xref: /openbsd/gnu/usr.bin/perl/t/io/shm.t (revision 73471bf0) 
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
17BEGIN {
18  chdir 't' if -d 't' && $ENV{'PERL_CORE'};
19  require "./test.pl";
20  set_up_inc('../lib') if $ENV{'PERL_CORE'} && -d '../lib' && -d '../ext';
21
22  require Config; import Config;
23
24  if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
25    skip_all('-- IPC::SysV was not built');
26  }
27  skip_all_if_miniperl();
28  if ($Config{'d_shm'} ne 'define') {
29    skip_all('-- $Config{d_shm} undefined');
30  }
31}
32
33
34use sigtrap qw/die normal-signals error-signals/;
35use IPC::SysV qw/ IPC_PRIVATE S_IRWXU IPC_RMID /;
36
37my $key;
38END { shmctl $key, IPC_RMID, 0 if defined $key }
39
40{
41	local $SIG{SYS} = sub { skip_all("SIGSYS caught") } if exists $SIG{SYS};
42	$key = shmget IPC_PRIVATE, 8, S_IRWXU;
43}
44
45if (not defined $key) {
46  my $info = "IPC::SharedMem->new failed: $!";
47  if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
48      $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
49    skip_all($info);
50  }
51  else {
52    die $info;
53  }
54}
55else {
56	plan(tests => 15);
57	pass('acquired shared mem');
58}
59
60ok(shmwrite($key, pack("N", 4711), 0, 4), 'write(offs=0)');
61ok(shmwrite($key, pack("N", 210577), 4, 4), 'write(offs=4)');
62
63my $var;
64ok(shmread($key, $var, 0, 4), 'read(offs=0) returned ok');
65is($var, pack("N", 4711), 'read(offs=0) correct');
66ok(shmread($key, $var, 4, 4), 'read(offs=4) returned ok');
67is($var, pack("N", 210577), 'read(offs=4) correct');
68
69ok(shmwrite($key, "Shared", 1, 6), 'write(offs=1)');
70
71ok(shmread($key, $var, 1, 6), 'read(offs=1) returned ok');
72is($var, 'Shared', 'read(offs=1) correct');
73ok(shmwrite($key,"Memory", 0, 6), 'write(offs=0)');
74
75my $number = 1;
76my $int = 2;
77shmwrite $key, $int, 0, 1;
78shmread $key, $number, 0, 1;
79is("$number", $int, qq{"\$id" eq "$int"});
80cmp_ok($number + 0, '==', $int, "\$id + 0 == $int");
81
82my ($fetch, $store) = (0, 0);
83{ package Counted;
84  sub TIESCALAR { bless [undef] }
85  sub FETCH     { ++$fetch; $_[0][0] }
86  sub STORE     { ++$store; $_[0][0] = $_[1] } }
87tie $ct, 'Counted';
88shmread $key, $ct, 0, 1;
89is($fetch, 1, "shmread FETCH once");
90is($store, 1, "shmread STORE once");
91