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