From: Peter Rabbitson <ribasushi@cpan.org>
Date: Mon, 4 Apr 2011 08:13:34 +0000 (+0200)
Subject: Consolidate all constants under DBIC::_ENV_, bump n::c breakage to < 5.8.5
X-Git-Tag: v0.08191~39
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e0b2dc7456481be6870a23a5927a99c8416c82f7;p=dbsrgits%2FDBIx-Class.git

Consolidate all constants under DBIC::_ENV_, bump n::c breakage to < 5.8.5
---

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index e5d9d85..c7d6c9d 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -4,20 +4,43 @@ use strict;
 use warnings;
 
 BEGIN {
+  package DBIx::Class::_ENV_;
+
   if ($] < 5.009_005) {
     require MRO::Compat;
-    *DBIx::Class::_ENV_::OLD_MRO = sub () { 1 };
+    *OLD_MRO = sub () { 1 };
   }
   else {
     require mro;
-    *DBIx::Class::_ENV_::OLD_MRO = sub () { 0 };
+    *OLD_MRO = sub () { 0 };
   }
 
   # ::Runmode would only be loaded by DBICTest, which in turn implies t/
-  *DBIx::Class::_ENV_::DBICTEST = eval { DBICTest::RunMode->is_author }
+  *DBICTEST = eval { DBICTest::RunMode->is_author }
     ? sub () { 1 }
     : sub () { 0 }
   ;
+
+  # During 5.13 dev cycle HELEMs started to leak on copy
+  *PEEPEENESS = (defined $ENV{DBICTEST_ALL_LEAKS}
+    # request for all tests would force "non-leaky" illusion and vice-versa
+    ? ! $ENV{DBICTEST_ALL_LEAKS}
+
+    # otherwise confess that this perl is busted ONLY on smokers
+    : do {
+      if (eval { DBICTest::RunMode->is_smoker }) {
+
+        # leaky 5.13.6 (fixed in blead/cefd5c7c)
+        if ($] == '5.013006') { 1 }
+
+        # not sure why this one leaks, but disable anyway - ANDK seems to make it weep
+        elsif ($] == '5.013005') { 1 }
+
+        else { 0 }
+      }
+      else { 0 }
+    }
+  ) ? sub () { 1 } : sub () { 0 };
 }
 
 use mro 'c3';
diff --git a/lib/DBIx/Class/Carp.pm b/lib/DBIx/Class/Carp.pm
index 62170ff..5f40094 100644
--- a/lib/DBIx/Class/Carp.pm
+++ b/lib/DBIx/Class/Carp.pm
@@ -3,6 +3,17 @@ package DBIx::Class::Carp;
 use strict;
 use warnings;
 
+# This is here instead of DBIx::Class because of load-order issues
+BEGIN {
+  ## FIXME FIXME FIXME - something is tripping up V::M on 5.8.1, leading
+  # to segfaults. When n::c/B::H::EndOfScope is rewritten in terms of tie()
+  # see if this starts working
+  *DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN = ($] < 5.008005)
+    ? sub () { 1 }
+    : sub () { 0 }
+  ;
+}
+
 use Carp ();
 use namespace::clean ();
 
@@ -44,13 +55,6 @@ my $warn = sub {
   );
 };
 
-# FIXME - see below
-BEGIN {
-  *__BROKEN_NC = ($] < 5.008003)
-    ? sub () { 1 }
-    : sub () { 0 }
-  ;
-}
 sub import {
   my (undef, $skip_pattern) = @_;
   my $into = caller;
@@ -102,7 +106,7 @@ sub import {
     ## FIXME FIXME FIXME - something is tripping up V::M on 5.8.1, leading
     # to segfaults. When n::c/B::H::EndOfScope is rewritten in terms of tie()
     # see if this starts working
-    unless __BROKEN_NC();
+    unless DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN();
 }
 
 sub unimport {
diff --git a/t/52leaks.t b/t/52leaks.t
index f2d23c8..6707b83 100644
--- a/t/52leaks.t
+++ b/t/52leaks.t
@@ -35,9 +35,10 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) {
 
 use lib qw(t/lib);
 use DBICTest::RunMode;
+use DBIx::Class;
 BEGIN {
   plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test"
-    if DBICTest::RunMode->peepeeness;
+    if DBIx::Class::_ENV_::PEEPEENESS();
 }
 
 use Scalar::Util qw/refaddr reftype weaken/;
diff --git a/t/55namespaces_cleaned.t b/t/55namespaces_cleaned.t
index 17f8750..6a3cc02 100644
--- a/t/55namespaces_cleaned.t
+++ b/t/55namespaces_cleaned.t
@@ -40,9 +40,6 @@ my $skip_idx = { map { $_ => 1 } (
   # G::L::D is unclean, but we never inherit from it
   'DBIx::Class::Admin::Descriptive',
   'DBIx::Class::Admin::Usage',
-
-  # exempt due to the __BROKEN_NC constant
-  'DBIx::Class::Carp',
 ) };
 
 my $has_cmop = eval { require Class::MOP };
@@ -73,7 +70,7 @@ for my $mod (@modules) {
 
     for my $name (keys %all_method_like) {
 
-      next if ( DBIx::Class::Carp::__BROKEN_NC() and $name =~ /^carp(?:_unique|_once)?$/ );
+      next if ( DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN() and $name =~ /^carp(?:_unique|_once)?$/ );
 
       # overload is a funky thing - it is neither cleaned, and its imports are named funny
       next if $name =~ /^\(/;
@@ -114,7 +111,7 @@ for my $mod (@modules) {
       }
     }
 
-    next if DBIx::Class::Carp::__BROKEN_NC();
+    next if DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN();
 
     # some common import names (these should never ever be methods)
     for my $f (qw/carp carp_once carp_unique croak confess cluck try catch finally/) {
diff --git a/t/71mysql.t b/t/71mysql.t
index 84bebc7..d732e1f 100644
--- a/t/71mysql.t
+++ b/t/71mysql.t
@@ -384,7 +384,13 @@ ZEROINSEARCH: {
 
     # kill our $dbh
     $schema_autorecon->storage->_dbh(undef);
-    ok (! defined $orig_dbh, 'Parent $dbh handle is gone');
+
+    TODO: {
+      local $TODO = "Perl $] is known to leak like a sieve"
+        if DBIx::Class::_ENV_::PEEPEENESS();
+
+      ok (! defined $orig_dbh, 'Parent $dbh handle is gone');
+    }
   }
   else {
     # wait for parent to kill its $dbh
@@ -400,7 +406,13 @@ ZEROINSEARCH: {
     # try to do something dbic-esque
     $rs->create({ name => "Hardcore Forker $$" });
 
-    ok (! defined $orig_dbh, 'DBIC operation triggered reconnect - old $dbh is gone');
+
+    TODO: {
+      local $TODO = "Perl $] is known to leak like a sieve"
+        if DBIx::Class::_ENV_::PEEPEENESS();
+
+      ok (! defined $orig_dbh, 'DBIC operation triggered reconnect - old $dbh is gone');
+    }
 
     exit 0;
   }
diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index 46e0918..e67c02a 100644
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -112,7 +112,7 @@ sub _database {
 }
 
 sub __mk_disconnect_guard {
-  return if DBICTest::RunMode->peepeeness; # leaks handles, delaying DESTROY, can't work right
+  return if DBIx::Class::_ENV_::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 207203d..b773c5d 100644
--- a/t/lib/DBICTest/RunMode.pm
+++ b/t/lib/DBICTest/RunMode.pm
@@ -110,24 +110,6 @@ 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 {
 
diff --git a/t/storage/error.t b/t/storage/error.t
index 002c328..b72b0fe 100644
--- a/t/storage/error.t
+++ b/t/storage/error.t
@@ -35,7 +35,7 @@ throws_ok (
 # exception fallback:
 
 SKIP: {
-  if (DBICTest::RunMode->peepeeness) {
+  if (DBIx::Class::_ENV_::PEEPEENESS()) {
     skip "Your perl version $] appears to leak like a sieve - skipping garbage collected \$schema test", 1;
   }