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