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 BEGIN {
  20   my $core_modules = { map { $_ => 1 } qw/
  21     strict
  22     warnings
  23
  24     base
  25     mro
  26     overload
  27
  28     B
  29     locale
  30
  31     namespace::clean
  32     Try::Tiny
  33     Sub::Name
  34
  35     Scalar::Util
  36     List::Util
  37     Hash::Merge
  38     Data::Compare
  39
  40     DBI
  41     SQL::Abstract
  42
  43     Carp
  44
  45     Class::Accessor::Grouped
  46     Class::C3::Componentised
  47   /, $] < 5.010 ? ( 'Class::C3', 'MRO::Compat' ) : () }; # this is special-cased in DBIx/Class.pm
  48
  49   $test_hook = sub {
  50
  51     my $req = $_[0];
  52     $req =~ s/\.pm$//;
  53     $req =~ s/\//::/g;
  54
  55     return if $req =~ /^DBIx::Class|^DBICTest::/;
  56
  57     my $up = 1;
  58     my @caller;
  59     do { @caller = caller($up++) } while (
  60       @caller and (
  61         # exclude our test suite, known "module require-rs" and eval frames
  62         $caller[1] =~ /^ t [\/\\] /x
  63           or
  64         $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector) $/x
  65           or
  66         $caller[3] eq '(eval)',
  67       )
  68     );
  69
  70     # exclude everything where the current namespace does not match the called function
  71     # (this works around very weird XS-induced require callstack corruption)
  72     if (
  73       !$core_modules->{$req}
  74         and
  75       @caller
  76         and
  77       $caller[0] =~ /^DBIx::Class/
  78         and
  79       (caller($up))[3] =~ /\Q$caller[0]/
  80     ) {
  81       fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])");
  82
  83       if ($ENV{TEST_VERBOSE}) {
  84         my ($i, @stack) = 1;
  85         while (my @f = caller($i++) ) {
  86           push @stack, \@f;
  87         }
  88         diag Dumper(\@stack);
  89       }
  90     }
  91   };
  92 }
  93
  94 use lib 't/lib';
  95 use DBICTest;
  96
  97 # these envvars bring in more stuff
  98 delete $ENV{$_} for qw/
  99   DBICTEST_SQLT_DEPLOY
 100   DBIC_TRACE
 101 /;
 102
 103 my $schema = DBICTest->init_schema;
 104 is ($schema->resultset('Artist')->next->name, 'Caterwauler McCrae');
 105
 106 done_testing;