Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
argv.t	3.92 KB	-r--r--r--	2014-12-27 11:49
binmode.t	1.02 KB	-r--r--r--	2014-12-27 11:49
bom.t	329 B	-r--r--r--	2014-12-27 11:49
closepid.t	1.26 KB	-r--r--r--	2014-12-27 11:49
crlf.t	2.45 KB	-r--r--r--	2014-12-27 11:49
crlf_through.t	152 B	-r--r--r--	2014-12-27 11:49
data.t	1.5 KB	-r--r--r--	2014-12-27 11:49
defout.t	1.09 KB	-r--r--r--	2014-12-27 11:49
dup.t	3.09 KB	-r--r--r--	2014-12-27 11:49
eintr.t	3.65 KB	-r--r--r--	2015-01-12 20:14
eintr_print.t	2.48 KB	-r--r--r--	2014-12-27 11:49
errno.t	1.12 KB	-r--r--r--	2014-12-27 11:49
errnosig.t	746 B	-r--r--r--	2014-12-27 11:49
fflush.t	3.25 KB	-r--r--r--	2014-12-27 11:49
fs.t	12.97 KB	-r--r--r--	2014-12-27 11:49
inplace.t	1.83 KB	-r--r--r--	2014-12-27 11:49
iofile.t	644 B	-r--r--r--	2014-12-27 11:49
iprefix.t	707 B	-r--r--r--	2014-12-27 11:49
layers.t	6.37 KB	-r--r--r--	2014-12-27 11:49
nargv.t	1.16 KB	-r--r--r--	2014-12-27 11:49
open.t	14.56 KB	-r--r--r--	2014-12-27 11:49
openpid.t	2.39 KB	-r--r--r--	2014-12-27 11:49
perlio.t	5.73 KB	-r--r--r--	2014-12-27 11:49
perlio_fail.t	1.06 KB	-r--r--r--	2014-12-27 11:49
perlio_leaks.t	675 B	-r--r--r--	2014-12-27 11:49
perlio_open.t	756 B	-r--r--r--	2014-12-27 11:49
pipe.t	5.9 KB	-r--r--r--	2014-12-27 11:49
print.t	1.41 KB	-r--r--r--	2014-12-27 11:49
pvbm.t	2.39 KB	-r--r--r--	2014-12-27 11:49
read.t	523 B	-r--r--r--	2014-12-27 11:49
say.t	1.05 KB	-r--r--r--	2014-12-27 11:49
sem.t	1.78 KB	-r--r--r--	2014-12-27 11:49
shm.t	2.56 KB	-r--r--r--	2014-12-27 11:49
socket.t	3.51 KB	-r--r--r--	2014-12-27 11:49
tell.t	4.94 KB	-r--r--r--	2014-12-27 11:49
through.t	4.52 KB	-r--r--r--	2014-12-27 11:49
utf8.t	9.28 KB	-r--r--r--	2014-12-27 11:49

Rename

################################################################################
#
#  $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");