1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
use Test::Stream::ForceExit;
use strict;
use warnings;
use Test::CanFork;
use Test::Stream qw/enable_fork/;
use Test::More;
use Test::Stream::ForceExit;
my ($read, $write);
pipe($read, $write) || die "Failed to create a pipe.";
my $pid = fork();
unless ($pid) {
die "Failed to fork" unless defined $pid;
close($read);
$SIG{__WARN__} = sub { print $write @_ };
{
my $force_exit = Test::Stream::ForceExit->new;
note "In Child";
}
print $write "Did not exit!";
ok(0, "Failed to exit");
exit 0;
}
close($write);
waitpid($pid, 0);
my $error = $?;
ok($error, "Got an error");
my $msg = join("", <$read>);
is($msg, <<EOT, "Got warning");
Something prevented child process $pid from exiting when it should have, Forcing exit now!
EOT
close($read);
pipe($read, $write) || die "Failed to create a pipe.";
$pid = fork();
unless ($pid) {
die "Failed to fork" unless defined $pid;
close($read);
$SIG{__WARN__} = sub { print $write @_ };
{
my $force_exit = Test::Stream::ForceExit->new;
note "In Child $$";
$force_exit->done(1);
}
print $write "Did not exit!\n";
exit 0;
}
close($write);
waitpid($pid, 0);
$error = $?;
ok(!$error, "no error");
$msg = join("", <$read>);
is($msg, <<EOT, "Did not exit early");
Did not exit!
EOT
done_testing;
|
