test all phases instead of just BEGIN
Graham Knop [Sat, 2 Feb 2013 12:00:29 +0000 (07:00 -0500)]
t/04_phases.t [moved from t/04_begin.t with 51% similarity]

similarity index 51%
rename from t/04_begin.t
rename to t/04_phases.t
index 7e5c52d..656fdb5 100644 (file)
@@ -25,8 +25,10 @@ BEGIN {
   sub DESTROY { my $self = shift; $self->[0]->() }
 }
 
+my $had_error = 0;
+END { $? = $had_error }
 sub ok ($$) {
-  print "not " if !$_[0];
+  $had_error++, print "not " if !$_[0];
   print "ok";
   print " - $_[1]" if defined $_[1];
   print "\n";
@@ -35,14 +37,31 @@ sub ok ($$) {
 
 use Devel::GlobalDestruction;
 
-BEGIN {
-  print "1..2\n";
-  ok !in_global_destruction(), "BEGIN is not GD";
-  my $foo = Test::Scope::Guard->new( sub {
-    ok( !in_global_destruction(), "DESTROY in BEGIN still not GD" ) or do {
-      require POSIX;
-      POSIX::_exit(1);
-    };
+sub check_not_global {
+  my $phase = shift;
+  ok !in_global_destruction(), "$phase is not GD";
+  Test::Scope::Guard->new( sub {
+    ok( !in_global_destruction(), "DESTROY in $phase still not GD" );
   });
 }
 
+BEGIN {
+  print "1..10\n";
+}
+
+BEGIN { check_not_global('BEGIN') }
+
+BEGIN {
+  if (eval 'UNITCHECK {}; 1') {
+    eval q[ UNITCHECK { check_not_global('UNITCHECK') }; 1 ]
+      or die $@;
+  }
+  else {
+    print "ok # UNITCHECK not supported in perl < 5.10\n" x 2;
+  }
+}
+
+CHECK { check_not_global('CHECK') }
+sub CLONE { check_not_global('CLONE') };
+INIT { check_not_global('INIT') }
+END { check_not_global('END') }