view release on metacpan or  search on metacpan

t/5persist/fork-before.t  view on Meta::CPAN

#
# make sure persist set in parent after fork visible in child
#
use strict;
use warnings;
use MyTest;
use Try::Tiny;
use File::Temp;

use vars qw($tmpdir $tmp $fn0);

BEGIN {
    $tmpdir = File::Temp->newdir('UUID-test-XXXXXXXX', TMPDIR => 1, CLEANUP => 0);
    $tmp = File::Temp::tempnam($tmpdir, 'UUID.test.');
    $fn0 = 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 $tmp,   'tmp missing';

sub cleanup {
    # close state so Win32 can cleanup
    UUID::_persist(undef);
    1 while unlink $fn0;
    1 while unlink $tmp;
    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 $kid = fork;
    err "fork: $!" unless defined $kid;

    if (!$kid) {  # child
        select(undef, undef, undef, 0.001)
            while !-e $tmp;
        my ($rv,$er) = t{ UUID::_persist() };
        open my $fh, '>', $fn0 or err "open: $!";
        print $fh (defined($er) ? $er : $rv)."\n";
        close $fh;
        exit 0;
    }

    UUID::_persist( $fpath );
    open my $sem, '>', $tmp or err "open: $!";
    close $sem;

    waitpid $kid, 0;
    my $status = $?;

    open my $fh, '<', $fn0 or err "open: $!";
    my $str = join '', <$fh>;
    chomp $str;

    is $status, 0,      'status correct';
    is $str,    $fpath, 'path correct';
}

cleanup;
done_testing;