Commit | Line | Data |
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 |
45638aed |
3 | # We will add the hook in a bit, got to load some regular stuff |
3b80fa31 |
4 | |
5 | my $test_hook; |
6 | BEGIN { |
45638aed |
7 | unshift @INC, 't/lib'; |
8 | require DBICTest::Util::OverrideRequire; |
9 | |
10 | DBICTest::Util::OverrideRequire::override_global_require( sub { |
11 | my $res = $_[0]->(); |
12 | $test_hook->($_[1]) if $test_hook; |
13 | return $res; |
14 | }); |
3b80fa31 |
15 | } |
16 | |
17 | use strict; |
18 | use warnings; |
19 | use Test::More; |
6fec58ca |
20 | use DBICTest::Util 'stacktrace'; |
3b80fa31 |
21 | |
45638aed |
22 | # Package::Stash::XS is silly and fails if a require hook contains regular |
23 | # expressions on perl < 5.8.7. Load the damned thing if the case |
24 | BEGIN { |
25 | require Package::Stash if $] < 5.008007; |
26 | } |
27 | |
f873b733 |
28 | my $expected_core_modules; |
29 | |
3b80fa31 |
30 | BEGIN { |
f873b733 |
31 | $expected_core_modules = { map { $_ => 1 } qw/ |
3b80fa31 |
32 | strict |
33 | warnings |
3b80fa31 |
34 | |
35 | base |
3b80fa31 |
36 | mro |
37 | overload |
6fec58ca |
38 | Exporter |
3b80fa31 |
39 | |
40 | B |
d6b39e46 |
41 | Devel::GlobalDestruction |
3b80fa31 |
42 | namespace::clean |
43 | Try::Tiny |
9345b14c |
44 | Context::Preserve |
3b80fa31 |
45 | Sub::Name |
46 | |
47 | Scalar::Util |
48 | List::Util |
49 | Hash::Merge |
6a9e3dd5 |
50 | Data::Compare |
3b80fa31 |
51 | |
52 | DBI |
af1f4f84 |
53 | DBI::Const::GetInfoType |
70c28808 |
54 | SQL::Abstract |
3b80fa31 |
55 | |
56 | Carp |
3b80fa31 |
57 | |
58 | Class::Accessor::Grouped |
59 | Class::C3::Componentised |
9345b14c |
60 | Moo |
61 | Sub::Quote |
6a9e3dd5 |
62 | /, $] < 5.010 ? ( 'Class::C3', 'MRO::Compat' ) : () }; # this is special-cased in DBIx/Class.pm |
3b80fa31 |
63 | |
64 | $test_hook = sub { |
65 | |
66 | my $req = $_[0]; |
67 | $req =~ s/\.pm$//; |
68 | $req =~ s/\//::/g; |
69 | |
6a9e3dd5 |
70 | return if $req =~ /^DBIx::Class|^DBICTest::/; |
3b80fa31 |
71 | |
72 | my $up = 1; |
73 | my @caller; |
74 | do { @caller = caller($up++) } while ( |
75 | @caller and ( |
6a9e3dd5 |
76 | # exclude our test suite, known "module require-rs" and eval frames |
77 | $caller[1] =~ /^ t [\/\\] /x |
78 | or |
3b80fa31 |
79 | $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector) $/x |
80 | or |
6a9e3dd5 |
81 | $caller[3] eq '(eval)', |
3b80fa31 |
82 | ) |
83 | ); |
84 | |
6a9e3dd5 |
85 | # exclude everything where the current namespace does not match the called function |
86 | # (this works around very weird XS-induced require callstack corruption) |
87 | if ( |
f873b733 |
88 | !$expected_core_modules->{$req} |
6a9e3dd5 |
89 | and |
90 | @caller |
91 | and |
92 | $caller[0] =~ /^DBIx::Class/ |
93 | and |
94 | (caller($up))[3] =~ /\Q$caller[0]/ |
95 | ) { |
96 | fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])"); |
97 | |
6fec58ca |
98 | diag( 'Require invoked' . stacktrace() ) if $ENV{TEST_VERBOSE}; |
3b80fa31 |
99 | } |
100 | }; |
101 | } |
102 | |
103 | use lib 't/lib'; |
104 | use DBICTest; |
105 | |
106 | # these envvars bring in more stuff |
107 | delete $ENV{$_} for qw/ |
108 | DBICTEST_SQLT_DEPLOY |
109 | DBIC_TRACE |
110 | /; |
111 | |
112 | my $schema = DBICTest->init_schema; |
113 | is ($schema->resultset('Artist')->next->name, 'Caterwauler McCrae'); |
114 | |
f873b733 |
115 | # check if anything we were expecting didn't actually load |
116 | my $nl; |
117 | for (keys %$expected_core_modules) { |
118 | my $mod = "$_.pm"; |
119 | $mod =~ s/::/\//g; |
120 | unless ($INC{$mod}) { |
121 | my $err = sprintf "Expected DBIC core module %s never loaded - %s needs adjustment", $_, __FILE__; |
45638aed |
122 | if (DBICTest::RunMode->is_smoker or DBICTest::RunMode->is_author) { |
f873b733 |
123 | fail ($err) |
124 | } |
125 | else { |
126 | diag "\n" unless $nl++; |
127 | diag $err; |
128 | } |
129 | } |
130 | } |
131 | |
3b80fa31 |
132 | done_testing; |