Commit | Line | Data |
c0329273 |
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 | } |
c0329273 |
10 | } |
11 | |
26710bc9 |
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; |
c0329273 |
22 | |
26710bc9 |
23 | # cover even more bases |
24 | $INC{$_} ||= __FILE__ for (qw( ANFANG.pm t/lib/ANFANG.pm ./t/lib/ANFANG.pm )); |
25 | |
26 | { |
c0329273 |
27 | # load-me-first sanity check |
28 | if ( |
29 | |
30 | # nobody shut us off |
31 | ! $ENV{DBICTEST_ANFANG_DEFANG} |
32 | |
33 | and |
34 | |
26710bc9 |
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 | ) |
c0329273 |
41 | |
42 | and |
43 | |
44 | # -d:Confess / -d:TraceUse and the like |
45 | ! $^P |
46 | |
47 | and |
48 | |
64d48e19 |
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 | |
c0329273 |
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 | # not loading warnings.pm |
95 | local $^W = 0; |
96 | |
97 | *UNIVERSAL::VERSION = sub { |
98 | Carp::carp( 'Argument "blah bleh bloh" isn\'t numeric in subroutine entry' ); |
99 | &$ov; |
100 | }; |
101 | } |
102 | |
103 | |
104 | if ( |
105 | $ENV{DBICTEST_ASSERT_NO_SPURIOUS_EXCEPTION_ACTION} |
106 | or |
107 | # keep it always on during CI |
108 | ( |
109 | ($ENV{TRAVIS}||'') eq 'true' |
110 | and |
111 | ($ENV{TRAVIS_REPO_SLUG}||'') =~ m|\w+/dbix-class$| |
112 | ) |
113 | ) { |
114 | require Try::Tiny; |
115 | my $orig = \&Try::Tiny::try; |
116 | |
117 | # not loading warnings.pm |
118 | local $^W = 0; |
119 | |
120 | *Try::Tiny::try = sub (&;@) { |
121 | my ($fr, $first_pkg) = 0; |
122 | while( $first_pkg = caller($fr++) ) { |
123 | last if $first_pkg !~ /^ |
124 | __ANON__ |
125 | | |
126 | \Q(eval)\E |
127 | $/x; |
128 | } |
129 | |
130 | if ($first_pkg =~ /DBIx::Class/) { |
131 | require Test::Builder; |
132 | Test::Builder->new->ok(0, |
133 | 'Using try{} within DBIC internals is a mistake - use dbic_internal_try{} instead' |
134 | ); |
135 | } |
136 | |
137 | goto $orig; |
138 | }; |
139 | } |
c0329273 |
140 | } |
141 | |
26710bc9 |
142 | |
143 | require lib; |
144 | lib->import('t/lib'); |
145 | |
c0329273 |
146 | |
e48635f7 |
147 | # everything expects this to be there |
148 | ! -d 't/var' and ( |
149 | mkdir 't/var' |
150 | or |
151 | die "Unable to create 't/var': $!\n" |
152 | ); |
153 | |
26710bc9 |
154 | |
7b87b77c |
155 | # Back in ab340f7f ribasushi stupidly introduced a "did you check your deps" |
156 | # verification tied very tightly to Module::Install. The check went away, and |
157 | # so eventually will M::I, but bisecting can bring all of this back from the |
158 | # dead. In order to reduce hair-pulling make sure that ./inc/ is always there |
159 | -f 'Makefile.PL' and mkdir 'inc' and mkdir 'inc/.author'; |
160 | |
10dd5c05 |
161 | END { |
162 | if( my @finalest_tasks = ( |
163 | |
164 | ( !$ENV{DBICTEST_DIRTY_EXIT} ? () : sub { |
165 | |
166 | my $exit = $?; |
167 | require POSIX; |
168 | |
169 | # Crucial flushes in case we are piping things out (e.g. prove) |
170 | # Otherwise the last lines will never arrive at the receiver |
2c4abbea |
171 | close($_) for \*STDOUT, \*STDERR; |
10dd5c05 |
172 | |
173 | POSIX::_exit($exit); |
174 | } ), |
175 | |
176 | )) { |
177 | |
178 | # in the case of an early skip_all B may very well not have loaded |
179 | unless( $INC{"B.pm"} ) { |
180 | local ( $!, $^E, $?, $@ ); |
181 | require B; |
182 | } |
183 | |
184 | # Make sure we run after any cleanup in other END blocks |
185 | # ( push-to-end twice in a row ) |
186 | push @{ B::end_av()->object_2svref }, sub { |
187 | push @{ B::end_av()->object_2svref }, @finalest_tasks; |
188 | } |
189 | } |
190 | } |
26710bc9 |
191 | |
192 | # make absolutely sure this is last |
193 | $anfang_loaded = 1; |