This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #123963] "@<fullwidth digit>"
[perl5.git] / cpan / Test-Simple / t / Test-Stream-ForceExit.t
CommitLineData
2e52a9b8
CG
1use Test::Stream::ForceExit;
2use strict;
3use warnings;
4
5use Test::CanFork;
6
7use Test::Stream qw/enable_fork/;
8use Test::More;
9use Test::Stream::ForceExit;
10
11my ($read, $write);
12pipe($read, $write) || die "Failed to create a pipe.";
13
14my $pid = fork();
15unless ($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
31close($write);
32waitpid($pid, 0);
33my $error = $?;
34ok($error, "Got an error");
35my $msg = join("", <$read>);
36is($msg, <<EOT, "Got warning");
37Something prevented child process $pid from exiting when it should have, Forcing exit now!
38EOT
39
40close($read);
41pipe($read, $write) || die "Failed to create a pipe.";
42
43$pid = fork();
44unless ($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
60close($write);
61waitpid($pid, 0);
62$error = $?;
63ok(!$error, "no error");
64$msg = join("", <$read>);
65is($msg, <<EOT, "Did not exit early");
66Did not exit!
67EOT
68
69done_testing;