t/io/shm.t

   1 ################################################################################
   2 #
   3 #  $Revision: 6 $
   4 #  $Author: mhx $
   5 #  $Date: 2010/03/07 16:01:42 +0100 $
   6 #
   7 ################################################################################
   8 #
   9 #  Version 2.x, Copyright (C) 2007-2010, Marcus Holland-Moritz <mhx@cpan.org>.
  10 #  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
  11 #
  12 #  This program is free software; you can redistribute it and/or
  13 #  modify it under the same terms as Perl itself.
  14 #
  15 ################################################################################
  16
  17 BEGIN {
  18   if ($ENV{'PERL_CORE'}) {
  19     chdir 't' if -d 't';
  20     @INC = '../lib' if -d '../lib' && -d '../ext';
  21   }
  22
  23   require "./test.pl";
  24   require Config; import Config;
  25
  26   if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
  27     plan(skip_all => 'IPC::SysV was not built');
  28   }
  29   unless(defined &DynaLoader::boot_DynaLoader) { # miniperl
  30     plan(skip_all => 'miniperl');
  31   }
  32   if ($Config{'d_shm'} ne 'define') {
  33     plan(skip_all => '$Config{d_shm} undefined');
  34   }
  35 }
  36
  37
  38 use sigtrap qw/die normal-signals error-signals/;
  39 use IPC::SysV qw/ IPC_PRIVATE S_IRWXU IPC_RMID /;
  40
  41 my $key;
  42 END { shmctl $key, IPC_RMID, 0 if defined $key }
  43
  44 {
  45         local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") } if exists $SIG{SYS};
  46         $key = shmget IPC_PRIVATE, 8, S_IRWXU;
  47 }
  48
  49 if (not defined $key) {
  50   my $info = "IPC::SharedMem->new failed: $!";
  51   if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
  52       $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
  53     plan(skip_all => $info);
  54   }
  55   else {
  56     die $info;
  57   }
  58 }
  59 else {
  60         plan(tests => 13);
  61         pass('acquired shared mem');
  62 }
  63
  64 ok(shmwrite($key, pack("N", 4711), 0, 4), 'write(offs=0)');
  65 ok(shmwrite($key, pack("N", 210577), 4, 4), 'write(offs=4)');
  66
  67 my $var;
  68 ok(shmread($key, $var, 0, 4), 'read(offs=0) returned ok');
  69 is($var, pack("N", 4711), 'read(offs=0) correct');
  70 ok(shmread($key, $var, 4, 4), 'read(offs=4) returned ok');
  71 is($var, pack("N", 210577), 'read(offs=4) correct');
  72
  73 ok(shmwrite($key, "Shared", 1, 6), 'write(offs=1)');
  74
  75 ok(shmread($key, $var, 1, 6), 'read(offs=1) returned ok');
  76 is($var, 'Shared', 'read(offs=1) correct');
  77 ok(shmwrite($key,"Memory", 0, 6), 'write(offs=0)');
  78
  79 my $number = 1;
  80 my $int = 2;
  81 shmwrite $key, $int, 0, 1;
  82 shmread $key, $number, 0, 1;
  83 is("$number", $int, qq{"\$id" eq "$int"});
  84 cmp_ok($number + 0, '==', $int, "\$id + 0 == $int");