This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update IPC-SysV to CPAN version 2.04
[perl5.git] / cpan / IPC-SysV / t / shm.t
1 ################################################################################
2 #
3 #  Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz <mhx@cpan.org>.
4 #  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
5 #
6 #  This program is free software; you can redistribute it and/or
7 #  modify it under the same terms as Perl itself.
8 #
9 ################################################################################
10
11 BEGIN {
12   if ($ENV{'PERL_CORE'}) {
13     chdir 't' if -d 't';
14     @INC = '../lib' if -d '../lib' && -d '../ext';
15   }
16
17   require Test::More; import Test::More;
18   require Config; import Config;
19
20   if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
21     plan(skip_all => 'IPC::SysV was not built');
22   }
23 }
24
25 if ($Config{'d_shm'} ne 'define') {
26   plan(skip_all => '$Config{d_shm} undefined');
27 }
28
29 use IPC::SysV qw( IPC_PRIVATE S_IRWXU );
30 use IPC::SharedMem;
31
32 my $shm = sub {
33   my $code = shift;
34   if (exists $SIG{SYS}) {
35     local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") };
36     return $code->();
37   }
38   return $code->();
39 }->(sub { IPC::SharedMem->new(IPC_PRIVATE, 8, S_IRWXU) });
40
41 unless (defined $shm) {
42   my $info = "IPC::SharedMem->new failed: $!";
43   if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
44       $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
45     plan(skip_all => $info);
46   }
47   else {
48     die $info;
49   }
50 }
51
52 plan(tests => 23);
53
54 pass('acquired shared mem');
55
56 my $st = $shm->stat;
57
58 ok($st, 'stat it');
59 is($st->nattch, 0, 'st->nattch');
60 is($st->cpid, $$, 'cpid');
61 ok($st->segsz >= 8, 'segsz');
62
63 ok($shm->write(pack("N", 4711), 0, 4), 'write(offs=0)');
64 ok($shm->write(pack("N", 210577), 4, 4), 'write(offs=4)');
65
66 is($shm->read(0, 4), pack("N", 4711), 'read(offs=0)');
67 is($shm->read(4, 4), pack("N", 210577), 'read(offs=4)');
68
69 ok($shm->attach, 'attach');
70
71 $st = $shm->stat;
72
73 ok($st, 'stat it');
74 is($st->nattch, 1, 'st->nattch');
75 is($st->cpid, $$, 'lpid');
76
77 is($shm->read(0, 4), pack("N", 4711), 'read(offs=0)');
78 is($shm->read(4, 4), pack("N", 210577), 'read(offs=4)');
79
80 ok($shm->write("Shared", 1, 6), 'write(offs=1)');
81
82 ok(!$shm->is_removed, '!is_removed');
83 ok($shm->remove, 'remove');
84 ok($shm->is_removed, 'is_removed');
85
86 is($shm->read(1, 6), 'Shared', 'read(offs=1)');
87 ok($shm->write("Memory", 0, 6), 'write(offs=0)');
88 is(unpack("P6", $shm->addr), 'Memory', 'read using unpack');
89
90 ok($shm->detach, 'detach');
91