From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 28 Oct 2010 09:01:41 +0000 (+0200)
Subject: Generalize leak-trace handling
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d5e5fb4b47b759b202e552ff1d2f1dd393ac7b39;p=dbsrgits%2FDBIx-Class-Historic.git

Generalize leak-trace handling

Disable the leak tests for perls 5.13.5 and 5.13.6 on *smoker only*
---

diff --git a/t/52leaks.t b/t/52leaks.t
index 3342e1f..792c3d3 100644
--- a/t/52leaks.t
+++ b/t/52leaks.t
@@ -12,18 +12,18 @@ BEGIN {
 }
 
 use Test::More;
+
+use lib qw(t/lib);
+use DBICTest::RunMode;
 BEGIN {
-  plan skip_all => '5.13.6 leaks like a sieve (fixed in blead/cefd5c7c)'
-    if $] == '5.013006';
+  plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test"
+    if DBICTest::RunMode->peepeeness;
 }
 
 use Scalar::Util qw/refaddr reftype weaken/;
 use Carp qw/longmess/;
 use Try::Tiny;
 
-use lib qw(t/lib);
-use DBICTest::RunMode;
-
 my $have_test_cycle;
 BEGIN {
   require DBIx::Class::Optional::Dependencies;
diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index 85e5ee4..bccf8cf 100644
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -112,7 +112,7 @@ sub _database {
 }
 
 sub __mk_disconnect_guard {
-  return if $] == '5.013006'; # leaks handles, delaying DESTROY, can't work right
+  return if DBICTest::RunMode->peepeeness; # leaks handles, delaying DESTROY, can't work right
 
   my $db_file = shift;
   return unless -f $db_file;
diff --git a/t/lib/DBICTest/RunMode.pm b/t/lib/DBICTest/RunMode.pm
index 6da3ead..d96fdcd 100644
--- a/t/lib/DBICTest/RunMode.pm
+++ b/t/lib/DBICTest/RunMode.pm
@@ -99,6 +99,24 @@ EOE
   }
 }
 
+sub peepeeness {
+  return ! $ENV{DBICTEST_ALL_LEAKS} if defined $ENV{DBICTEST_ALL_LEAKS};
+
+  # don't smoke perls with known issues:
+  if (__PACKAGE__->is_smoker) {
+    if ($] == '5.013006') {
+      # leaky 5.13.6 (fixed in blead/cefd5c7c)
+      return 1;
+    }
+    elsif ($] == '5.013005') {
+      # not sure why this one leaks, but disable anyway - ANDK seems to make it weep
+      return 1;
+    }
+  }
+
+  return 0;
+}
+
 # Mimic $Module::Install::AUTHOR
 sub is_author {