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; |
6a9e3dd5 |
20 | use Data::Dumper; |
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 |
38 | |
39 | B |
40 | locale |
41 | |
42 | namespace::clean |
43 | Try::Tiny |
44 | Sub::Name |
45 | |
46 | Scalar::Util |
47 | List::Util |
48 | Hash::Merge |
6a9e3dd5 |
49 | Data::Compare |
3b80fa31 |
50 | |
51 | DBI |
70c28808 |
52 | SQL::Abstract |
3b80fa31 |
53 | |
54 | Carp |
3b80fa31 |
55 | |
56 | Class::Accessor::Grouped |
57 | Class::C3::Componentised |
6a9e3dd5 |
58 | /, $] < 5.010 ? ( 'Class::C3', 'MRO::Compat' ) : () }; # this is special-cased in DBIx/Class.pm |
3b80fa31 |
59 | |
60 | $test_hook = sub { |
61 | |
62 | my $req = $_[0]; |
63 | $req =~ s/\.pm$//; |
64 | $req =~ s/\//::/g; |
65 | |
6a9e3dd5 |
66 | return if $req =~ /^DBIx::Class|^DBICTest::/; |
3b80fa31 |
67 | |
68 | my $up = 1; |
69 | my @caller; |
70 | do { @caller = caller($up++) } while ( |
71 | @caller and ( |
6a9e3dd5 |
72 | # exclude our test suite, known "module require-rs" and eval frames |
73 | $caller[1] =~ /^ t [\/\\] /x |
74 | or |
3b80fa31 |
75 | $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector) $/x |
76 | or |
6a9e3dd5 |
77 | $caller[3] eq '(eval)', |
3b80fa31 |
78 | ) |
79 | ); |
80 | |
6a9e3dd5 |
81 | # exclude everything where the current namespace does not match the called function |
82 | # (this works around very weird XS-induced require callstack corruption) |
83 | if ( |
f873b733 |
84 | !$expected_core_modules->{$req} |
6a9e3dd5 |
85 | and |
86 | @caller |
87 | and |
88 | $caller[0] =~ /^DBIx::Class/ |
89 | and |
90 | (caller($up))[3] =~ /\Q$caller[0]/ |
91 | ) { |
92 | fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])"); |
93 | |
8273e845 |
94 | if ($ENV{TEST_VERBOSE}) { |
6a9e3dd5 |
95 | my ($i, @stack) = 1; |
96 | while (my @f = caller($i++) ) { |
97 | push @stack, \@f; |
98 | } |
99 | diag Dumper(\@stack); |
100 | } |
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; |