cpan/IPC-SysV/t/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::More; import Test::More;
  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 }
  30
  31 if ($Config{'d_shm'} ne 'define') {
  32   plan(skip_all => '$Config{d_shm} undefined');
  33 }
  34
  35 use IPC::SysV qw( IPC_PRIVATE S_IRWXU );
  36 use IPC::SharedMem;
  37
  38 my $shm = sub {
  39   my $code = shift;
  40   if (exists $SIG{SYS}) {
  41     local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") };
  42     return $code->();
  43   }
  44   return $code->();
  45 }->(sub { IPC::SharedMem->new(IPC_PRIVATE, 8, S_IRWXU) });
  46
  47 unless (defined $shm) {
  48   my $info = "IPC::SharedMem->new failed: $!";
  49   if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
  50       $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
  51     plan(skip_all => $info);
  52   }
  53   else {
  54     die $info;
  55   }
  56 }
  57
  58 plan(tests => 23);
  59
  60 pass('acquired shared mem');
  61
  62 my $st = $shm->stat;
  63
  64 ok($st, 'stat it');
  65 is($st->nattch, 0, 'st->nattch');
  66 is($st->cpid, $$, 'cpid');
  67 ok($st->segsz >= 8, 'segsz');
  68
  69 ok($shm->write(pack("N", 4711), 0, 4), 'write(offs=0)');
  70 ok($shm->write(pack("N", 210577), 4, 4), 'write(offs=4)');
  71
  72 is($shm->read(0, 4), pack("N", 4711), 'read(offs=0)');
  73 is($shm->read(4, 4), pack("N", 210577), 'read(offs=4)');
  74
  75 ok($shm->attach, 'attach');
  76
  77 $st = $shm->stat;
  78
  79 ok($st, 'stat it');
  80 is($st->nattch, 1, 'st->nattch');
  81 is($st->cpid, $$, 'lpid');
  82
  83 is($shm->read(0, 4), pack("N", 4711), 'read(offs=0)');
  84 is($shm->read(4, 4), pack("N", 210577), 'read(offs=4)');
  85
  86 ok($shm->write("Shared", 1, 6), 'write(offs=1)');
  87
  88 ok(!$shm->is_removed, '!is_removed');
  89 ok($shm->remove, 'remove');
  90 ok($shm->is_removed, 'is_removed');
  91
  92 is($shm->read(1, 6), 'Shared', 'read(offs=1)');
  93 ok($shm->write("Memory", 0, 6), 'write(offs=0)');
  94 is(unpack("P6", $shm->addr), 'Memory', 'read using unpack');
  95
  96 ok($shm->detach, 'detach');
  97