X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=xt%2Fextra%2Flean_startup.t;h=4d73f4b965d4a3bd40603ca63bbbb1c58fd9c141;hb=92fbedbc5befe2e660ec168b1b6a2a1255ae6104;hp=59953240dbafd7904ce155117591dabd2b3c9ff2;hpb=fd2c6658f74eda2831017727d3890dffd0eff06c;p=dbsrgits%2FDBIx-Class.git diff --git a/xt/extra/lean_startup.t b/xt/extra/lean_startup.t index 5995324..4d73f4b 100644 --- a/xt/extra/lean_startup.t +++ b/xt/extra/lean_startup.t @@ -1,30 +1,33 @@ # 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 or @@ -37,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 ( @@ -48,15 +63,18 @@ 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])"); - if ( $ENV{TEST_VERBOSE} or ! DBICTest::RunMode->is_plain ) { - CORE::require('DBICTest/Util.pm'); - Test::More::diag( 'Require invoked' . DBICTest::Util::stacktrace() ); - } + require('DBICTest/Util.pm'); + Test::More::diag( 'Require invoked' . DBICTest::Util::stacktrace() ); } return $res; @@ -71,8 +89,25 @@ 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; + if "$]" < 5.010; + + # these envvars *will* bring in more stuff than the baseline + delete @ENV{qw( + DBIC_TRACE + DBICTEST_SQLT_DEPLOY + DBICTEST_SQLITE_REVERSE_DEFAULT_ORDER + DBICTEST_VIA_REPLICATED + DBICTEST_DEBUG_CONCURRENCY_LOCKS + )}; + + $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) { @@ -83,7 +118,6 @@ BEGIN { } } -BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 } ####### ### This is where the test starts @@ -113,10 +147,9 @@ BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 } Class::Accessor::Grouped Class::C3::Componentised - SQL::Abstract )); - require DBICTest::Schema; + require DBIx::Class::Schema; assert_no_missing_expected_requires(); } @@ -128,9 +161,10 @@ BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 } 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(); } @@ -142,7 +176,52 @@ BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 } 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, @@ -158,21 +237,23 @@ BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 } 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; @@ -191,23 +272,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; }