Use the now pure-perlized Devel::GlobalDestroy module

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

# 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

    Devel::GlobalDestruction
    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;