Reenable 5.10 travis smokes
[dbsrgits/DBIx-Class.git] / t / 53lean_startup.t
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
3
4 my ($initial_inc_contents, $expected_dbic_deps, $require_sites);
5 BEGIN {
6   # these envvars *will* bring in more stuff than the baseline
7   delete @ENV{qw(DBICTEST_SQLT_DEPLOY DBIC_TRACE)};
8
9   unshift @INC, 't/lib';
10   require DBICTest::Util::OverrideRequire;
11
12   DBICTest::Util::OverrideRequire::override_global_require( sub {
13     my $res = $_[0]->();
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
59     return $res;
60   });
61 }
62
63 use strict;
64 use warnings;
65 use Test::More;
66
67 BEGIN {
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   }
81 }
82
83 #######
84 ### This is where the test starts
85 #######
86
87 # checking base schema load, no storage no connection
88 {
89   register_lazy_loadable_requires(qw(
90     B
91     constant
92     overload
93
94     base
95     Devel::GlobalDestruction
96     mro
97
98     Carp
99     namespace::clean
100     Try::Tiny
101     Sub::Name
102
103     Scalar::Util
104     List::Util
105     Data::Compare
106
107     Class::Accessor::Grouped
108     Class::C3::Componentised
109   ));
110
111   require DBICTest::Schema;
112   assert_no_missing_expected_requires();
113 }
114
115 # check schema/storage instantiation with no connect
116 {
117   register_lazy_loadable_requires(qw(
118     Moo
119     Sub::Quote
120     Context::Preserve
121   ));
122
123   my $s = DBICTest::Schema->connect('dbi:SQLite::memory:');
124   ok (! $s->storage->connected, 'no connection');
125   assert_no_missing_expected_requires();
126 }
127
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   });
145
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 }
151
152 # and do full populate() as well, just in case - shouldn't add new stuff
153 {
154   local $ENV{DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER};
155   require DBICTest;
156   my $s = DBICTest->init_schema;
157   is ($s->resultset('Artist')->find(1)->name, 'Caterwauler McCrae');
158   assert_no_missing_expected_requires();
159 }
160
161 done_testing;
162
163 sub register_lazy_loadable_requires {
164   local $Test::Builder::Level = $Test::Builder::Level + 1;
165
166   for my $mod (@_) {
167     (my $modfn = "$mod.pm") =~ s!::!\/!g;
168     fail(join "\n",
169       "Module $mod already loaded by require site(s):",
170       (map { "\t$_" } @{$require_sites->{$mod}}),
171       '',
172     ) if $INC{$modfn} and !$initial_inc_contents->{$mod};
173
174     $expected_dbic_deps->{$mod}++
175   }
176 }
177
178 # check if anything we were expecting didn't actually load
179 sub assert_no_missing_expected_requires {
180   my $nl;
181   for my $mod (keys %$expected_dbic_deps) {
182     (my $modfn = "$mod.pm") =~ s/::/\//g;
183     unless ($INC{$modfn}) {
184       my $err = sprintf "Expected DBIC core dependency '%s' never loaded - %s needs adjustment", $mod, __FILE__;
185       if (DBICTest::RunMode->is_smoker or DBICTest::RunMode->is_author) {
186         fail ($err)
187       }
188       else {
189         diag "\n" unless $nl->{$mod}++;
190         diag $err;
191       }
192     }
193   }
194   pass(sprintf 'All modules expected at %s line %s loaded by DBIC: %s',
195     __FILE__,
196     (caller(0))[2],
197     join (', ', sort keys %$expected_dbic_deps ),
198   ) unless $nl;
199 }