Skip to content

Commit

Permalink
t/io/shm.t: test shmwrite beyond the 2GB mark
Browse files Browse the repository at this point in the history
Guard tests behind PERL_TEST_MEMORY because we're allocating a 2GB
shared mem segment and a 2GB scalar buffer. These tests used to fail (or
crash) before the do_shmio() I32 fixes.

Also fix the error message if the initial shmget fails
("IPC::SharedMem->new" was a copy/paste oversight from when these tests
were copied in from IPC::SysV in 2d5385e).

Also test that shmwrite() from a tied buffer only calls FETCH once while
we're at it.
  • Loading branch information
mauke committed Jan 8, 2025
1 parent 55f136d commit 01ac950
Showing 1 changed file with 29 additions and 3 deletions.
32 changes: 29 additions & 3 deletions t/io/shm.t
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ END { shmctl $key, IPC_RMID, 0 if defined $key }
}

if (not defined $key) {
my $info = "IPC::SharedMem->new failed: $!";
my $info = "shmget() failed: $!";
if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
$! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
skip_all($info);
Expand All @@ -54,7 +54,7 @@ if (not defined $key) {
}
}
else {
plan(tests => 21);
plan(tests => 28);
pass('acquired shared mem');
}

Expand Down Expand Up @@ -85,10 +85,14 @@ my ($fetch, $store) = (0, 0);
sub TIESCALAR { bless [undef] }
sub FETCH { ++$fetch; $_[0][0] }
sub STORE { ++$store; $_[0][0] = $_[1] } }
tie $ct, 'Counted';
tie my $ct, 'Counted';
shmread $key, $ct, 0, 1;
is($fetch, 1, "shmread FETCH once");
is($store, 1, "shmread STORE once");
($fetch, $store) = (0, 0);
shmwrite $key, $ct, 0, 1;
is($fetch, 1, "shmwrite FETCH once");
is($store, 0, "shmwrite STORE none");

{
# check reading into an upgraded buffer is sane
Expand All @@ -105,3 +109,25 @@ is($store, 1, "shmread STORE once");
ok(shmread($key, $rdbuf, 0, 4), "read it back (upgraded source)");
is($rdbuf, $text, "check we got back the expected (upgraded source)");
}

# GH #22895 - 2^31 boundary
SKIP: {
skip("need at least 5GB of memory for this test", 5)
unless ($ENV{PERL_TEST_MEMORY} // 0) >= 5;

# delete previous allocation
shmctl $key, IPC_RMID, 0;
$key = undef;

my $int32_max = 0x7fff_ffff;
$key = shmget(IPC_PRIVATE, $int32_max+2, S_IRWXU) // die "shmget(2GB+1) failed: $!";
my $bigbuf = 'A' x $int32_max;
ok(shmwrite($key, $bigbuf, 0, length($bigbuf)), "wrote $int32_max bytes");
$bigbuf .= 'X';
ok(shmwrite($key, $bigbuf, 0, length($bigbuf)), "wrote $int32_max+1 bytes");
my $smallbuf = 'X';
ok(shmwrite($key, $smallbuf, $int32_max, 1), "wrote 1 byte at offset $int32_max");
ok(shmwrite($key, $smallbuf, $int32_max+1, 1), "wrote 1 byte at offset $int32_max+1");
my $int30x = 0x4000_0000;
ok(shmwrite($key, $bigbuf, $int30x, $int30x), "wrote $int30x bytes at offset $int30x");
}

0 comments on commit 01ac950

Please sign in to comment.