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