Fix building on perls with no . in @INC
[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 -It/lib -MANFANG -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     # a ghetto way of recognizing cperl without loading Config.pm
50     # the $] guard is there because touching $^V on pre-5.10 loads
51     # the entire utf8 stack (wtf!!!)
52     ( "$]" < 5.010 or $^V !~ /\d+c$/ )
53
54       and
55
56     # just don't check anything under RELEASE_TESTING
57     # a naive approach would be to simply whitelist both
58     # strict and warnings, but pre 5.10 there were even
59     # more modules loaded by these two:
60     #
61     #   perlbrew exec perl -Mstrict -Mwarnings -e 'warn join "\n", sort keys %INC'
62     #
63     ! $ENV{RELEASE_TESTING}
64
65       and
66
67     my @undesirables = grep {
68
69       ($INC{$_}||'') ne __FILE__
70
71         and
72
73       # allow direct loads via -M
74       $_ !~ m{^ DBICTest (?: /Schema )? \.pm $}x
75
76     } keys %INC
77
78   ) {
79
80     my ( $fr, @frame );
81     while (@frame = caller(++$fr)) {
82       last if $frame[1] !~ m{ (?: \A | [\/\\] ) t [\/\\] lib [\/\\] }x;
83     }
84
85     die __FILE__ . " must be loaded before any other module (i.e. @{[ join ', ', map { qq('$_') } sort @undesirables ]}) at $frame[1] line $frame[2]\n";
86   }
87
88
89   if ( $ENV{DBICTEST_VERSION_WARNS_INDISCRIMINATELY} ) {
90     my $ov = UNIVERSAL->can("VERSION");
91
92     require Carp;
93
94     # in case we loaded warnings.pm / used -w
95     # ( do not do `no warnings ...` as it is also a load )
96     local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /redefined/ };
97
98     *UNIVERSAL::VERSION = sub {
99       Carp::carp( 'Argument "blah bleh bloh" isn\'t numeric in subroutine entry' );
100       &$ov;
101     };
102   }
103
104
105   if (
106     $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION}
107       or
108     # keep it always on during CI
109     (
110       ($ENV{TRAVIS}||'') eq 'true'
111         and
112       ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$|
113     )
114   ) {
115     # two levels of if() because of taint mode tangling the %ENV-checks
116     # with the require() call, sigh...
117
118     if ( eval { require Try::Tiny } ) {
119       my $orig = \&Try::Tiny::try;
120
121       # in case we loaded warnings.pm / used -w
122       # ( do not do `no warnings ...` as it is also a load )
123       local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /redefined/ };
124
125       *Try::Tiny::try = sub (&;@) {
126         my ($fr, $first_pkg) = 0;
127         while( $first_pkg = caller($fr++) ) {
128           last if $first_pkg !~ /^
129             __ANON__
130               |
131             \Q(eval)\E
132           $/x;
133         }
134
135         if ($first_pkg =~ /DBIx::Class/) {
136           require Test::Builder;
137           Test::Builder->new->ok(0,
138             'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead'
139           );
140         }
141
142         goto $orig;
143       };
144     }
145   }
146 }
147
148
149 unshift @INC, 't/lib';
150
151
152 # everything expects this to be there
153 ! -d 't/var'
154   and
155 (
156   mkdir 't/var'
157     or
158   # creation is inherently racy
159   do {
160     my $err = $!;
161     require Errno;
162     die "Unable to create 't/var': $err\n"
163       unless $err == Errno::EEXIST();
164   }
165 );
166
167
168 # Back in ab340f7f ribasushi stupidly introduced a "did you check your deps"
169 # verification tied very tightly to Module::Install. The check went away, and
170 # so eventually will M::I, but bisecting can bring all of this back from the
171 # dead. In order to reduce hair-pulling make sure that ./inc/ is always there
172 -f 'Makefile.PL' and mkdir 'inc' and mkdir 'inc/.author';
173
174 END {
175   if( my @finalest_tasks = (
176
177     ( !$ENV{DBICTEST_DIRTY_EXIT} ? () : sub {
178
179       my $exit = $?;
180       require POSIX;
181
182       # Crucial flushes in case we are piping things out (e.g. prove)
183       # Otherwise the last lines will never arrive at the receiver
184       close($_) for \*STDOUT, \*STDERR;
185
186       POSIX::_exit($exit);
187     } ),
188
189   )) {
190
191     # in the case of an early skip_all B may very well not have loaded
192     unless( $INC{"B.pm"} ) {
193       local ( $!, $^E, $?, $@ );
194       require B;
195     }
196
197     # Make sure we run after any cleanup in other END blocks
198     # ( push-to-end twice in a row )
199     push @{ B::end_av()->object_2svref }, sub {
200       push @{ B::end_av()->object_2svref }, @finalest_tasks;
201     }
202   }
203 }
204
205 # make absolutely sure this is last
206 $anfang_loaded = 1;