From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 17 Sep 2010 15:18:04 +0000 (+0200)
Subject: Fix leak of $sth during populate() on perls < 5.10
X-Git-Tag: v0.08124~74
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=574d9b690cd9687feed73e81adf35ed589f0d7eb

Fix leak of $sth during populate() on perls < 5.10

The removal of the explicit ->disconnect on $storage DESTROY
revealed a problem with older perls and nesting of try blocks
---

diff --git a/Changes b/Changes
index aa53c2e..3a6ad78 100644
--- a/Changes
+++ b/Changes
@@ -15,6 +15,7 @@ Revision history for DBIx::Class
         - Optimized RowNum based Oracle limit-dialect (RT#61277)
 
     * Fixes
+        - Fix memory leak during populate() on 5.8.x perls
         - Make sure exception_action does not allow exception-hiding
           due to badly-written handlers (the mechanism was never meant
           to be able to suppress exceptions)
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 2cc0219..d54e0b2 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1770,15 +1770,14 @@ sub _execute_array {
   }
   catch {
     $err = shift;
+  };
+
+  # Statement must finish even if there was an exception.
+  try {
+    $sth->finish
   }
-  finally {
-    # Statement must finish even if there was an exception.
-    try {
-      $sth->finish
-    }
-    catch {
-      $err = shift unless defined $err
-    };
+  catch {
+    $err = shift unless defined $err
   };
 
   $err = $sth->errstr
diff --git a/t/52cycle.t b/t/52cycle.t
index b64be5c..d3d88d5 100644
--- a/t/52cycle.t
+++ b/t/52cycle.t
@@ -27,12 +27,6 @@ my $weak;
   my $storage = $weak->{storage} = $s->storage;
   memory_cycle_ok($storage, 'No cycles in storage');
 
-  my $dbh = $weak->{dbh} = $s->storage->_get_dbh;
-  memory_cycle_ok($dbh, 'No cycles in DBI handle');
-
-  my $sqla = $weak->{sqla} = $s->storage->sql_maker;
-  memory_cycle_ok($sqla, 'No cycles in SQL maker');
-
   my $rs = $weak->{resultset} = $s->resultset ('Artist');
   memory_cycle_ok($rs, 'No cycles in resultset');
 
@@ -42,6 +36,16 @@ my $weak;
   my $row = $weak->{row} = $rs->first;
   memory_cycle_ok($row, 'No cycles in row');
 
+  my $sqla = $weak->{sqla} = $s->storage->sql_maker;
+  memory_cycle_ok($sqla, 'No cycles in SQL maker');
+
+  my $dbh = $weak->{dbh} = $s->storage->_get_dbh;
+  memory_cycle_ok($dbh, 'No cycles in DBI handle');
+
+  for (@{$dbh->{ChildHandles}}) {
+    $weak->{"$_"} = $_ if $_;
+  }
+
   weaken $_ for values %$weak;
   memory_cycle_ok($weak, 'No cycles in weak object collection');
 }
diff --git a/xt/dbictest_unlink_guard.t b/xt/dbictest_unlink_guard.t
new file mode 100644
index 0000000..83a38e9
--- /dev/null
+++ b/xt/dbictest_unlink_guard.t
@@ -0,0 +1,19 @@
+use warnings;
+use strict;
+
+use Test::More;
+use lib 't/lib';
+use DBICTest;
+
+# Once upon a time there was a problem with a leaking $sth
+# which in turn delayed the $dbh destruction, which in turn
+# made the inode comaprison fire at the wrong time
+# This simulates the problem without doing much else
+for (1..2) {
+  my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
+  $schema->storage->ensure_connected;
+  isa_ok ($schema, 'DBICTest::Schema');
+}
+
+done_testing;
+