Added support for handling Class::DBI::Column in CDBICompat
[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
7f9a3f70 102 Sub::Quote
3b80fa31 103
104 Scalar::Util
105 List::Util
6a9e3dd5 106 Data::Compare
3b80fa31 107
3b80fa31 108 Class::Accessor::Grouped
109 Class::C3::Componentised
b5ce6748 110 SQL::Abstract
d0435d75 111
112 Module::Runtime
113 File::Spec
8c49cf15 114 ));
3b80fa31 115
8c49cf15 116 require DBICTest::Schema;
117 assert_no_missing_expected_requires();
118}
3b80fa31 119
8c49cf15 120# check schema/storage instantiation with no connect
121{
122 register_lazy_loadable_requires(qw(
123 Moo
8c49cf15 124 Context::Preserve
125 ));
3b80fa31 126
8c49cf15 127 my $s = DBICTest::Schema->connect('dbi:SQLite::memory:');
128 ok (! $s->storage->connected, 'no connection');
129 assert_no_missing_expected_requires();
130}
3b80fa31 131
8c49cf15 132# do something (deploy, insert)
133{
134 register_lazy_loadable_requires(qw(
135 DBI
8c49cf15 136 Hash::Merge
137 ));
138
139 my $s = DBICTest::Schema->connect('dbi:SQLite::memory:');
140 $s->storage->dbh_do(sub {
141 $_[1]->do('CREATE TABLE artist (
142 "artistid" INTEGER PRIMARY KEY NOT NULL,
143 "name" varchar(100),
144 "rank" integer NOT NULL DEFAULT 13,
145 "charfield" char(10)
146 )');
147 });
3b80fa31 148
8c49cf15 149 my $art = $s->resultset('Artist')->create({ name => \[ '?' => 'foo'], rank => 42 });
150 $art->discard_changes;
151 $art->update({ rank => 69, name => 'foo' });
152 assert_no_missing_expected_requires();
153}
6a9e3dd5 154
8c49cf15 155# and do full populate() as well, just in case - shouldn't add new stuff
156{
4a24dba9 157 local $ENV{DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER};
5e724964 158 {
159 # in general we do not want DBICTest to load before sqla, but it is
160 # ok to cheat here
161 local $INC{'SQL/Abstract.pm'};
162 require DBICTest;
163 }
8c49cf15 164 my $s = DBICTest->init_schema;
fb88ca2c 165 is ($s->resultset('Artist')->find(1)->name, 'Caterwauler McCrae');
8c49cf15 166 assert_no_missing_expected_requires();
3b80fa31 167}
168
8c49cf15 169done_testing;
3b80fa31 170
8c49cf15 171sub register_lazy_loadable_requires {
172 local $Test::Builder::Level = $Test::Builder::Level + 1;
3b80fa31 173
8c49cf15 174 for my $mod (@_) {
175 (my $modfn = "$mod.pm") =~ s!::!\/!g;
176 fail(join "\n",
177 "Module $mod already loaded by require site(s):",
178 (map { "\t$_" } @{$require_sites->{$mod}}),
179 '',
180 ) if $INC{$modfn} and !$initial_inc_contents->{$mod};
181
182 $expected_dbic_deps->{$mod}++
183 }
184}
3b80fa31 185
f873b733 186# check if anything we were expecting didn't actually load
8c49cf15 187sub assert_no_missing_expected_requires {
188 my $nl;
189 for my $mod (keys %$expected_dbic_deps) {
190 (my $modfn = "$mod.pm") =~ s/::/\//g;
191 unless ($INC{$modfn}) {
192 my $err = sprintf "Expected DBIC core dependency '%s' never loaded - %s needs adjustment", $mod, __FILE__;
193 if (DBICTest::RunMode->is_smoker or DBICTest::RunMode->is_author) {
194 fail ($err)
195 }
196 else {
197 diag "\n" unless $nl->{$mod}++;
198 diag $err;
199 }
f873b733 200 }
201 }
8c49cf15 202 pass(sprintf 'All modules expected at %s line %s loaded by DBIC: %s',
203 __FILE__,
204 (caller(0))[2],
205 join (', ', sort keys %$expected_dbic_deps ),
206 ) unless $nl;
f873b733 207}