X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F53lean_startup.t;h=6c00ff605614a00ae4a43e0608eb11af34b579bb;hb=d6b39e463d43250ea171fa983b2364227172266f;hp=0054f035ba80275fe60ef69c93906205a7f271da;hpb=6a9e3dd5169417bc25cb531cd9a52b80c4ca50bb;p=dbsrgits%2FDBIx-Class.git diff --git a/t/53lean_startup.t b/t/53lean_startup.t index 0054f03..6c00ff6 100644 --- a/t/53lean_startup.t +++ b/t/53lean_startup.t @@ -1,35 +1,49 @@ # Use a require override instead of @INC munging (less common) # Do the override as early as possible so that CORE::require doesn't get compiled away -# We will replace $req_override in a bit +# We will add the hook in a bit, got to load some regular stuff my $test_hook; BEGIN { - $test_hook = sub {}; # noop at first - *CORE::GLOBAL::require = sub { - $test_hook->(@_); - CORE::require($_[0]); - }; + unshift @INC, 't/lib'; + require DBICTest::Util::OverrideRequire; + + DBICTest::Util::OverrideRequire::override_global_require( sub { + my $res = $_[0]->(); + $test_hook->($_[1]) if $test_hook; + return $res; + }); } use strict; use warnings; use Test::More; -use Data::Dumper; +use DBICTest::Util 'stacktrace'; + +# Package::Stash::XS is silly and fails if a require hook contains regular +# expressions on perl < 5.8.7. Load the damned thing if the case +BEGIN { + require Package::Stash if $] < 5.008007; +} + +my $expected_core_modules; BEGIN { - my $core_modules = { map { $_ => 1 } qw/ + $expected_core_modules = { map { $_ => 1 } qw/ strict warnings base mro overload + Exporter B locale + Devel::GlobalDestruction namespace::clean Try::Tiny + Context::Preserve Sub::Name Scalar::Util @@ -38,12 +52,15 @@ BEGIN { Data::Compare DBI + DBI::Const::GetInfoType SQL::Abstract Carp Class::Accessor::Grouped Class::C3::Componentised + Moo + Sub::Quote /, $] < 5.010 ? ( 'Class::C3', 'MRO::Compat' ) : () }; # this is special-cased in DBIx/Class.pm $test_hook = sub { @@ -70,7 +87,7 @@ BEGIN { # exclude everything where the current namespace does not match the called function # (this works around very weird XS-induced require callstack corruption) if ( - !$core_modules->{$req} + !$expected_core_modules->{$req} and @caller and @@ -80,13 +97,7 @@ BEGIN { ) { fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])"); - if ($ENV{TEST_VERBOSE}) { - my ($i, @stack) = 1; - while (my @f = caller($i++) ) { - push @stack, \@f; - } - diag Dumper(\@stack); - } + diag( 'Require invoked' . stacktrace() ) if $ENV{TEST_VERBOSE}; } }; } @@ -103,4 +114,21 @@ delete $ENV{$_} for qw/ my $schema = DBICTest->init_schema; is ($schema->resultset('Artist')->next->name, 'Caterwauler McCrae'); +# check if anything we were expecting didn't actually load +my $nl; +for (keys %$expected_core_modules) { + my $mod = "$_.pm"; + $mod =~ s/::/\//g; + unless ($INC{$mod}) { + my $err = sprintf "Expected DBIC core module %s never loaded - %s needs adjustment", $_, __FILE__; + if (DBICTest::RunMode->is_smoker or DBICTest::RunMode->is_author) { + fail ($err) + } + else { + diag "\n" unless $nl++; + diag $err; + } + } +} + done_testing;