Commit | Line | Data |
---|---|---|
2d5385e0 LT |
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 | ||
8d646433 | 23 | require "./test.pl"; |
2d5385e0 LT |
24 | require Config; import Config; |
25 | ||
26 | if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { | |
044255da | 27 | skip_all('-- IPC::SysV was not built'); |
2d5385e0 | 28 | } |
877c86f7 | 29 | skip_all_if_miniperl(); |
44f59ad0 | 30 | if ($Config{'d_shm'} ne 'define') { |
044255da | 31 | skip_all('-- $Config{d_shm} undefined'); |
44f59ad0 | 32 | } |
2d5385e0 LT |
33 | } |
34 | ||
2d5385e0 LT |
35 | |
36 | use sigtrap qw/die normal-signals error-signals/; | |
37 | use IPC::SysV qw/ IPC_PRIVATE S_IRWXU IPC_RMID /; | |
38 | ||
39 | my $key; | |
40 | END { shmctl $key, IPC_RMID, 0 if defined $key } | |
41 | ||
42 | { | |
43 | local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") } if exists $SIG{SYS}; | |
44 | $key = shmget IPC_PRIVATE, 8, S_IRWXU; | |
45 | } | |
46 | ||
47 | if (not defined $key) { | |
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 | else { | |
b399897d | 58 | plan(tests => 15); |
2d5385e0 LT |
59 | pass('acquired shared mem'); |
60 | } | |
61 | ||
62 | ok(shmwrite($key, pack("N", 4711), 0, 4), 'write(offs=0)'); | |
63 | ok(shmwrite($key, pack("N", 210577), 4, 4), 'write(offs=4)'); | |
64 | ||
65 | my $var; | |
66 | ok(shmread($key, $var, 0, 4), 'read(offs=0) returned ok'); | |
67 | is($var, pack("N", 4711), 'read(offs=0) correct'); | |
68 | ok(shmread($key, $var, 4, 4), 'read(offs=4) returned ok'); | |
69 | is($var, pack("N", 210577), 'read(offs=4) correct'); | |
70 | ||
71 | ok(shmwrite($key, "Shared", 1, 6), 'write(offs=1)'); | |
72 | ||
73 | ok(shmread($key, $var, 1, 6), 'read(offs=1) returned ok'); | |
74 | is($var, 'Shared', 'read(offs=1) correct'); | |
75 | ok(shmwrite($key,"Memory", 0, 6), 'write(offs=0)'); | |
76 | ||
af8ff727 LT |
77 | my $number = 1; |
78 | my $int = 2; | |
79 | shmwrite $key, $int, 0, 1; | |
80 | shmread $key, $number, 0, 1; | |
81 | is("$number", $int, qq{"\$id" eq "$int"}); | |
82 | cmp_ok($number + 0, '==', $int, "\$id + 0 == $int"); | |
b399897d CS |
83 | |
84 | my ($fetch, $store) = (0, 0); | |
85 | { package Counted; | |
86 | sub TIESCALAR { bless [undef] } | |
87 | sub FETCH { ++$fetch; $_[0][0] } | |
88 | sub STORE { ++$store; $_[0][0] = $_[1] } } | |
89 | tie $ct, 'Counted'; | |
90 | shmread $key, $ct, 0, 1; | |
91 | is($fetch, 1, "shmread FETCH once"); | |
92 | is($store, 1, "shmread STORE once"); |