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;