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