The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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;