This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Added SysV shared memory tests
authorLeon Timmermans <fawaka@gmail.com>
Tue, 13 Sep 2011 16:34:28 +0000 (18:34 +0200)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 14 Sep 2011 19:49:56 +0000 (12:49 -0700)
Tests are based on IPC-SysV's tests, though I had to remove a lot for it
not to rely on IPC::SharedMem.

MANIFEST
t/io/shm.t [new file with mode: 0644]

index 16121f8..a52d7a7 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4810,6 +4810,7 @@ t/io/print.t                      See if print commands work
 t/io/pvbm.t                    See if PVBMs break IO commands
 t/io/read.t                    See if read works
 t/io/say.t                     See if say works
+t/io/shm.t                     See if SysV shared memory works
 t/io/tell.t                    See if file seeking works
 t/io/through.t                 See if pipe passes data intact
 t/io/utf8.t                    See if file seeking works
diff --git a/t/io/shm.t b/t/io/shm.t
new file mode 100644 (file)
index 0000000..a450679
--- /dev/null
@@ -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)');
+