(travis) Strangely `cpan .` does not work in certain configs
[dbsrgits/DBIx-Class.git] / 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
12 #
13 # FROM THIS POINT ONWARD EVERYTHING HAPPENS LINEARLY AT RUNTIME
14 #
15 our $anfang_loaded;
16
17 # this allows the obscure but possible call case to behave correctly:
18 #
19 #   perl -Mt::lib::ANFANG -e 'do "./t/lib/ANFANG.pm" or die ( $@ || $! )'
20 #
21 return 1 if $anfang_loaded;
22
23 # cover even more bases
24 $INC{$_} ||= __FILE__ for (qw( ANFANG.pm t/lib/ANFANG.pm ./t/lib/ANFANG.pm ));
25
26 {
27   # load-me-first sanity check
28   if (
29
30     # nobody shut us off
31     ! $ENV{DBICTEST_ANFANG_DEFANG}
32
33       and
34
35     # if these are set - all bets are off
36     ! (
37       $ENV{PERL5OPT}
38         or
39       scalar grep { $_ =~ m| \/ sitecustomize\.pl $ |x } keys %INC
40     )
41
42       and
43
44     # -d:Confess / -d:TraceUse and the like
45     ! $^P
46
47       and
48
49     # just don't check anything under RELEASE_TESTING
50     # a naive approach would be to simply whitelist both
51     # strict and warnings, but pre 5.10 there were even
52     # more modules loaded by these two:
53     #
54     #   perlbrew exec perl -Mstrict -Mwarnings -e 'warn join "\n", sort keys %INC'
55     #
56     ! $ENV{RELEASE_TESTING}
57
58       and
59
60     my @undesirables = grep {
61
62       ($INC{$_}||'') ne __FILE__
63
64         and
65
66       # allow direct loads via -M
67       $_ !~ m{^ DBICTest (?: /Schema )? \.pm $}x
68
69     } keys %INC
70
71   ) {
72
73     my ( $fr, @frame );
74     while (@frame = caller(++$fr)) {
75       last if $frame[1] !~ m{ (?: \A | [\/\\] ) t [\/\\] lib [\/\\] }x;
76     }
77
78     die __FILE__ . " must be loaded before any other module (i.e. @{[ join ', ', map { qq('$_') } sort @undesirables ]}) at $frame[1] line $frame[2]\n";
79   }
80
81
82   if ( $ENV{DBICTEST_VERSION_WARNS_INDISCRIMINATELY} ) {
83     my $ov = UNIVERSAL->can("VERSION");
84
85     require Carp;
86
87     # not loading warnings.pm
88     local $^W = 0;
89
90     *UNIVERSAL::VERSION = sub {
91       Carp::carp( 'Argument "blah bleh bloh" isn\'t numeric in subroutine entry' );
92       &$ov;
93     };
94   }
95
96
97   if (
98     $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION}
99       or
100     # keep it always on during CI
101     (
102       ($ENV{TRAVIS}||'') eq 'true'
103         and
104       ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
105     )
106   ) {
107     require Try::Tiny;
108     my $orig = \&Try::Tiny::try;
109
110     # not loading warnings.pm
111     local $^W = 0;
112
113     *Try::Tiny::try = sub (&;@) {
114       my ($fr, $first_pkg) = 0;
115       while( $first_pkg = caller($fr++) ) {
116         last if $first_pkg !~ /^
117           __ANON__
118             |
119           \Q(eval)\E
120         $/x;
121       }
122
123       if ($first_pkg =~ /DBIx::Class/) {
124         require Test::Builder;
125         Test::Builder->new->ok(0,
126           'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead'
127         );
128       }
129
130       goto $orig;
131     };
132   }
133 }
134
135
136 require lib;
137 lib->import('t/lib');
138
139
140 # everything expects this to be there
141 ! -d 't/var' and (
142   mkdir 't/var'
143     or
144   die "Unable to create 't/var': $!\n"
145 );
146
147
148 # Back in ab340f7f ribasushi stupidly introduced a "did you check your deps"
149 # verification tied very tightly to Module::Install. The check went away, and
150 # so eventually will M::I, but bisecting can bring all of this back from the
151 # dead. In order to reduce hair-pulling make sure that ./inc/ is always there
152 -f 'Makefile.PL' and mkdir 'inc' and mkdir 'inc/.author';
153
154 END {
155   if( my @finalest_tasks = (
156
157     ( !$ENV{DBICTEST_DIRTY_EXIT} ? () : sub {
158
159       my $exit = $?;
160       require POSIX;
161
162       # Crucial flushes in case we are piping things out (e.g. prove)
163       # Otherwise the last lines will never arrive at the receiver
164       close($_) for \*STDOUT, \*STDERR;
165
166       POSIX::_exit($exit);
167     } ),
168
169   )) {
170
171     # in the case of an early skip_all B may very well not have loaded
172     unless( $INC{"B.pm"} ) {
173       local ( $!, $^E, $?, $@ );
174       require B;
175     }
176
177     # Make sure we run after any cleanup in other END blocks
178     # ( push-to-end twice in a row )
179     push @{ B::end_av()->object_2svref }, sub {
180       push @{ B::end_av()->object_2svref }, @finalest_tasks;
181     }
182   }
183 }
184
185 # make absolutely sure this is last
186 $anfang_loaded = 1;