blob: 32efb58170c7f3328ba37e664a548cc6c73f5e54 (
plain)
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
package Test::Stream::ForceExit;
use strict;
use warnings;
sub new {
my $class = shift;
my $done = 0;
my $self = \$done;
return bless $self, $class;
}
sub done {
my $self = shift;
($$self) = @_ if @_;
return $$self;
}
sub DESTROY {
my $self = shift;
return if $self->done;
warn "Something prevented child process $$ from exiting when it should have, Forcing exit now!\n";
$self->done(1); # Prevent duplicate message during global destruction
exit 255;
}
1;
__END__
=head1 NAME
Test::ForceExit - Ensure C<exit()> is called by the end of a scope, force the issue.
=head1 DESCRIPTION
Sometimes you need to fork. Sometimes the forked process can throw an exception
to exit. If you forked below an eval the exception will be cought and you
suddenly have an unexpected process running amok. This module can be used to
protect you from such issues.
=head1 SYNOPSYS
eval {
...
my $pid = fork;
unless($pid) {
require Test::Stream::ForceExit;
my $force_exit = Test::Stream::ForceExit->new;
thing_that_can_die();
# We did not die, turn off the forced exit.
$force_exit->done(1);
# Do the exit we intend.
exit 0;
}
...
}
=head1 SOURCE
The source code repository for Test::More can be found at
F<http://github.com/Test-More/test-more/>.
=head1 MAINTAINER
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 AUTHORS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 COPYRIGHT
Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F<http://www.perl.com/perl/misc/Artistic.html>
=cut
|
