Better lean startup check
Peter Rabbitson [Sun, 28 Feb 2016 12:27:25 +0000 (13:27 +0100)]
Instead of stupidly loading DBICTest right away, delay to examine the actual
bare DBIC startup

xt/extra/lean_startup.t

index d107bb8..4d73f4b 100644 (file)
@@ -1,7 +1,14 @@
 # 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
 
-my ($initial_inc_contents, $expected_dbic_deps, $require_sites);
+BEGIN {
+  if ( $ENV{RELEASE_TESTING} ) {
+    require warnings and warnings->import;
+    require strict and strict->import;
+  }
+}
+
+my ($initial_inc_contents, $expected_dbic_deps, $require_sites, %stack);
 BEGIN {
   unshift @INC, 't/lib';
   require DBICTest::Util::OverrideRequire;
@@ -9,16 +16,18 @@ BEGIN {
   DBICTest::Util::OverrideRequire::override_global_require( sub {
     my $res = $_[0]->();
 
+    return $res if $stack{neutralize_override};
+
     my $req = $_[1];
     $req =~ s/\.pm$//;
     $req =~ s/\//::/g;
 
     my $up = 0;
     my @caller;
-    do { @caller = caller($up++) } while (
+    do { @caller = CORE::caller($up++) } while (
       @caller and (
         # exclude our test suite, known "module require-rs" and eval frames
-        $caller[1] =~ /^ t [\/\\] /x
+        $caller[1] =~ / (?: \A | [\/\\] ) x?t [\/\\] /x
           or
         $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector | Module::Runtime ) $/x
           or
@@ -31,6 +40,18 @@ BEGIN {
 
     return $res if $req =~ /^DBIx::Class|^DBICTest::/;
 
+    # FIXME - work around RT#114641
+    #
+    # Because *OF COURSE* when (questionable) unicode tests fail on < 5.8
+    # the answer is to make the entire module 5.8 only, instead of skipping
+    # the tests in question
+    # rjbs-- # thinly veiled passive aggressive bullshit
+    #
+    # The actual skip is needed because the use happens before 'package' had
+    # a chance to switch the namespace, so the shim thinks DBIC::Schema tried
+    # to require this
+    return $res if $req eq '5.008';
+
     # exclude everything where the current namespace does not match the called function
     # (this works around very weird XS-induced require callstack corruption)
     if (
@@ -42,12 +63,17 @@ BEGIN {
         and
       $caller[0] =~ /^DBIx::Class/
         and
-      (caller($up))[3] =~ /\Q$caller[0]/
+      (CORE::caller($up))[3] =~ /\Q$caller[0]/
     ) {
-      CORE::require('Test/More.pm');
+      local $stack{neutralize_override} = 1;
+
+      do 1 while CORE::caller(++$up);
+
+      require('Test/More.pm');
+      local $Test::Builder::Level = $up + 1;
       Test::More::fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])");
 
-      CORE::require('DBICTest/Util.pm');
+      require('DBICTest/Util.pm');
       Test::More::diag( 'Require invoked' .  DBICTest::Util::stacktrace() );
     }
 
@@ -73,6 +99,7 @@ BEGIN {
   delete @ENV{qw(
     DBIC_TRACE
     DBICTEST_SQLT_DEPLOY
+    DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER
     DBICTEST_VIA_REPLICATED
     DBICTEST_DEBUG_CONCURRENCY_LOCKS
   )};
@@ -120,10 +147,9 @@ BEGIN {
 
     Class::Accessor::Grouped
     Class::C3::Componentised
-    SQL::Abstract
   ));
 
-  require DBICTest::Schema;
+  require DBIx::Class::Schema;
   assert_no_missing_expected_requires();
 }
 
@@ -135,9 +161,10 @@ BEGIN {
     Method::Generate::Accessor
     Method::Generate::Constructor
     Context::Preserve
+    SQL::Abstract
   ));
 
-  my $s = DBICTest::Schema->connect('dbi:SQLite::memory:');
+  my $s = DBIx::Class::Schema->connect('dbi:SQLite::memory:');
   ok (! $s->storage->connected, 'no connection');
   assert_no_missing_expected_requires();
 }
@@ -149,7 +176,52 @@ BEGIN {
     Hash::Merge
   ));
 
-  my $s = DBICTest::Schema->connect('dbi:SQLite::memory:');
+  {
+    eval <<'EOP' or die $@;
+
+  package DBICTest::Result::Artist;
+
+  use warnings;
+  use strict;
+
+  use base 'DBIx::Class::Core';
+
+  __PACKAGE__->table("artist");
+
+  __PACKAGE__->add_columns(
+    artistid => {
+      data_type => 'integer',
+      is_auto_increment => 1,
+    },
+    name => {
+      data_type => 'varchar',
+      size      => 100,
+      is_nullable => 1,
+    },
+    rank => {
+      data_type => 'integer',
+      default_value => 13,
+    },
+    charfield => {
+      data_type => 'char',
+      size => 10,
+      is_nullable => 1,
+    },
+  );
+
+  __PACKAGE__->set_primary_key('artistid');
+  __PACKAGE__->add_unique_constraint(['name']);
+  __PACKAGE__->add_unique_constraint(u_nullable => [qw/charfield rank/]);
+
+  1;
+
+EOP
+  }
+
+  my $s = DBIx::Class::Schema->connect('dbi:SQLite::memory:');
+
+  $s->register_class( Artist => 'DBICTest::Result::Artist' );
+
   $s->storage->dbh_do(sub {
     $_[1]->do('CREATE TABLE artist (
       "artistid" INTEGER PRIMARY KEY NOT NULL,
@@ -165,21 +237,23 @@ BEGIN {
   assert_no_missing_expected_requires();
 }
 
-# and do full populate() as well, just in case - shouldn't add new stuff
+
+# and do full DBICTest based populate() as well, just in case - shouldn't add new stuff
 {
-  local $ENV{DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER};
-  {
-    # in general we do not want DBICTest to load before sqla, but it is
-    # ok to cheat here
-    local $INC{'SQL/Abstract.pm'};
-    require DBICTest;
-  }
+  # DBICTest needs File::Spec, but older versions of Storable load it alread
+  # Instead of adding a contrived conditional, just preempt the testing entirely
+  require File::Spec;
+
+  require DBICTest;
+  DBICTest->import;
+
   my $s = DBICTest->init_schema;
-  is ($s->resultset('Artist')->find(1)->name, 'Caterwauler McCrae');
-  assert_no_missing_expected_requires();
+  is ($s->resultset('Artist')->find(1)->name, 'Caterwauler McCrae', 'Expected find() result');
 }
 
 done_testing;
+# one final quiet guard to run at all times
+END { assert_no_missing_expected_requires('quiet') };
 
 sub register_lazy_loadable_requires {
   local $Test::Builder::Level = $Test::Builder::Level + 1;
@@ -198,7 +272,8 @@ sub register_lazy_loadable_requires {
 
 # check if anything we were expecting didn't actually load
 sub assert_no_missing_expected_requires {
-  my $nl;
+  my $quiet = shift;
+
   for my $mod (keys %$expected_dbic_deps) {
     (my $modfn = "$mod.pm") =~ s/::/\//g;
     fail sprintf (
@@ -207,9 +282,10 @@ sub assert_no_missing_expected_requires {
       __FILE__
     ) unless $INC{$modfn};
   }
+
   pass(sprintf 'All modules expected at %s line %s loaded by DBIC: %s',
     __FILE__,
     (caller(0))[2],
     join (', ', sort keys %$expected_dbic_deps ),
-  ) unless $nl;
+  ) unless $quiet;
 }