Added SysV shared memory tests

Tests are based on IPC-SysV's tests, though I had to remove a lot for it
not to rely on IPC::SharedMem.

1 files changed, 75 insertions, 0 deletions

diff --git a/t/io/shm.t b/t/io/shm.t
new file mode 100644
index 0000000000..a4506799e1
--- /dev/null
+++ b/t/io/shm.t
@@ -0,0 +1,75 @@
+################################################################################
+#
+#  $Revision: 6 $
+#  $Author: mhx $
+#  $Date: 2010/03/07 16:01:42 +0100 $
+#
+################################################################################
+#
+#  Version 2.x, Copyright (C) 2007-2010, Marcus Holland-Moritz <mhx@cpan.org>.
+#  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
+#
+#  This program is free software; you can redistribute it and/or
+#  modify it under the same terms as Perl itself.
+#
+################################################################################
+
+BEGIN {
+  if ($ENV{'PERL_CORE'}) {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib' && -d '../ext';
+  }
+
+  require Test::More; import Test::More;
+  require Config; import Config;
+
+  if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
+    plan(skip_all => 'IPC::SysV was not built');
+  }
+}
+
+if ($Config{'d_shm'} ne 'define') {
+  plan(skip_all => '$Config{d_shm} undefined');
+}
+
+use sigtrap qw/die normal-signals error-signals/;
+use IPC::SysV qw/ IPC_PRIVATE S_IRWXU IPC_RMID /;
+
+my $key;
+END { shmctl $key, IPC_RMID, 0 if defined $key }
+
+{
+	local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") } if exists $SIG{SYS};
+	$key = shmget IPC_PRIVATE, 8, S_IRWXU;
+}
+
+if (not defined $key) {
+  my $info = "IPC::SharedMem->new failed: $!";
+  if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
+      $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
+    plan(skip_all => $info);
+  }
+  else {
+    die $info;
+  }
+}
+else {
+	plan(tests => 11);
+	pass('acquired shared mem');
+}
+
+ok(shmwrite($key, pack("N", 4711), 0, 4), 'write(offs=0)');
+ok(shmwrite($key, pack("N", 210577), 4, 4), 'write(offs=4)');
+
+my $var;
+ok(shmread($key, $var, 0, 4), 'read(offs=0) returned ok');
+is($var, pack("N", 4711), 'read(offs=0) correct');
+ok(shmread($key, $var, 4, 4), 'read(offs=4) returned ok');
+is($var, pack("N", 210577), 'read(offs=4) correct');
+
+ok(shmwrite($key, "Shared", 1, 6), 'write(offs=1)');
+
+ok(shmread($key, $var, 1, 6), 'read(offs=1) returned ok');
+is($var, 'Shared', 'read(offs=1) correct');
+ok(shmwrite($key,"Memory", 0, 6), 'write(offs=0)');
+