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 |
41 | locale |
42 | |
d6b39e46 |
43 | Devel::GlobalDestruction |
3b80fa31 |
44 | namespace::clean |
45 | Try::Tiny |
9345b14c |
46 | Context::Preserve |
3b80fa31 |
47 | Sub::Name |
48 | |
49 | Scalar::Util |
50 | List::Util |
51 | Hash::Merge |
6a9e3dd5 |
52 | Data::Compare |
3b80fa31 |
53 | |
54 | DBI |
af1f4f84 |
55 | DBI::Const::GetInfoType |
70c28808 |
56 | SQL::Abstract |
3b80fa31 |
57 | |
58 | Carp |
3b80fa31 |
59 | |
60 | Class::Accessor::Grouped |
61 | Class::C3::Componentised |
9345b14c |
62 | Moo |
63 | Sub::Quote |
6a9e3dd5 |
64 | /, $] < 5.010 ? ( 'Class::C3', 'MRO::Compat' ) : () }; # this is special-cased in DBIx/Class.pm |
3b80fa31 |
65 | |
66 | $test_hook = sub { |
67 | |
68 | my $req = $_[0]; |
69 | $req =~ s/\.pm$//; |
70 | $req =~ s/\//::/g; |
71 | |
6a9e3dd5 |
72 | return if $req =~ /^DBIx::Class|^DBICTest::/; |
3b80fa31 |
73 | |
74 | my $up = 1; |
75 | my @caller; |
76 | do { @caller = caller($up++) } while ( |
77 | @caller and ( |
6a9e3dd5 |
78 | # exclude our test suite, known "module require-rs" and eval frames |
79 | $caller[1] =~ /^ t [\/\\] /x |
80 | or |
3b80fa31 |
81 | $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector) $/x |
82 | or |
6a9e3dd5 |
83 | $caller[3] eq '(eval)', |
3b80fa31 |
84 | ) |
85 | ); |
86 | |
6a9e3dd5 |
87 | # exclude everything where the current namespace does not match the called function |
88 | # (this works around very weird XS-induced require callstack corruption) |
89 | if ( |
f873b733 |
90 | !$expected_core_modules->{$req} |
6a9e3dd5 |
91 | and |
92 | @caller |
93 | and |
94 | $caller[0] =~ /^DBIx::Class/ |
95 | and |
96 | (caller($up))[3] =~ /\Q$caller[0]/ |
97 | ) { |
98 | fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])"); |
99 | |
6fec58ca |
100 | diag( 'Require invoked' . stacktrace() ) if $ENV{TEST_VERBOSE}; |
3b80fa31 |
101 | } |
102 | }; |
103 | } |
104 | |
105 | use lib 't/lib'; |
106 | use DBICTest; |
107 | |
108 | # these envvars bring in more stuff |
109 | delete $ENV{$_} for qw/ |
110 | DBICTEST_SQLT_DEPLOY |
111 | DBIC_TRACE |
112 | /; |
113 | |
114 | my $schema = DBICTest->init_schema; |
115 | is ($schema->resultset('Artist')->next->name, 'Caterwauler McCrae'); |
116 | |
f873b733 |
117 | # check if anything we were expecting didn't actually load |
118 | my $nl; |
119 | for (keys %$expected_core_modules) { |
120 | my $mod = "$_.pm"; |
121 | $mod =~ s/::/\//g; |
122 | unless ($INC{$mod}) { |
123 | my $err = sprintf "Expected DBIC core module %s never loaded - %s needs adjustment", $_, __FILE__; |
45638aed |
124 | if (DBICTest::RunMode->is_smoker or DBICTest::RunMode->is_author) { |
f873b733 |
125 | fail ($err) |
126 | } |
127 | else { |
128 | diag "\n" unless $nl++; |
129 | diag $err; |
130 | } |
131 | } |
132 | } |
133 | |
3b80fa31 |
134 | done_testing; |