| Commit | Line | Data |
|---|
| 8f85282b |
1 | ################################################################################ |
| 2 | # |
| 503ba33a |
3 | # $Revision: 5 $ |
| 8f85282b |
4 | # $Author: mhx $ |
| 503ba33a |
5 | # $Date: 2008/11/28 18:08:11 +0100 $ |
| 8f85282b |
6 | # |
| 7 | ################################################################################ |
| 8 | # |
| 9 | # Version 2.x, Copyright (C) 2007, 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: $!"; |
| 503ba33a |
49 | if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS || |
| 50 | $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) { |
| 8f85282b |
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 | |
projects / p5sagit/p5-mst-13.2.git / blame