Browse files

Override CORE::GLOBAL::exit in INIT.

During BEGIN we just set up a promise to replace exit. We actually do
the replacement inside an INIT block.
  • Loading branch information...
1 parent 5e179c8 commit 22bcb4091d6b69eec04c18fa9ddc934cdc39c9d0 Belden Lyman committed Mar 26, 2012
Showing with 26 additions and 3 deletions.
  1. +9 −3 lib/Test/Exit.pm
  2. +17 −0 t/overrides-exit-also.t
View
12 lib/Test/Exit.pm
@@ -12,12 +12,18 @@ our @EXPORT = qw(exits_ok exits_zero exits_nonzero never_exits_ok);
# We have to install this at compile-time and globally.
# We provide one that does effectively nothing, and then override it locally.
-# Of course, if anyone else overrides CORE::GLOBAL::exit as well, bad stuff happens.
-our $exit_handler = sub {
+our $exit_handler = sub {
my $value = @_ ? $_[0] : 0;
CORE::exit $value;
};
-BEGIN {
+BEGIN { *CORE::GLOBAL::exit = \&CORE::exit };
+
+# someone else might have set up an exit handler inside some other BEGIN block.
+# We just do ours in a CHECK block, which increases the likelihood that ours is
+# the installed exit handler. (Note that we use CHECK rather than INIT since CHECK
+# runs in FILO order, whereas INIT runs in FIFO order.)
+CHECK {
+ no warnings 'redefine';
*CORE::GLOBAL::exit = sub { $exit_handler->(@_) };
}
View
17 t/overrides-exit-also.t
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+use Test::Exit;
+
+our $tried_to_exit;
+BEGIN {
+ no warnings 'redefine';
+ *CORE::GLOBAL::exit = sub { $tried_to_exit++ };
+}
+
+exits_ok { exit 1 } "our exit handler is still in place";
+ok( ! $tried_to_exit, "preexisting exit handler not called (dang)" );

0 comments on commit 22bcb40

Please sign in to comment.