view release on metacpan or  search on metacpan

t/unthreaded.t  view on Meta::CPAN

            Test::More::skip("ptrace permissions", 1);
        }

        Test::More::like(
        $trace,
            qr{
                (?:
                    ^t/unthreaded\.t:\d+\n
                ){10}
            }xm
        );

    }

        Test::More::is( $WAITED_PID, $pstack_pid, "Reaped pstack" );
        Test::More::is( $WAITED_RC >> 8, 0, "exit(0)" );
        Test::More::is( $WAITED_RC & 127, 0, "No signals" );
        Test::More::is( $WAITED_RC & 128, 0, "No core dump" );
    
    exit;
}

close $pstack_rd;
close $pstack_wr1;
sysread $pstack_rd1, $_, 1;

my ( $script_rd, $script_wr );
pipe( $script_rd, $script_wr );

$SIG{CHLD} = sub { exit };
my $script_ppid = $$;
my $script_pid = fork;
if (!defined $pstack_pid) {
    die "Can't fork: $!";
}
elsif ($script_pid) {
    sysread $script_rd, $_, 1;

    require App::Stacktrace;
    open STDOUT, '>&=' . fileno( $pstack_wr );
    open STDERR, '>&=' . fileno( $pstack_wr );
    App::Stacktrace->new(
        '--exec',
        $script_pid
    )->run;
    kill 2, $script_pid;
    exit;
}

$SIG{INT} = sub { exit };
foo( 10 );
sub foo {
    my $v = shift;
    if ( $v ) {
        -- $v;
        foo( $v );
    }
    else {
        syswrite $script_wr, '.';
        while (1) {
            my $pstack_ppid_alive = kill 0, $pstack_ppid;
            my $script_ppid_alive = kill 0, $script_ppid;
            print "# Alive top @{[time]}: $pstack_ppid_alive middle: $script_ppid_alive\n";
            if ($pstack_ppid_alive && $script_ppid_alive) {
                select undef, undef, undef, 1;
            }
            else {
                exit;
            }
        }
        exit;
    }
}