X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FBaseSchema.pm;h=1c42201f4775d932d6714a3f8a17060b44e7f6a8;hb=0f6d86e4c025273bdbe5d6527e44d7b42b7fede8;hp=c68d7fded0694f63c499bcc6fe110c0c46148686;hpb=2c2bc4e58c2146670960fc1a0a2ae802cb650506;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/t/lib/DBICTest/BaseSchema.pm b/t/lib/DBICTest/BaseSchema.pm index c68d7fd..1c42201 100644 --- a/t/lib/DBICTest/BaseSchema.pm +++ b/t/lib/DBICTest/BaseSchema.pm @@ -7,6 +7,7 @@ use base qw(DBICTest::Base DBIx::Class::Schema); use Fcntl qw(:DEFAULT :seek :flock); use Time::HiRes 'sleep'; +use Scope::Guard (); use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry); use DBICTest::Util 'local_umask'; use namespace::clean; @@ -23,10 +24,20 @@ sub capture_executed_sql_bind { local *DBIx::Class::Storage::DBI::_format_for_trace = sub { $_[1] }; Class::C3->reinitialize if DBIx::Class::_ENV_::OLD_MRO; + # can not use local() due to an unknown number of storages + # (think replicated) + my $orig_states = { map + { $_ => $self->storage->$_ } + qw(debugcb debugobj debug) + }; + + my $sg = Scope::Guard->new(sub { + $self->storage->$_ ( $orig_states->{$_} ) for keys %$orig_states; + }); - local $self->storage->{debugcb}; - local $self->storage->{debugobj} = my $tracer_obj = DBICTest::SQLTracerObj->new; - local $self->storage->{debug} = 1; + $self->storage->debugcb(undef); + $self->storage->debugobj( my $tracer_obj = DBICTest::SQLTracerObj->new ); + $self->storage->debug(1); local $Test::Builder::Level = $Test::Builder::Level + 2; $cref->(); @@ -156,28 +167,28 @@ sub connection { ($_[0]||'') !~ /^ (?i:dbi) \: SQLite \: (?: dbname\= )? (?: \:memory\: | t [\/\\] var [\/\\] DBIxClass\-) /x ) { - my $locktype = do { + my $locktype; + + { # guard against infinite recursion local $ENV{DBICTEST_LOCK_HOLDER} = -1; - # we need to connect a forced fresh clone so that we do not upset any state + # we need to work with a forced fresh clone so that we do not upset any state # of the main $schema (some tests examine it quite closely) local $SIG{__WARN__} = sub {}; local $@; - my $storage = eval { - my $st = ref($self)->connect(@{$self->storage->connect_info})->storage; - $st->ensure_connected; # do connect here, to catch a possible throw - $st; + + # this will either give us an undef $locktype or will determine things + # properly with a default ( possibly connecting in the process ) + eval { + my $s = ref($self)->connect(@{$self->storage->connect_info})->storage; + + $locktype = $s->sqlt_type || 'generic'; + + # in case sqlt_type did connect, doesn't matter if it fails or something + $s->disconnect; }; - $storage - ? do { - my $t = $storage->sqlt_type || 'generic'; - eval { $storage->disconnect }; - $t; - } - : undef - ; - }; + } # Never hold more than one lock. This solves the "lock in order" issues # unrelated tests may have @@ -258,7 +269,6 @@ sub clone { END { # Make sure we run after any cleanup in other END blocks - require B; push @{ B::end_av()->object_2svref }, sub { assert_empty_weakregistry($weak_registry, 'quiet'); };