UUID
view release on metacpan or search on metacpan
t/5persist/fork-sibling.t view on Meta::CPAN
#
# make sure persist set in child visible in sibling
#
use strict;
use warnings;
use MyTest;
use Try::Tiny;
use File::Temp;
use vars qw($tmpdir $fn0 $fn1);
BEGIN {
$tmpdir = File::Temp->newdir('UUID-test-XXXXXXXX', TMPDIR => 1, CLEANUP => 0);
$fn0 = File::Temp::tempnam($tmpdir, 'UUID.test.');
$fn1 = File::Temp::tempnam($tmpdir, 'UUID.test.');
ok 1, 'began';
}
use UUID;
ok 1, 'loaded';
ok -d $tmpdir, 'tmpdir exists';
ok !-e $fn0, 'fn0 missing';
ok !-e $fn1, 'fn1 missing';
sub cleanup {
# close state so Win32 can cleanup
UUID::_persist(undef);
1 while unlink $fn0;
1 while unlink $fn1;
rmdir $tmpdir;
}
sub err ($) {
my $msg = shift;
cleanup();
die $msg;
}
sub t (&) {
my $t = shift;
my ($rv, $err);
$rv = try { $t->() }
catch { $err = $_; undef };
return $rv, $err;
}
{
my $fpath = '/some/random/path';
my $kid0 = fork;
err "fork: $!" unless defined $kid0;
if (!$kid0) { # child
my ($rv,$er) = t{ UUID::_persist($fpath) };
open my $fh, '>', $fn0 or err "open: $!";
print $fh (defined($er) ? $er : $rv)."\n";
close $fh;
exit 0;
}
waitpid $kid0, 0;
my $status0 = $?;
my $kid1 = fork;
err "fork: $!" unless defined $kid1;
if (!$kid1) { # child
my ($rv,$er) = t{ UUID::_persist() };
open my $fh, '>', $fn1 or err "open: $!";
print $fh (defined($er) ? $er : $rv)."\n";
close $fh;
exit 0;
}
waitpid $kid1, 0;
my $status1 = $?;
UUID::_persist( $fpath );
open my $fh0, '<', $fn0 or err "open: $!";
my $str0 = join '', <$fh0>;
chomp $str0;
open my $fh1, '<', $fn1 or err "open: $!";
my $str1 = join '', <$fh1>;
chomp $str1;
is $status0, 0, 'status0 correct';
is $status1, 0, 'status1 correct';
is $str0, 1, 'path0 correct';
is $str1, $fpath, 'path1 correct';
}
cleanup;
done_testing;
( run in 1.998 second using v1.01-cache-2.11-cpan-524268b4103 )