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

diff --git a/t/lib/DBICTest/BaseSchema.pm b/t/lib/DBICTest/BaseSchema.pm
index 0e1e5e2..c68d7fd 100644
--- a/t/lib/DBICTest/BaseSchema.pm
+++ b/t/lib/DBICTest/BaseSchema.pm
@@ -3,7 +3,6 @@ package #hide from pause
 
 use strict;
 use warnings;
-
 use base qw(DBICTest::Base DBIx::Class::Schema);
 
 use Fcntl qw(:DEFAULT :seek :flock);
@@ -12,6 +11,99 @@ use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistr
 use DBICTest::Util 'local_umask';
 use namespace::clean;
 
+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) = @_;
+
+  local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+  $self->throw_exception("Expecting an arrayref of SQL/Bind pairs") unless ref $sqlbinds eq 'ARRAY';
+
+  my @expected = @$sqlbinds;
+
+  my @got = map { $_->[1] } @{ $self->capture_executed_sql_bind($cref) };
+
+
+  return Test::Builder->new->ok(1, $msg || "No queries executed while running $cref")
+    if !@got and !@expected;
+
+  require SQL::Abstract::Test;
+  my $ret = 1;
+  while (@expected or @got) {
+    my $left = shift @got;
+    my $right = shift @expected;
+
+    # allow the right side to "simplify" the entire shebang
+    if ($left and $right) {
+      $left = [ @$left ];
+      for my $i (1..$#$right) {
+        if (
+          ! ref $right->[$i]
+            and
+          ref $left->[$i] eq 'ARRAY'
+            and
+          @{$left->[$i]} == 2
+        ) {
+          $left->[$i] = $left->[$i][1]
+        }
+      }
+    }
+
+    $ret &= SQL::Abstract::Test::is_same_sql_bind(
+      \( $left || [] ),
+      \( $right || [] ),
+      $msg,
+    );
+  }
+
+  return $ret;
+}
+
 our $locker;
 END {
   # we need the $locker to be referenced here for delayed destruction
@@ -165,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;