Merge branch 'master' into topic/constructor_rewrite

[dbsrgits/DBIx-Class.git] / t / 53lean_startup.t

diff --git a/t/53lean_startup.t b/t/53lean_startup.t
new file mode 100644 (file)
index 0000000..30f1d90
--- /dev/null
+++ b/t/53lean_startup.t
@@ -0,0 +1,133 @@
+# 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 add the hook in a bit, got to load some regular stuff
+
+my $test_hook;
+BEGIN {
+  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 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 {
+  $expected_core_modules = { map { $_ => 1 } qw/
+    strict
+    warnings
+
+    base
+    mro
+    overload
+    Exporter
+
+    B
+    locale
+
+    namespace::clean
+    Try::Tiny
+    Context::Preserve
+    Sub::Name
+
+    Scalar::Util
+    List::Util
+    Hash::Merge
+    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 {
+
+    my $req = $_[0];
+    $req =~ s/\.pm$//;
+    $req =~ s/\//::/g;
+
+    return if $req =~ /^DBIx::Class|^DBICTest::/;
+
+    my $up = 1;
+    my @caller;
+    do { @caller = caller($up++) } while (
+      @caller and (
+        # exclude our test suite, known "module require-rs" and eval frames
+        $caller[1] =~ /^ t [\/\\] /x
+          or
+        $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector) $/x
+          or
+        $caller[3] eq '(eval)',
+      )
+    );
+
+    # exclude everything where the current namespace does not match the called function
+    # (this works around very weird XS-induced require callstack corruption)
+    if (
+      !$expected_core_modules->{$req}
+        and
+      @caller
+        and
+      $caller[0] =~ /^DBIx::Class/
+        and
+      (caller($up))[3] =~ /\Q$caller[0]/
+    ) {
+      fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])");
+
+      diag( 'Require invoked' .  stacktrace() ) if $ENV{TEST_VERBOSE};
+    }
+  };
+}
+
+use lib 't/lib';
+use DBICTest;
+
+# these envvars bring in more stuff
+delete $ENV{$_} for qw/
+  DBICTEST_SQLT_DEPLOY
+  DBIC_TRACE
+/;
+
+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;