From 01ac950d56a44f70e2e10b5cc6440140428f20dd Mon Sep 17 00:00:00 2001
From: Lukas Mai <lukasmai.403@gmail.com>
Date: Wed, 8 Jan 2025 14:28:06 +0100
Subject: [PATCH] t/io/shm.t: test shmwrite beyond the 2GB mark

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 2d5385e000).

Also test that shmwrite() from a tied buffer only calls FETCH once while
we're at it.
---
 t/io/shm.t | 32 +++++++++++++++++++++++++++++---
 1 file changed, 29 insertions(+), 3 deletions(-)

diff --git a/t/io/shm.t b/t/io/shm.t
index 1070bdf5b146..c54e07b4b446 100644
--- a/t/io/shm.t
+++ b/t/io/shm.t
@@ -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);
@@ -54,7 +54,7 @@ if (not defined $key) {
   }
 }
 else {
-	plan(tests => 21);
+	plan(tests => 28);
 	pass('acquired shared mem');
 }
 
@@ -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
@@ -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");
+}