Skip error/warn frames within CAG - saner callsite error messages this way
[dbsrgits/DBIx-Class.git] / t / 53lean_startup.t
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
5 my $test_hook;
6 BEGIN {
7   $test_hook = sub {}; # noop at first
8   *CORE::GLOBAL::require = sub {
9     $test_hook->(@_);
10     CORE::require($_[0]);
11   };
12 }
13
14 use strict;
15 use warnings;
16 use Test::More;
17 use Data::Dumper;
18
19 my $expected_core_modules;
20
21 BEGIN {
22   $expected_core_modules = { map { $_ => 1 } qw/
23     strict
24     warnings
25
26     base
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
40     Data::Compare
41
42     DBI
43     SQL::Abstract
44
45     Carp
46
47     Class::Accessor::Grouped
48     Class::C3::Componentised
49   /, $] < 5.010 ? ( 'Class::C3', 'MRO::Compat' ) : () }; # this is special-cased in DBIx/Class.pm
50
51   $test_hook = sub {
52
53     my $req = $_[0];
54     $req =~ s/\.pm$//;
55     $req =~ s/\//::/g;
56
57     return if $req =~ /^DBIx::Class|^DBICTest::/;
58
59     my $up = 1;
60     my @caller;
61     do { @caller = caller($up++) } while (
62       @caller and (
63         # exclude our test suite, known "module require-rs" and eval frames
64         $caller[1] =~ /^ t [\/\\] /x
65           or
66         $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector) $/x
67           or
68         $caller[3] eq '(eval)',
69       )
70     );
71
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 (
75       !$expected_core_modules->{$req}
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       }
92     }
93   };
94 }
95
96 use lib 't/lib';
97 use DBICTest;
98
99 # these envvars bring in more stuff
100 delete $ENV{$_} for qw/
101   DBICTEST_SQLT_DEPLOY
102   DBIC_TRACE
103 /;
104
105 my $schema = DBICTest->init_schema;
106 is ($schema->resultset('Artist')->next->name, 'Caterwauler McCrae');
107
108 # check if anything we were expecting didn't actually load
109 my $nl;
110 for (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
125 done_testing;