BEGIN {
$^W = 1;
$| = 1;
$SIG{INT} = sub { die };
print "1..11\n";
}
use strict;
use Carp;
use IPC::Shareable;
use IPC::Shareable::SharedMem;
my $t = 1;
my $ok = 1;
sub gonzo {
# --- shmread should barf if the segment has really been cleaned
my $id = shift;
my $data = '';
eval { shmread($id, $data, 0, 6) or die "$!" };
return scalar($@ =~ /Invalid/ or $@ =~ /removed/);
}
# --- remove()
my $sv;
(my $s = tie $sv, 'IPC::Shareable', { destroy => 0 })
or undef $ok;
print $ok ? "ok $t\n" : "not ok $t\n";
$sv = 'foobar';
++$t;
# XXX Don't do the following: it's not part of the interface!
my $id = $s->{_shm}->id;
$s->remove;
$ok = gonzo($id);
print $ok ? "ok $t\n" : "not ok $t\n";
my $awake = 0;
local $SIG{ALRM} = sub { $awake = 1 };
# --- remove(), clean_up(), clean_up_all()
++$t;
$ok = 1;
my $pid = fork;
defined $pid or die "Cannot fork : $!";
if ($pid == 0) {
# --- Child
sleep unless $awake;
my $s = tie($sv, 'IPC::Shareable', 'hash', { destroy => 0 })
or undef $ok;
print $ok ? "ok $t\n" : "not ok $t\n";
$sv = 'foobar';
++$t;
my $data = '';
my $id = $s->{_shm}->id;
IPC::Shareable->clean_up();
$ok = shmread($id, $data, 0, length('IPC::Shareable'));
print $ok ? "ok $t\n" : "not ok $t\n";
++$t;
$ok = ($data eq 'IPC::Shareable');
print $ok ? "ok $t\n" : "not ok $t\n";
++$t;
$s->remove;
$ok = gonzo($id);
print $ok ? "ok $t\n" : "not ok $t\n";
++$t;
tie($sv, 'IPC::Shareable', 'kids', { create => 'yes', destroy => 0 })
or undef $ok;
print $ok ? "ok $t\n" : "not ok $t\n";
$sv = 'the kid was here';
exit;
} else {
# --- Parent
my $s = tie($sv, 'IPC::Shareable', 'hash', { create => 'yes', destroy => 0 })
or undef $ok;
kill ALRM => $pid;
my $id = $s->{_shm}->id;
waitpid($pid, 0);
+$t += 5; # - Child performed 4 tests
$ok = gonzo($id);
print $ok ? "ok $t\n" : "not ok $t\n";
}
++$t;
$s = tie($sv, 'IPC::Shareable', 'kids', { destroy => 0 })
or undef $ok;
print $ok ? "ok $t\n" : "not ok $t\n";
$id = $s->{_shm}->id;
++$t;
$ok = ($sv eq 'the kid was here');
print $ok ? "ok $t\n" : "not ok $t\n";
++$t;
IPC::Shareable->clean_up_all;
$ok = gonzo($id);
print $ok ? "ok $t\n" : "not ok $t\n";
# --- Done!
exit;