This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make utf8::encode respect magic
[perl5.git] / t / io / shm.t
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.pl";
24   require Config; import Config;
25
26   if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
27     skip_all('-- IPC::SysV was not built');
28   }
29   skip_all_if_miniperl();
30   if ($Config{'d_shm'} ne 'define') {
31     skip_all('-- $Config{d_shm} undefined');
32   }
33 }
34
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 {
58         plan(tests => 15);
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
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");
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");