t/lib/ANFANG.pm

   1 package # hide from pauses
   2   ANFANG;
   3
   4 # load-time critical
   5 BEGIN {
   6   if ( $ENV{RELEASE_TESTING} ) {
   7     require warnings and warnings->import;
   8     require strict and strict->import;
   9   }
  10
  11   # allow 'use ANFANG' to work after it's been do()ne
  12   $INC{"ANFANG.pm"} ||= __FILE__;
  13   $INC{"t/lib/ANFANG.pm"} ||= __FILE__;
  14   $INC{"./t/lib/ANFANG.pm"} ||= __FILE__;
  15 }
  16
  17 BEGIN {
  18
  19   # load-me-first sanity check
  20   if (
  21
  22     # nobody shut us off
  23     ! $ENV{DBICTEST_ANFANG_DEFANG}
  24
  25       and
  26
  27     # if this is set - all bets are off
  28     ! $ENV{PERL5OPT}
  29
  30       and
  31
  32     # -d:Confess / -d:TraceUse and the like
  33     ! $^P
  34
  35       and
  36
  37     # just don't check anything under RELEASE_TESTING
  38     # a naive approach would be to simply whitelist both
  39     # strict and warnings, but pre 5.10 there were even
  40     # more modules loaded by these two:
  41     #
  42     #   perlbrew exec perl -Mstrict -Mwarnings -e 'warn join "\n", sort keys %INC'
  43     #
  44     ! $ENV{RELEASE_TESTING}
  45
  46       and
  47
  48     my @undesirables = grep {
  49
  50       ($INC{$_}||'') ne __FILE__
  51
  52         and
  53
  54       # allow direct loads via -M
  55       $_ !~ m{^ DBICTest (?: /Schema )? \.pm $}x
  56
  57     } keys %INC
  58
  59   ) {
  60
  61     my ( $fr, @frame );
  62     while (@frame = caller(++$fr)) {
  63       last if $frame[1] !~ m{ (?: \A | [\/\\] ) t [\/\\] lib [\/\\] }x;
  64     }
  65
  66     die __FILE__ . " must be loaded before any other module (i.e. @{[ join ', ', map { qq('$_') } sort @undesirables ]}) at $frame[1] line $frame[2]\n";
  67   }
  68
  69
  70   if ( $ENV{DBICTEST_VERSION_WARNS_INDISCRIMINATELY} ) {
  71     my $ov = UNIVERSAL->can("VERSION");
  72
  73     require Carp;
  74
  75     # not loading warnings.pm
  76     local $^W = 0;
  77
  78     *UNIVERSAL::VERSION = sub {
  79       Carp::carp( 'Argument "blah bleh bloh" isn\'t numeric in subroutine entry' );
  80       &$ov;
  81     };
  82   }
  83
  84
  85   if (
  86     $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION}
  87       or
  88     # keep it always on during CI
  89     (
  90       ($ENV{TRAVIS}||'') eq 'true'
  91         and
  92       ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
  93     )
  94   ) {
  95     require Try::Tiny;
  96     my $orig = \&Try::Tiny::try;
  97
  98     # not loading warnings.pm
  99     local $^W = 0;
 100
 101     *Try::Tiny::try = sub (&;@) {
 102       my ($fr, $first_pkg) = 0;
 103       while( $first_pkg = caller($fr++) ) {
 104         last if $first_pkg !~ /^
 105           __ANON__
 106             |
 107           \Q(eval)\E
 108         $/x;
 109       }
 110
 111       if ($first_pkg =~ /DBIx::Class/) {
 112         require Test::Builder;
 113         Test::Builder->new->ok(0,
 114           'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead'
 115         );
 116       }
 117
 118       goto $orig;
 119     };
 120   }
 121
 122 }
 123
 124 use lib 't/lib';
 125
 126 # Back in ab340f7f ribasushi stupidly introduced a "did you check your deps"
 127 # verification tied very tightly to Module::Install. The check went away, and
 128 # so eventually will M::I, but bisecting can bring all of this back from the
 129 # dead. In order to reduce hair-pulling make sure that ./inc/ is always there
 130 -f 'Makefile.PL' and mkdir 'inc' and mkdir 'inc/.author';
 131
 132 1;