X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FANFANG.pm;h=e5e603548f3a4ca99275d0f1f4e7617795d3b0a6;hb=e2741c7fd695dca054614f297b01d351a45bbf38;hp=354bc013806bda8a7cfe3d8042bc9c70aa06c46f;hpb=26710bc9ccfc5ffd506c50aff7d7e7a10efe6620;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/lib/ANFANG.pm b/t/lib/ANFANG.pm
index 354bc01..e5e6035 100644
--- a/t/lib/ANFANG.pm
+++ b/t/lib/ANFANG.pm
@@ -46,6 +46,13 @@ $INC{$_} ||= __FILE__ for (qw( ANFANG.pm t/lib/ANFANG.pm ./t/lib/ANFANG.pm ));
 
       and
 
+    # a ghetto way of recognizing cperl without loading Config.pm
+    # the $] guard is there because touching $^V on pre-5.10 loads
+    # the entire utf8 stack (wtf!!!)
+    ( "$]" < 5.010 or $^V !~ /\d+c$/ )
+
+      and
+
     # just don't check anything under RELEASE_TESTING
     # a naive approach would be to simply whitelist both
     # strict and warnings, but pre 5.10 there were even
@@ -84,8 +91,9 @@ $INC{$_} ||= __FILE__ for (qw( ANFANG.pm t/lib/ANFANG.pm ./t/lib/ANFANG.pm ));
 
     require Carp;
 
-    # not loading warnings.pm
-    local $^W = 0;
+    # in case we loaded warnings.pm / used -w
+    # ( do not do `no warnings ...` as it is also a load )
+    local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /redefined/ };
 
     *UNIVERSAL::VERSION = sub {
       Carp::carp( 'Argument "blah bleh bloh" isn\'t numeric in subroutine entry' );
@@ -104,44 +112,56 @@ $INC{$_} ||= __FILE__ for (qw( ANFANG.pm t/lib/ANFANG.pm ./t/lib/ANFANG.pm ));
       ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
     )
   ) {
-    require Try::Tiny;
-    my $orig = \&Try::Tiny::try;
-
-    # not loading warnings.pm
-    local $^W = 0;
-
-    *Try::Tiny::try = sub (&;@) {
-      my ($fr, $first_pkg) = 0;
-      while( $first_pkg = caller($fr++) ) {
-        last if $first_pkg !~ /^
-          __ANON__
-            |
-          \Q(eval)\E
-        $/x;
-      }
-
-      if ($first_pkg =~ /DBIx::Class/) {
-        require Test::Builder;
-        Test::Builder->new->ok(0,
-          'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead'
-        );
-      }
-
-      goto $orig;
-    };
+    # two levels of if() because of taint mode tangling the %ENV-checks
+    # with the require() call, sigh...
+
+    if ( eval { require Try::Tiny } ) {
+      my $orig = \&Try::Tiny::try;
+
+      # in case we loaded warnings.pm / used -w
+      # ( do not do `no warnings ...` as it is also a load )
+      local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /redefined/ };
+
+      *Try::Tiny::try = sub (&;@) {
+        my ($fr, $first_pkg) = 0;
+        while( $first_pkg = caller($fr++) ) {
+          last if $first_pkg !~ /^
+            __ANON__
+              |
+            \Q(eval)\E
+          $/x;
+        }
+
+        if ($first_pkg =~ /DBIx::Class/) {
+          require Test::Builder;
+          Test::Builder->new->ok(0,
+            'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead'
+          );
+        }
+
+        goto $orig;
+      };
+    }
   }
 }
 
 
-require lib;
-lib->import('t/lib');
+unshift @INC, 't/lib';
 
 
 # everything expects this to be there
-! -d 't/var' and (
+! -d 't/var'
+  and
+(
   mkdir 't/var'
     or
-  die "Unable to create 't/var': $!\n"
+  # creation is inherently racy
+  do {
+    my $err = $!;
+    require Errno;
+    die "Unable to create 't/var': $err\n"
+      unless $err == Errno::EEXIST();
+  }
 );
 
 
@@ -151,6 +171,36 @@ lib->import('t/lib');
 # dead. In order to reduce hair-pulling make sure that ./inc/ is always there
 -f 'Makefile.PL' and mkdir 'inc' and mkdir 'inc/.author';
 
+END {
+  if( my @finalest_tasks = (
+
+    ( !$ENV{DBICTEST_DIRTY_EXIT} ? () : sub {
+
+      my $exit = $?;
+      require POSIX;
+
+      # Crucial flushes in case we are piping things out (e.g. prove)
+      # Otherwise the last lines will never arrive at the receiver
+      close($_) for \*STDOUT, \*STDERR;
+
+      POSIX::_exit($exit);
+    } ),
+
+  )) {
+
+    # in the case of an early skip_all B may very well not have loaded
+    unless( $INC{"B.pm"} ) {
+      local ( $!, $^E, $?, $@ );
+      require B;
+    }
+
+    # Make sure we run after any cleanup in other END blocks
+    # ( push-to-end twice in a row )
+    push @{ B::end_av()->object_2svref }, sub {
+      push @{ B::end_av()->object_2svref }, @finalest_tasks;
+    }
+  }
+}
 
 # make absolutely sure this is last
 $anfang_loaded = 1;