From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 29 Mar 2011 23:31:20 +0000 (+0200)
Subject: Several 5.8.old fixes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=90cfe42b94a798be8ee5498fd57e2e76adff5156;p=dbsrgits%2FDBIx-Class-Historic.git

Several 5.8.old fixes

* Stop running threading tests on < 5.8.5 - DBD::Pg is *really* unhappy there
* Switch t/55namespaces_cleaned.t to Package::Stash - the hand-written syntax
  breaks 5.8.1 and I'm lazy (and it's an implicit dep anyway)
* Stop auto-cleaning the imports of DBIC::Carp - it segfaults all over the
  place on 5.8.1 (will revisit when I rewrite n::c in pure-perl)
---

diff --git a/Makefile.PL b/Makefile.PL
index f11a5ea..8b538d5 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -53,6 +53,10 @@ my $test_requires = {
   'Test::Exception'          => '0.31',
   'Test::More'               => '0.92',
   'Test::Warn'               => '0.21',
+
+  # this is already a dep of n::c, but just in case - used by t/55namespaces_cleaned.t
+  # remove and do a manual glob-collection if n::c is no longer a dep
+  'Package::Stash'           => '0.28',
 };
 
 my $runtime_requires = {
diff --git a/lib/DBIx/Class/Carp.pm b/lib/DBIx/Class/Carp.pm
index e2af539..62170ff 100644
--- a/lib/DBIx/Class/Carp.pm
+++ b/lib/DBIx/Class/Carp.pm
@@ -44,6 +44,13 @@ my $warn = sub {
   );
 };
 
+# FIXME - see below
+BEGIN {
+  *__BROKEN_NC = ($] < 5.008003)
+    ? sub () { 1 }
+    : sub () { 0 }
+  ;
+}
 sub import {
   my (undef, $skip_pattern) = @_;
   my $into = caller;
@@ -91,7 +98,11 @@ sub import {
   };
 
   # cleanup after ourselves
-  namespace::clean->import(-cleanee => $into, qw/carp carp_once carp_unique/);
+  namespace::clean->import(-cleanee => $into, qw/carp carp_once carp_unique/)
+    ## 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();
 }
 
 sub unimport {
diff --git a/t/51threads.t b/t/51threads.t
index 8a1ed57..fb7cf10 100644
--- a/t/51threads.t
+++ b/t/51threads.t
@@ -10,8 +10,8 @@ BEGIN {
 }
 
 BEGIN {
-    plan skip_all => 'Minimum of perl 5.8.3 required for thread tests (DBD::Pg mandated)'
-        if $] < '5.008003';
+    plan skip_all => 'Minimum of perl 5.8.5 required for thread tests (DBD::Pg mandated)'
+        if $] < '5.008005';
 }
 
 use threads;
@@ -31,9 +31,6 @@ if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
 
 use_ok('DBICTest::Schema');
 
-diag "\n\nIt is ok if you see series of 'Attempt to free unreferenced scalar: ...' warnings during this test\n "
-  if $] < '5.008005';
-
 my $schema = DBICTest::Schema->connection($dsn, $user, $pass, { AutoCommit => 1, RaiseError => 1, PrintError => 0 });
 
 my $parent_rs;
diff --git a/t/51threadtxn.t b/t/51threadtxn.t
index e368771..65220b6 100644
--- a/t/51threadtxn.t
+++ b/t/51threadtxn.t
@@ -12,8 +12,8 @@ BEGIN {
 }
 
 BEGIN {
-    plan skip_all => 'Minimum of perl 5.8.3 required for thread tests (DBD::Pg mandated)'
-        if $] < '5.008003';
+    plan skip_all => 'Minimum of perl 5.8.5 required for thread tests (DBD::Pg mandated)'
+        if $] < '5.008005';
 }
 
 
@@ -32,9 +32,6 @@ if($num_children !~ /^[0-9]+$/ || $num_children < 10) {
 
 use_ok('DBICTest::Schema');
 
-diag "\n\nIt is ok if you see series of 'Attempt to free unreferenced scalar: ...' warnings during this test\n "
-  if $] < '5.008005';
-
 my $schema = DBICTest::Schema->connection($dsn, $user, $pass, { AutoCommit => 1, RaiseError => 1, PrintError => 0 });
 
 my $parent_rs;
diff --git a/t/53lean_startup.t b/t/53lean_startup.t
index d9f902e..d54de0b 100644
--- a/t/53lean_startup.t
+++ b/t/53lean_startup.t
@@ -15,8 +15,6 @@ use strict;
 use warnings;
 use Test::More;
 
-use Carp;
-
 BEGIN {
   my $core_modules = { map { $_ => 1 } qw/
     strict
diff --git a/t/55namespaces_cleaned.t b/t/55namespaces_cleaned.t
index 2556546..17f8750 100644
--- a/t/55namespaces_cleaned.t
+++ b/t/55namespaces_cleaned.t
@@ -6,9 +6,11 @@ use Test::More;
 use File::Find;
 use File::Spec;
 use B qw/svref_2object/;
+use Package::Stash;
 
 # makes sure we can load at least something
 use DBIx::Class;
+use DBIx::Class::Carp;
 
 my @modules = grep {
   my $mod = $_;
@@ -38,6 +40,9 @@ 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 };
@@ -52,15 +57,10 @@ for my $mod (@modules) {
   SKIP: {
     skip "$mod exempt from namespace checks",1 if $skip_idx->{$mod};
 
-    my %all_method_like = do {
-      no strict 'refs';
-      map {
-        my $m = $_;
-        map
-          { *{"${m}::$_"}{CODE} ? ( $_ => *{"${m}::$_"}{CODE} ) : () }
-          keys %{"${m}::"}
-      } (reverse @{mro::get_linear_isa($mod)});
-    };
+    my %all_method_like = (map
+      { %{Package::Stash->new($_)->get_all_symbols('CODE')} }
+      (reverse @{mro::get_linear_isa($mod)})
+    );
 
     my %parents = map { $_ => 1 } @{mro::get_linear_isa($mod)};
 
@@ -73,6 +73,8 @@ for my $mod (@modules) {
 
     for my $name (keys %all_method_like) {
 
+      next if ( DBIx::Class::Carp::__BROKEN_NC() and $name =~ /^carp(?:_unique|_once)?$/ );
+
       # overload is a funky thing - it is neither cleaned, and its imports are named funny
       next if $name =~ /^\(/;
 
@@ -112,6 +114,8 @@ for my $mod (@modules) {
       }
     }
 
+    next if DBIx::Class::Carp::__BROKEN_NC();
+
     # 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/) {
       if ($mod->can($f)) {