X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FDBICTest%2FBaseSchema.pm;h=c68d7fded0694f63c499bcc6fe110c0c46148686;hb=961d79dbe25ef8a92e867fcc84914b4bf568c11d;hp=ae8d74a69c69bb9bb1c462844d1554b20daf3ce6;hpb=2cfc22ddff9cb35524031dfc9d429d294b5e3d6e;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/lib/DBICTest/BaseSchema.pm b/t/lib/DBICTest/BaseSchema.pm
index ae8d74a..c68d7fd 100644
--- a/t/lib/DBICTest/BaseSchema.pm
+++ b/t/lib/DBICTest/BaseSchema.pm
@@ -11,45 +11,52 @@ use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistr
 use DBICTest::Util 'local_umask';
 use namespace::clean;
 
-{
-  package # moar hide
-    DBICTest::SQLTracerObj;
-  use base 'DBIx::Class::Storage::Statistics';
-
-  sub query_start { push @{$_[0]{sqlbinds}}, [ ($_[1] =~ /^\s*(\S+)/)[0], [ $_[1], @{ $_[2]||[] } ] ] }
-
-  # who the hell came up with this API >:(
-  for my $txn (qw(begin rollback commit)) {
-    no strict 'refs';
-    *{"txn_$txn"} = sub { push @{$_[0]{sqlbinds}}, [ uc $txn => [ uc $txn ] ] };
-  }
-
-  sub svp_begin { push @{$_[0]{sqlbinds}}, [ SAVEPOINT => [ "SAVEPOINT $_[1]" ] ] }
-  sub svp_release { push @{$_[0]{sqlbinds}}, [ RELEASE_SAVEPOINT => [ "RELEASE $_[1]" ] ] }
-  sub svp_rollback { push @{$_[0]{sqlbinds}}, [ ROLLBACK_TO_SAVEPOINT => [ "ROLLBACK TO $_[1]" ] ] }
-
-}
-
 sub capture_executed_sql_bind {
   my ($self, $cref) = @_;
 
   $self->throw_exception("Expecting a coderef to run") unless ref $cref eq 'CODE';
 
+  require DBICTest::SQLTracerObj;
+
   # hack around stupid, stupid API
   no warnings 'redefine';
   local *DBIx::Class::Storage::DBI::_format_for_trace = sub { $_[1] };
   Class::C3->reinitialize if DBIx::Class::_ENV_::OLD_MRO;
 
+
   local $self->storage->{debugcb};
   local $self->storage->{debugobj} = my $tracer_obj = DBICTest::SQLTracerObj->new;
   local $self->storage->{debug} = 1;
 
-
+  local $Test::Builder::Level = $Test::Builder::Level + 2;
   $cref->();
 
   return $tracer_obj->{sqlbinds} || [];
 }
 
+sub is_executed_querycount {
+  my ($self, $cref, $exp_counts, $msg) = @_;
+
+  local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+  $self->throw_exception("Expecting an hashref of counts or an integer representing total query count")
+    unless ref $exp_counts eq 'HASH' or (defined $exp_counts and ! ref $exp_counts);
+
+  my @got = map { $_->[0] } @{ $self->capture_executed_sql_bind($cref) };
+
+  return Test::More::is( @got, $exp_counts, $msg )
+    unless ref $exp_counts;
+
+  my $got_counts = { map { $_ => 0 } keys %$exp_counts };
+  $got_counts->{$_}++ for @got;
+
+  return Test::More::is_deeply(
+    $got_counts,
+    $exp_counts,
+    $msg,
+  );
+}
+
 sub is_executed_sql_bind {
   my ($self, $cref, $sqlbinds, $msg) = @_;
 
@@ -250,7 +257,11 @@ sub clone {
 }
 
 END {
-  assert_empty_weakregistry($weak_registry, 'quiet');
+  # 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');
+  };
 }
 
 1;