Fix false negatives in lean_startup.t
[dbsrgits/DBIx-Class.git] / xt / extra / lean_startup.t
CommitLineData
3b80fa31 1# Use a require override instead of @INC munging (less common)
2# Do the override as early as possible so that CORE::require doesn't get compiled away
3b80fa31 3
92fbedbc 4BEGIN {
5 if ( $ENV{RELEASE_TESTING} ) {
6 require warnings and warnings->import;
7 require strict and strict->import;
8 }
9}
10
11my ($initial_inc_contents, $expected_dbic_deps, $require_sites, %stack);
3b80fa31 12BEGIN {
45638aed 13 unshift @INC, 't/lib';
14 require DBICTest::Util::OverrideRequire;
15
16 DBICTest::Util::OverrideRequire::override_global_require( sub {
17 my $res = $_[0]->();
8c49cf15 18
92fbedbc 19 return $res if $stack{neutralize_override};
20
8c49cf15 21 my $req = $_[1];
22 $req =~ s/\.pm$//;
23 $req =~ s/\//::/g;
24
25 my $up = 0;
26 my @caller;
92fbedbc 27 do { @caller = CORE::caller($up++) } while (
8c49cf15 28 @caller and (
29 # exclude our test suite, known "module require-rs" and eval frames
92fbedbc 30 $caller[1] =~ / (?: \A | [\/\\] ) x?t [\/\\] /x
8c49cf15 31 or
cc782be2 32 $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector | Module::Runtime | DBIx::Class::Optional::Dependencies ) $/x
8c49cf15 33 or
34 $caller[3] eq '(eval)',
35 )
36 );
37
38 push @{$require_sites->{$req}}, "$caller[1] line $caller[2]"
39 if @caller;
40
41 return $res if $req =~ /^DBIx::Class|^DBICTest::/;
42
e8452b02 43 # Some modules have a bare 'use $perl_version' as the first statement
44 # Since the use() happens before 'package' had a chance to switch
45 # the namespace, the shim thinks DBIC* tried to require this
397056f9 46 return $res if $req =~ /^v?[0-9.]+$/;
92fbedbc 47
8c49cf15 48 if (
49 !$initial_inc_contents->{$req}
50 and
51 !$expected_dbic_deps->{$req}
52 and
53 @caller
54 and
55 $caller[0] =~ /^DBIx::Class/
8c49cf15 56 ) {
92fbedbc 57 local $stack{neutralize_override} = 1;
58
cc782be2 59 # find last-most frame, to feed to T::B below
60 while( CORE::caller(++$up) ) { 1 }
92fbedbc 61
62 require('Test/More.pm');
63 local $Test::Builder::Level = $up + 1;
cc782be2 64
65 # work around the trainwreck that is https://github.com/doy/package-stash-xs/pull/4
66 local $::TODO = 'sigh' if (
67 $INC{'Package/Stash/XS.pm'}
68 and
69 $req eq 'utf8'
70 );
71
8c49cf15 72 Test::More::fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])");
73
cc782be2 74 unless( $::TODO ) {
75 require('DBICTest/Util.pm');
76 Test::More::diag( 'Require invoked' . DBICTest::Util::stacktrace() );
77 }
8c49cf15 78 }
79
45638aed 80 return $res;
81 });
3b80fa31 82}
83
84use strict;
85use warnings;
86use Test::More;
87
45638aed 88BEGIN {
8c49cf15 89 plan skip_all => 'A defined PERL5OPT may inject extra deps crashing this test'
90 if $ENV{PERL5OPT};
91
26710bc9 92 plan skip_all => 'Presence of sitecustomize.pl may inject extra deps crashing this test'
93 if grep { $_ =~ m| \/ sitecustomize\.pl $ |x } keys %INC;
94
8c49cf15 95 plan skip_all => 'Dependency load patterns are radically different before perl 5.10'
750a4ad2 96 if "$]" < 5.010;
8c49cf15 97
26710bc9 98 # these envvars *will* bring in more stuff than the baseline
99 delete @ENV{qw(
100 DBIC_TRACE
58b92e31 101 DBIC_SHUFFLE_UNORDERED_RESULTSETS
26710bc9 102 DBICTEST_SQLT_DEPLOY
92fbedbc 103 DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER
26710bc9 104 DBICTEST_VIA_REPLICATED
105 DBICTEST_DEBUG_CONCURRENCY_LOCKS
106 )};
107
108 $ENV{DBICTEST_ANFANG_DEFANG} = 1;
109
110 # make sure extras do not load even when this is set
111 $ENV{PERL_STRICTURES_EXTRA} = 1;
112
8c49cf15 113 # add what we loaded so far
114 for (keys %INC) {
115 my $mod = $_;
116 $mod =~ s/\.pm$//;
117 $mod =~ s!\/!::!g;
118 $initial_inc_contents->{$mod} = 1;
119 }
45638aed 120}
121
8b60b921 122
8c49cf15 123#######
124### This is where the test starts
125#######
3b80fa31 126
8c49cf15 127# checking base schema load, no storage no connection
128{
129 register_lazy_loadable_requires(qw(
130 B
0d8817bc 131 constant
8c49cf15 132 overload
0d8817bc 133
3b80fa31 134 base
8c49cf15 135 Devel::GlobalDestruction
3b80fa31 136 mro
3b80fa31 137
8c49cf15 138 Carp
3b80fa31 139 namespace::clean
140 Try::Tiny
141 Sub::Name
cbd7f87a 142 Sub::Defer
7f9a3f70 143 Sub::Quote
140bcb6a 144 attributes
3b80fa31 145
146 Scalar::Util
d7d45bdc 147 Storable
3b80fa31 148
3b80fa31 149 Class::Accessor::Grouped
150 Class::C3::Componentised
8c49cf15 151 ));
3b80fa31 152
cc782be2 153 # load Storable ourselves here - there are too many
154 # variations with DynaLoader and XSLoader making testing
155 # for it rather unstable
156 require Storable;
157
92fbedbc 158 require DBIx::Class::Schema;
8c49cf15 159 assert_no_missing_expected_requires();
160}
3b80fa31 161
8c49cf15 162# check schema/storage instantiation with no connect
163{
164 register_lazy_loadable_requires(qw(
165 Moo
cbd7f87a 166 Moo::Object
167 Method::Generate::Accessor
168 Method::Generate::Constructor
8c49cf15 169 Context::Preserve
92fbedbc 170 SQL::Abstract
8c49cf15 171 ));
3b80fa31 172
92fbedbc 173 my $s = DBIx::Class::Schema->connect('dbi:SQLite::memory:');
8c49cf15 174 ok (! $s->storage->connected, 'no connection');
175 assert_no_missing_expected_requires();
176}
3b80fa31 177
8c49cf15 178# do something (deploy, insert)
179{
180 register_lazy_loadable_requires(qw(
181 DBI
8c49cf15 182 Hash::Merge
183 ));
184
92fbedbc 185 {
186 eval <<'EOP' or die $@;
187
188 package DBICTest::Result::Artist;
189
190 use warnings;
191 use strict;
192
193 use base 'DBIx::Class::Core';
194
195 __PACKAGE__->table("artist");
196
197 __PACKAGE__->add_columns(
198 artistid => {
199 data_type => 'integer',
200 is_auto_increment => 1,
201 },
202 name => {
203 data_type => 'varchar',
204 size => 100,
205 is_nullable => 1,
206 },
207 rank => {
208 data_type => 'integer',
209 default_value => 13,
210 },
211 charfield => {
212 data_type => 'char',
213 size => 10,
214 is_nullable => 1,
215 },
216 );
217
218 __PACKAGE__->set_primary_key('artistid');
219 __PACKAGE__->add_unique_constraint(['name']);
220 __PACKAGE__->add_unique_constraint(u_nullable => [qw/charfield rank/]);
221
222 1;
223
224EOP
225 }
226
227 my $s = DBIx::Class::Schema->connect('dbi:SQLite::memory:');
228
229 $s->register_class( Artist => 'DBICTest::Result::Artist' );
230
8c49cf15 231 $s->storage->dbh_do(sub {
232 $_[1]->do('CREATE TABLE artist (
233 "artistid" INTEGER PRIMARY KEY NOT NULL,
234 "name" varchar(100),
235 "rank" integer NOT NULL DEFAULT 13,
236 "charfield" char(10)
237 )');
238 });
3b80fa31 239
8c49cf15 240 my $art = $s->resultset('Artist')->create({ name => \[ '?' => 'foo'], rank => 42 });
241 $art->discard_changes;
242 $art->update({ rank => 69, name => 'foo' });
58b92e31 243 $s->resultset('Artist')->all;
8c49cf15 244 assert_no_missing_expected_requires();
245}
6a9e3dd5 246
92fbedbc 247
248# and do full DBICTest based populate() as well, just in case - shouldn't add new stuff
8c49cf15 249{
92fbedbc 250 # DBICTest needs File::Spec, but older versions of Storable load it alread
251 # Instead of adding a contrived conditional, just preempt the testing entirely
252 require File::Spec;
253
254 require DBICTest;
255 DBICTest->import;
256
8c49cf15 257 my $s = DBICTest->init_schema;
92fbedbc 258 is ($s->resultset('Artist')->find(1)->name, 'Caterwauler McCrae', 'Expected find() result');
3b80fa31 259}
260
8c49cf15 261done_testing;
92fbedbc 262# one final quiet guard to run at all times
263END { assert_no_missing_expected_requires('quiet') };
3b80fa31 264
8c49cf15 265sub register_lazy_loadable_requires {
266 local $Test::Builder::Level = $Test::Builder::Level + 1;
3b80fa31 267
8c49cf15 268 for my $mod (@_) {
269 (my $modfn = "$mod.pm") =~ s!::!\/!g;
270 fail(join "\n",
271 "Module $mod already loaded by require site(s):",
272 (map { "\t$_" } @{$require_sites->{$mod}}),
273 '',
274 ) if $INC{$modfn} and !$initial_inc_contents->{$mod};
275
276 $expected_dbic_deps->{$mod}++
277 }
278}
3b80fa31 279
f873b733 280# check if anything we were expecting didn't actually load
8c49cf15 281sub assert_no_missing_expected_requires {
92fbedbc 282 my $quiet = shift;
283
8c49cf15 284 for my $mod (keys %$expected_dbic_deps) {
285 (my $modfn = "$mod.pm") =~ s/::/\//g;
554484cb 286 fail sprintf (
287 "Expected DBIC core dependency '%s' never loaded - %s needs adjustment",
288 $mod,
289 __FILE__
290 ) unless $INC{$modfn};
f873b733 291 }
92fbedbc 292
8c49cf15 293 pass(sprintf 'All modules expected at %s line %s loaded by DBIC: %s',
294 __FILE__,
295 (caller(0))[2],
296 join (', ', sort keys %$expected_dbic_deps ),
92fbedbc 297 ) unless $quiet;
f873b733 298}