Remove warning introduced in 75a1d824 (cherry-pick of cff17b97)
[dbsrgits/DBIx-Class.git] / t / 53lean_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
8c49cf15 4my ($initial_inc_contents, $expected_dbic_deps, $require_sites);
3b80fa31 5BEGIN {
8c49cf15 6 # these envvars *will* bring in more stuff than the baseline
7 delete @ENV{qw(DBICTEST_SQLT_DEPLOY DBIC_TRACE)};
8
45638aed 9 unshift @INC, 't/lib';
10 require DBICTest::Util::OverrideRequire;
11
12 DBICTest::Util::OverrideRequire::override_global_require( sub {
13 my $res = $_[0]->();
8c49cf15 14
15 my $req = $_[1];
16 $req =~ s/\.pm$//;
17 $req =~ s/\//::/g;
18
19 my $up = 0;
20 my @caller;
21 do { @caller = caller($up++) } while (
22 @caller and (
23 # exclude our test suite, known "module require-rs" and eval frames
24 $caller[1] =~ /^ t [\/\\] /x
25 or
26 $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector | Module::Runtime ) $/x
27 or
28 $caller[3] eq '(eval)',
29 )
30 );
31
32 push @{$require_sites->{$req}}, "$caller[1] line $caller[2]"
33 if @caller;
34
35 return $res if $req =~ /^DBIx::Class|^DBICTest::/;
36
37 # exclude everything where the current namespace does not match the called function
38 # (this works around very weird XS-induced require callstack corruption)
39 if (
40 !$initial_inc_contents->{$req}
41 and
42 !$expected_dbic_deps->{$req}
43 and
44 @caller
45 and
46 $caller[0] =~ /^DBIx::Class/
47 and
48 (caller($up))[3] =~ /\Q$caller[0]/
49 ) {
50 CORE::require('Test/More.pm');
51 Test::More::fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])");
52
53 if ($ENV{TEST_VERBOSE}) {
54 CORE::require('DBICTest/Util.pm');
55 Test::More::diag( 'Require invoked' . DBICTest::Util::stacktrace() );
56 }
57 }
58
45638aed 59 return $res;
60 });
3b80fa31 61}
62
63use strict;
64use warnings;
65use Test::More;
66
45638aed 67BEGIN {
8c49cf15 68 plan skip_all => 'A defined PERL5OPT may inject extra deps crashing this test'
69 if $ENV{PERL5OPT};
70
71 plan skip_all => 'Dependency load patterns are radically different before perl 5.10'
72 if $] < 5.010;
73
74 # add what we loaded so far
75 for (keys %INC) {
76 my $mod = $_;
77 $mod =~ s/\.pm$//;
78 $mod =~ s!\/!::!g;
79 $initial_inc_contents->{$mod} = 1;
80 }
45638aed 81}
82
8c49cf15 83#######
84### This is where the test starts
85#######
3b80fa31 86
8c49cf15 87# checking base schema load, no storage no connection
88{
89 register_lazy_loadable_requires(qw(
90 B
0d8817bc 91 constant
8c49cf15 92 overload
0d8817bc 93
3b80fa31 94 base
8c49cf15 95 Devel::GlobalDestruction
3b80fa31 96 mro
3b80fa31 97
8c49cf15 98 Carp
3b80fa31 99 namespace::clean
100 Try::Tiny
101 Sub::Name
102
103 Scalar::Util
104 List::Util
6a9e3dd5 105 Data::Compare
3b80fa31 106
3b80fa31 107 Class::Accessor::Grouped
108 Class::C3::Componentised
8c49cf15 109 ));
3b80fa31 110
8c49cf15 111 require DBICTest::Schema;
112 assert_no_missing_expected_requires();
113}
3b80fa31 114
8c49cf15 115# check schema/storage instantiation with no connect
116{
117 register_lazy_loadable_requires(qw(
118 Moo
119 Sub::Quote
120 Context::Preserve
121 ));
3b80fa31 122
8c49cf15 123 my $s = DBICTest::Schema->connect('dbi:SQLite::memory:');
124 ok (! $s->storage->connected, 'no connection');
125 assert_no_missing_expected_requires();
126}
3b80fa31 127
8c49cf15 128# do something (deploy, insert)
129{
130 register_lazy_loadable_requires(qw(
131 DBI
132 SQL::Abstract
133 Hash::Merge
134 ));
135
136 my $s = DBICTest::Schema->connect('dbi:SQLite::memory:');
137 $s->storage->dbh_do(sub {
138 $_[1]->do('CREATE TABLE artist (
139 "artistid" INTEGER PRIMARY KEY NOT NULL,
140 "name" varchar(100),
141 "rank" integer NOT NULL DEFAULT 13,
142 "charfield" char(10)
143 )');
144 });
3b80fa31 145
8c49cf15 146 my $art = $s->resultset('Artist')->create({ name => \[ '?' => 'foo'], rank => 42 });
147 $art->discard_changes;
148 $art->update({ rank => 69, name => 'foo' });
149 assert_no_missing_expected_requires();
150}
6a9e3dd5 151
8c49cf15 152# and do full populate() as well, just in case - shouldn't add new stuff
153{
4a24dba9 154 local $ENV{DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER};
5e724964 155 {
156 # in general we do not want DBICTest to load before sqla, but it is
157 # ok to cheat here
158 local $INC{'SQL/Abstract.pm'};
159 require DBICTest;
160 }
8c49cf15 161 my $s = DBICTest->init_schema;
fb88ca2c 162 is ($s->resultset('Artist')->find(1)->name, 'Caterwauler McCrae');
8c49cf15 163 assert_no_missing_expected_requires();
3b80fa31 164}
165
8c49cf15 166done_testing;
3b80fa31 167
8c49cf15 168sub register_lazy_loadable_requires {
169 local $Test::Builder::Level = $Test::Builder::Level + 1;
3b80fa31 170
8c49cf15 171 for my $mod (@_) {
172 (my $modfn = "$mod.pm") =~ s!::!\/!g;
173 fail(join "\n",
174 "Module $mod already loaded by require site(s):",
175 (map { "\t$_" } @{$require_sites->{$mod}}),
176 '',
177 ) if $INC{$modfn} and !$initial_inc_contents->{$mod};
178
179 $expected_dbic_deps->{$mod}++
180 }
181}
3b80fa31 182
f873b733 183# check if anything we were expecting didn't actually load
8c49cf15 184sub assert_no_missing_expected_requires {
185 my $nl;
186 for my $mod (keys %$expected_dbic_deps) {
187 (my $modfn = "$mod.pm") =~ s/::/\//g;
188 unless ($INC{$modfn}) {
189 my $err = sprintf "Expected DBIC core dependency '%s' never loaded - %s needs adjustment", $mod, __FILE__;
190 if (DBICTest::RunMode->is_smoker or DBICTest::RunMode->is_author) {
191 fail ($err)
192 }
193 else {
194 diag "\n" unless $nl->{$mod}++;
195 diag $err;
196 }
f873b733 197 }
198 }
8c49cf15 199 pass(sprintf 'All modules expected at %s line %s loaded by DBIC: %s',
200 __FILE__,
201 (caller(0))[2],
202 join (', ', sort keys %$expected_dbic_deps ),
203 ) unless $nl;
f873b733 204}