From: Peter Rabbitson <ribasushi@cpan.org>
Date: Wed, 14 Mar 2012 12:40:44 +0000 (+0100)
Subject: Add all storage instances to the test suite leaktracing pool
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6892eb09b6090628ae4e7092767da0cbff8afcbc;p=dbsrgits%2FDBIx-Class-Historic.git

Add all storage instances to the test suite leaktracing pool
---

diff --git a/t/50fork.t b/t/50fork.t
index c5384c9..1d51605 100644
--- a/t/50fork.t
+++ b/t/50fork.t
@@ -24,7 +24,7 @@ use lib qw(t/lib);
 
 use_ok('DBICTest::Schema');
 
-my $schema = DBICTest::Schema->connection($dsn, $user, $pass, { AutoCommit => 1 });
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { AutoCommit => 1 });
 
 my $parent_rs;
 
diff --git a/t/51threads.t b/t/51threads.t
index b01771d..7212dc9 100644
--- a/t/51threads.t
+++ b/t/51threads.t
@@ -35,7 +35,7 @@ if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
 
 use_ok('DBICTest::Schema');
 
-my $schema = DBICTest::Schema->connection($dsn, $user, $pass, { AutoCommit => 1, RaiseError => 1, PrintError => 0 });
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { AutoCommit => 1, RaiseError => 1, PrintError => 0 });
 
 my $parent_rs;
 
diff --git a/t/51threadtxn.t b/t/51threadtxn.t
index c5e1e35..1c8f7e6 100644
--- a/t/51threadtxn.t
+++ b/t/51threadtxn.t
@@ -19,6 +19,7 @@ plan skip_all => 'DBIC does not actively support threads before perl 5.8.5'
   if $] < '5.008005';
 
 use DBIx::Class::Optional::Dependencies ();
+use Scalar::Util 'weaken';
 use lib qw(t/lib);
 
 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
@@ -35,7 +36,7 @@ if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
 
 use_ok('DBICTest::Schema');
 
-my $schema = DBICTest::Schema->connection($dsn, $user, $pass, { AutoCommit => 1, RaiseError => 1, PrintError => 0 });
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass, { AutoCommit => 1, RaiseError => 1, PrintError => 0 });
 
 my $parent_rs;
 
@@ -61,13 +62,13 @@ while(@children < $num_children) {
 
     my $newthread = async {
         my $tid = threads->tid;
-        # my $dbh = $schema->storage->dbh;
-
+        weaken(my $weak_schema = $schema);
+        weaken(my $weak_parent_rs = $parent_rs);
         $schema->txn_do(sub {
-            my $child_rs = $schema->resultset('CD')->search({ year => 1901 });
-            my $row = $parent_rs->next;
+            my $child_rs = $weak_schema->resultset('CD')->search({ year => 1901 });
+            my $row = $weak_parent_rs->next;
             if($row && $row->get_column('artist') =~ /^(?:123|456)$/) {
-                $schema->resultset('CD')->create({ title => "test success $tid", artist => $tid, year => scalar(@children) });
+                $weak_schema->resultset('CD')->create({ title => "test success $tid", artist => $tid, year => scalar(@children) });
             }
         });
         sleep(1);  # tasty crashes without this
diff --git a/t/72pg.t b/t/72pg.t
index e2acc10..5e2f08f 100644
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -112,9 +112,10 @@ for my $use_insert_returning ($test_server_supports_insert_returning
   : (0)
 ) {
 
-  no warnings qw/once/;
+  no warnings qw/once redefine/;
+  my $old_connection = DBICTest::Schema->can('connection');
   local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
-    my $s = shift->next::method (@_);
+    my $s = shift->$old_connection(@_);
     $s->storage->_use_insert_returning ($use_insert_returning);
     $s;
   };
diff --git a/t/72pg_bytea.t b/t/72pg_bytea.t
index 4ff3e36..ac5b9c4 100644
--- a/t/72pg_bytea.t
+++ b/t/72pg_bytea.t
@@ -15,7 +15,7 @@ my ($dsn, $dbuser, $dbpass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}
 plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
   unless ($dsn && $dbuser);
 
-my $schema = DBICTest::Schema->connection($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
+my $schema = DBICTest::Schema->connect($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
 
 if ($schema->storage->_server_info->{normalized_dbms_version} >= 9.0) {
   if (not try { DBD::Pg->VERSION('2.17.2') }) {
diff --git a/t/73oracle.t b/t/73oracle.t
index 907c278..07f1afa 100644
--- a/t/73oracle.t
+++ b/t/73oracle.t
@@ -110,9 +110,10 @@ my $schema;
 for my $use_insert_returning ($test_server_supports_insert_returning ? (1,0) : (0) ) {
   for my $force_ora_joins ($test_server_supports_only_orajoins ? (0) : (0,1) ) {
 
-    no warnings qw/once/;
+    no warnings qw/once redefine/;
+    my $old_connection = DBICTest::Schema->can('connection');
     local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
-      my $s = shift->next::method (@_);
+      my $s = shift->$old_connection (@_);
       $s->storage->_use_insert_returning ($use_insert_returning);
       $s->storage->sql_maker_class('DBIx::Class::SQLMaker::OracleJoins') if $force_ora_joins;
       $s;
diff --git a/t/inflate/datetime_msaccess.t b/t/inflate/datetime_msaccess.t
index 00450cd..f012199 100644
--- a/t/inflate/datetime_msaccess.t
+++ b/t/inflate/datetime_msaccess.t
@@ -34,19 +34,17 @@ my @connect_info = (
   [ $dsn2, $user2 || '', $pass2 || '' ],
 );
 
-my $schema;
-
 for my $connect_info (@connect_info) {
   my ($dsn, $user, $pass) = @$connect_info;
 
   next unless $dsn;
 
-  $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
+  my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
     on_connect_call => 'datetime_setup',
     quote_names => 1,
   });
 
-  my $guard = Scope::Guard->new(\&cleanup);
+  my $guard = Scope::Guard->new(sub { cleanup($schema) });
 
   try { local $^W = 0; $schema->storage->dbh->do('DROP TABLE track') };
   $schema->storage->dbh->do(<<"SQL");
@@ -82,6 +80,7 @@ done_testing;
 
 # clean up our mess
 sub cleanup {
+  my $schema = shift;
   # have to reconnect to drop a table that's in use
   if (my $storage = eval { $schema->storage }) {
     local $^W = 0;
diff --git a/t/lib/DBICTest/Schema.pm b/t/lib/DBICTest/Schema.pm
index 1e5c564..285582d 100644
--- a/t/lib/DBICTest/Schema.pm
+++ b/t/lib/DBICTest/Schema.pm
@@ -74,6 +74,13 @@ sub clone {
   $self;
 }
 
+sub connection {
+  my $self = shift->next::method(@_);
+  populate_weakregistry ( $weak_registry, $self->storage )
+    if $INC{'Test/Builder.pm'};
+  $self;
+}
+
 END {
   assert_empty_weakregistry($weak_registry, 'quiet');
 }
diff --git a/t/storage/on_connect_do.t b/t/storage/on_connect_do.t
index 2ce77b2..fd0ab49 100644
--- a/t/storage/on_connect_do.t
+++ b/t/storage/on_connect_do.t
@@ -77,6 +77,7 @@ $schema->storage->disconnect();
 ok $disconnected, 'on_disconnect_do() called after disconnect()';
 
 isa_ok($cb_args[0], 'DBIx::Class::Storage', 'first arg to on_connect_do hook');
+@cb_args = ();
 
 sub check_exists {
     my $storage = shift;