Commit | Line | Data |
8f85282b |
1 | ################################################################################ |
2 | # |
47e9bce1 |
3 | # $Revision: 5 $ |
8f85282b |
4 | # $Author: mhx $ |
47e9bce1 |
5 | # $Date: 2008/11/28 18:08:11 +0100 $ |
8f85282b |
6 | # |
7 | ################################################################################ |
8 | # |
47e9bce1 |
9 | # Version 2.x, Copyright (C) 2007, Marcus Holland-Moritz <mhx@cpan.org>. |
8f85282b |
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 | |