https://perl5.git.perl.org / perl5.git / blame
| 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 | ||
| 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 sigtrap qw/die normal-signals error-signals/; | |
| 36 | use IPC::SysV qw/ IPC_PRIVATE S_IRWXU IPC_RMID /; | |
| 37 | ||
| 38 | my $key; | |
| 39 | END { shmctl $key, IPC_RMID, 0 if defined $key } | |
| 40 | ||
| 41 | { | |
| 42 | local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") } if exists $SIG{SYS}; | |
| 43 | $key = shmget IPC_PRIVATE, 8, S_IRWXU; | |
| 44 | } | |
| 45 | ||
| 46 | if (not defined $key) { | |
| 47 | my $info = "IPC::SharedMem->new failed: $!"; | |
| 48 | if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS || | |
| 49 | $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) { | |
| 50 | plan(skip_all => $info); | |
| 51 | } | |
| 52 | else { | |
| 53 | die $info; | |
| 54 | } | |
| 55 | } | |
| 56 | else { | |
| 57 | plan(tests => 11); | |
| 58 | pass('acquired shared mem'); | |
| 59 | } | |
| 60 | ||
| 61 | ok(shmwrite($key, pack("N", 4711), 0, 4), 'write(offs=0)'); | |
| 62 | ok(shmwrite($key, pack("N", 210577), 4, 4), 'write(offs=4)'); | |
| 63 | ||
| 64 | my $var; | |
| 65 | ok(shmread($key, $var, 0, 4), 'read(offs=0) returned ok'); | |
| 66 | is($var, pack("N", 4711), 'read(offs=0) correct'); | |
| 67 | ok(shmread($key, $var, 4, 4), 'read(offs=4) returned ok'); | |
| 68 | is($var, pack("N", 210577), 'read(offs=4) correct'); | |
| 69 | ||
| 70 | ok(shmwrite($key, "Shared", 1, 6), 'write(offs=1)'); | |
| 71 | ||
| 72 | ok(shmread($key, $var, 1, 6), 'read(offs=1) returned ok'); | |
| 73 | is($var, 'Shared', 'read(offs=1) correct'); | |
| 74 | ok(shmwrite($key,"Memory", 0, 6), 'write(offs=0)'); | |
| 75 |