X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xt%2Fextra%2Flean_startup.t;h=f915819de49fc1dd8057f58529ee1c2696db7438;hb=c9087040faf8de638936b163c20f702a2878d7ab;hp=95bec73e7c7cbe20933884ffc618e7978bdda928;hpb=072b62c48b130d75f4e96ecdb4c46095f520050d;p=dbsrgits%2FDBIx-Class.git diff --git a/xt/extra/lean_startup.t b/xt/extra/lean_startup.t index 95bec73..f915819 100644 --- a/xt/extra/lean_startup.t +++ b/xt/extra/lean_startup.t @@ -1,32 +1,35 @@ # 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 { - # these envvars *will* bring in more stuff than the baseline - delete @ENV{qw(DBICTEST_SQLT_DEPLOY DBIC_TRACE)}; - - # make sure extras do not load even when this is set - $ENV{PERL_STRICTURES_EXTRA} = 1; + 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; 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 + $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector | Module::Runtime | DBIx::Class::Optional::Dependencies ) $/x or $caller[3] eq '(eval)', ) @@ -37,8 +40,11 @@ BEGIN { return $res if $req =~ /^DBIx::Class|^DBICTest::/; - # exclude everything where the current namespace does not match the called function - # (this works around very weird XS-induced require callstack corruption) + # Some modules have a bare 'use $perl_version' as the first statement + # Since the use() happens before 'package' had a chance to switch + # the namespace, the shim thinks DBIC* tried to require this + return $res if $req =~ /^v?[0-9.]+$/; + if ( !$initial_inc_contents->{$req} and @@ -47,14 +53,26 @@ BEGIN { @caller and $caller[0] =~ /^DBIx::Class/ - and - (caller($up))[3] =~ /\Q$caller[0]/ ) { - CORE::require('Test/More.pm'); + local $stack{neutralize_override} = 1; + + # find last-most frame, to feed to T::B below + while( CORE::caller(++$up) ) { 1 } + + require('Test/More.pm'); + local $Test::Builder::Level = $up + 1; + + # work around the trainwreck that is https://github.com/doy/package-stash-xs/pull/4 + local $::TODO = 'sigh' if ( + $INC{'Package/Stash/XS.pm'} + and + $req eq 'utf8' + ); + Test::More::fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])"); - if ( $ENV{TEST_VERBOSE} or ! DBICTest::RunMode->is_plain ) { - CORE::require('DBICTest/Util.pm'); + unless( $::TODO ) { + require('DBICTest/Util.pm'); Test::More::diag( 'Require invoked' . DBICTest::Util::stacktrace() ); } } @@ -71,9 +89,31 @@ BEGIN { plan skip_all => 'A defined PERL5OPT may inject extra deps crashing this test' if $ENV{PERL5OPT}; + plan skip_all => 'Presence of sitecustomize.pl may inject extra deps crashing this test' + if grep { $_ =~ m| \/ sitecustomize\.pl $ |x } keys %INC; + plan skip_all => 'Dependency load patterns are radically different before perl 5.10' if "$]" < 5.010; + # these envvars *will* bring in more stuff than the baseline + delete @ENV{qw( + DBIC_TRACE + DBIC_SHUFFLE_UNORDERED_RESULTSETS + DBICTEST_SQLT_DEPLOY + DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER + DBICTEST_VIA_REPLICATED + DBICTEST_DEBUG_CONCURRENCY_LOCKS + )}; + + # ensures the checker won't be disabled in + # t/lib/DBICTest/BaseSchema.pm + $ENV{DBIC_ASSERT_NO_FAILING_SANITY_CHECKS} = 1; + + $ENV{DBICTEST_ANFANG_DEFANG} = 1; + + # make sure extras do not load even when this is set + $ENV{PERL_STRICTURES_EXTRA} = 1; + # add what we loaded so far for (keys %INC) { my $mod = $_; @@ -83,12 +123,6 @@ BEGIN { } } -BEGIN { - delete $ENV{$_} for qw( - DBICTEST_VIA_REPLICATED - DBICTEST_DEBUG_CONCURRENCY_LOCKS - ); -} ####### ### This is where the test starts @@ -111,17 +145,21 @@ BEGIN { Sub::Name Sub::Defer Sub::Quote + attributes Scalar::Util - List::Util Storable Class::Accessor::Grouped Class::C3::Componentised - SQL::Abstract )); - require DBICTest::Schema; + # load Storable ourselves here - there are too many + # variations with DynaLoader and XSLoader making testing + # for it rather unstable + require Storable; + + require DBIx::Class::Schema; assert_no_missing_expected_requires(); } @@ -133,9 +171,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(); } @@ -145,9 +184,55 @@ BEGIN { register_lazy_loadable_requires(qw( DBI Hash::Merge + Data::Dumper )); - 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, @@ -160,24 +245,27 @@ BEGIN { my $art = $s->resultset('Artist')->create({ name => \[ '?' => 'foo'], rank => 42 }); $art->discard_changes; $art->update({ rank => 69, name => 'foo' }); + $s->resultset('Artist')->all; 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; @@ -196,23 +284,20 @@ 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; - unless ($INC{$modfn}) { - my $err = sprintf "Expected DBIC core dependency '%s' never loaded - %s needs adjustment", $mod, __FILE__; - if (DBICTest::RunMode->is_smoker or DBICTest::RunMode->is_author) { - fail ($err) - } - else { - diag "\n" unless $nl->{$mod}++; - diag $err; - } - } + fail sprintf ( + "Expected DBIC core dependency '%s' never loaded - %s needs adjustment", + $mod, + __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; }