1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
################################################################################
#
# $Revision: 6 $
# $Author: mhx $
# $Date: 2010/03/07 16:01:42 +0100 $
#
################################################################################
#
# Version 2.x, Copyright (C) 2007-2010, Marcus Holland-Moritz <mhx@cpan.org>.
# Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
BEGIN {
if ($ENV{'PERL_CORE'}) {
chdir 't' if -d 't';
@INC = '../lib' if -d '../lib' && -d '../ext';
}
require "./test.pl";
require Config; import Config;
if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
skip_all('-- IPC::SysV was not built');
}
skip_all_if_miniperl();
if ($Config{'d_shm'} ne 'define') {
skip_all('-- $Config{d_shm} undefined');
}
}
use sigtrap qw/die normal-signals error-signals/;
use IPC::SysV qw/ IPC_PRIVATE S_IRWXU IPC_RMID /;
my $key;
END { shmctl $key, IPC_RMID, 0 if defined $key }
{
local $SIG{SYS} = sub { skip_all("SIGSYS caught") } if exists $SIG{SYS};
$key = shmget IPC_PRIVATE, 8, S_IRWXU;
}
if (not defined $key) {
my $info = "IPC::SharedMem->new failed: $!";
if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
$! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
skip_all($info);
}
else {
die $info;
}
}
else {
plan(tests => 15);
pass('acquired shared mem');
}
ok(shmwrite($key, pack("N", 4711), 0, 4), 'write(offs=0)');
ok(shmwrite($key, pack("N", 210577), 4, 4), 'write(offs=4)');
my $var;
ok(shmread($key, $var, 0, 4), 'read(offs=0) returned ok');
is($var, pack("N", 4711), 'read(offs=0) correct');
ok(shmread($key, $var, 4, 4), 'read(offs=4) returned ok');
is($var, pack("N", 210577), 'read(offs=4) correct');
ok(shmwrite($key, "Shared", 1, 6), 'write(offs=1)');
ok(shmread($key, $var, 1, 6), 'read(offs=1) returned ok');
is($var, 'Shared', 'read(offs=1) correct');
ok(shmwrite($key,"Memory", 0, 6), 'write(offs=0)');
my $number = 1;
my $int = 2;
shmwrite $key, $int, 0, 1;
shmread $key, $number, 0, 1;
is("$number", $int, qq{"\$id" eq "$int"});
cmp_ok($number + 0, '==', $int, "\$id + 0 == $int");
my ($fetch, $store) = (0, 0);
{ package Counted;
sub TIESCALAR { bless [undef] }
sub FETCH { ++$fetch; $_[0][0] }
sub STORE { ++$store; $_[0][0] = $_[1] } }
tie $ct, 'Counted';
shmread $key, $ct, 0, 1;
is($fetch, 1, "shmread FETCH once");
is($store, 1, "shmread STORE once");
|
