Skip error/warn frames within CAG - saner callsite error messages this way
[dbsrgits/DBIx-Class.git] / t / 53lean_startup.t
CommitLineData
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
3# We will replace $req_override in a bit
4
5my $test_hook;
6BEGIN {
7 $test_hook = sub {}; # noop at first
8 *CORE::GLOBAL::require = sub {
9 $test_hook->(@_);
10 CORE::require($_[0]);
11 };
12}
13
14use strict;
15use warnings;
16use Test::More;
6a9e3dd5 17use Data::Dumper;
3b80fa31 18
f873b733 19my $expected_core_modules;
20
3b80fa31 21BEGIN {
f873b733 22 $expected_core_modules = { map { $_ => 1 } qw/
3b80fa31 23 strict
24 warnings
3b80fa31 25
26 base
3b80fa31 27 mro
28 overload
29
30 B
31 locale
32
33 namespace::clean
34 Try::Tiny
35 Sub::Name
36
37 Scalar::Util
38 List::Util
39 Hash::Merge
6a9e3dd5 40 Data::Compare
3b80fa31 41
42 DBI
70c28808 43 SQL::Abstract
3b80fa31 44
45 Carp
3b80fa31 46
47 Class::Accessor::Grouped
48 Class::C3::Componentised
6a9e3dd5 49 /, $] < 5.010 ? ( 'Class::C3', 'MRO::Compat' ) : () }; # this is special-cased in DBIx/Class.pm
3b80fa31 50
51 $test_hook = sub {
52
53 my $req = $_[0];
54 $req =~ s/\.pm$//;
55 $req =~ s/\//::/g;
56
6a9e3dd5 57 return if $req =~ /^DBIx::Class|^DBICTest::/;
3b80fa31 58
59 my $up = 1;
60 my @caller;
61 do { @caller = caller($up++) } while (
62 @caller and (
6a9e3dd5 63 # exclude our test suite, known "module require-rs" and eval frames
64 $caller[1] =~ /^ t [\/\\] /x
65 or
3b80fa31 66 $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector) $/x
67 or
6a9e3dd5 68 $caller[3] eq '(eval)',
3b80fa31 69 )
70 );
71
6a9e3dd5 72 # exclude everything where the current namespace does not match the called function
73 # (this works around very weird XS-induced require callstack corruption)
74 if (
f873b733 75 !$expected_core_modules->{$req}
6a9e3dd5 76 and
77 @caller
78 and
79 $caller[0] =~ /^DBIx::Class/
80 and
81 (caller($up))[3] =~ /\Q$caller[0]/
82 ) {
83 fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])");
84
85 if ($ENV{TEST_VERBOSE}) {
86 my ($i, @stack) = 1;
87 while (my @f = caller($i++) ) {
88 push @stack, \@f;
89 }
90 diag Dumper(\@stack);
91 }
3b80fa31 92 }
93 };
94}
95
96use lib 't/lib';
97use DBICTest;
98
99# these envvars bring in more stuff
100delete $ENV{$_} for qw/
101 DBICTEST_SQLT_DEPLOY
102 DBIC_TRACE
103/;
104
105my $schema = DBICTest->init_schema;
106is ($schema->resultset('Artist')->next->name, 'Caterwauler McCrae');
107
f873b733 108# check if anything we were expecting didn't actually load
109my $nl;
110for (keys %$expected_core_modules) {
111 my $mod = "$_.pm";
112 $mod =~ s/::/\//g;
113 unless ($INC{$mod}) {
114 my $err = sprintf "Expected DBIC core module %s never loaded - %s needs adjustment", $_, __FILE__;
115 if (DBICTest::RunMode->is_smoker) {
116 fail ($err)
117 }
118 else {
119 diag "\n" unless $nl++;
120 diag $err;
121 }
122 }
123}
124
3b80fa31 125done_testing;