From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 17 Jul 2014 09:20:30 +0000 (+0200)
Subject: Port taint-related fixes from b5ce6748, 4fb8d74c and 652d9b76
X-Git-Tag: v0.08271~14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=287a273736ae8b8157a627cf382a0b1315965dac;p=dbsrgits%2FDBIx-Class.git

Port taint-related fixes from b5ce6748, 4fb8d74c and 652d9b76

Needed to pass under the updated CI framework
---

diff --git a/t/52leaks.t b/t/52leaks.t
index 80c6cc5..de3f0b4 100644
--- a/t/52leaks.t
+++ b/t/52leaks.t
@@ -552,7 +552,17 @@ SKIP: {
     @{$persistence_tests->{PPerl}{cmd}}[ 1 .. $#{$persistence_tests->{PPerl}{cmd}} ],
   ];
 
-  require IPC::Open2;
+  # set up -I
+  require Config;
+  $ENV{PERL5LIB} = join ($Config::Config{path_sep}, @INC);
+
+  # adjust PATH for -T
+  if (length $ENV{PATH}) {
+    ( $ENV{PATH} ) = join ( $Config::Config{path_sep},
+      map { length($_) ? File::Spec->rel2abs($_) : () }
+        split /\Q$Config::Config{path_sep}/, $ENV{PATH}
+    ) =~ /\A(.+)\z/;
+  }
 
   for my $type (keys %$persistence_tests) { SKIP: {
     unless (eval "require $type") {
@@ -574,6 +584,8 @@ SKIP: {
         if system(@cmd);
     }
 
+    require IPC::Open2;
+
     for (1,2,3) {
       note ("Starting run in persistent env ($type pass $_)");
       IPC::Open2::open2(my $out, undef, @cmd);
diff --git a/t/55namespaces_cleaned.t b/t/55namespaces_cleaned.t
index 176de5e..c6ad435 100644
--- a/t/55namespaces_cleaned.t
+++ b/t/55namespaces_cleaned.t
@@ -33,6 +33,29 @@ BEGIN {
 use strict;
 use warnings;
 
+# FIXME This is a crock of shit, needs to go away
+# currently here to work around https://rt.cpan.org/Ticket/Display.html?id=74151
+# kill with fire when PS::XS / RT#74151 is *finally* fixed
+BEGIN {
+  my $PS_provider;
+
+  if ( "$]" < 5.010 ) {
+    require Package::Stash::PP;
+    $PS_provider = 'Package::Stash::PP';
+  }
+  else {
+    require Package::Stash;
+    $PS_provider = 'Package::Stash';
+  }
+  eval <<"EOS" or die $@;
+
+sub stash_for (\$) {
+  $PS_provider->new(\$_[0]);
+}
+1;
+EOS
+}
+
 use Test::More;
 
 use lib 't/lib';
@@ -41,7 +64,6 @@ use DBICTest;
 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;
@@ -98,7 +120,7 @@ for my $mod (@modules) {
     skip "$mod exempt from namespace checks",1 if $skip_idx->{$mod};
 
     my %all_method_like = (map
-      { %{Package::Stash->new($_)->get_all_symbols('CODE')} }
+      { %{stash_for($_)->get_all_symbols('CODE')} }
       (reverse @{mro::get_linear_isa($mod)})
     );
 
@@ -143,9 +165,18 @@ for my $mod (@modules) {
             last;
           }
         }
-        fail ("${mod}::${name} appears to have entered inheritance chain by import into "
-            . ($via || 'UNKNOWN')
-        );
+
+        # exception time
+        if (
+          ( $name eq 'import' and $via = 'Exporter' )
+        ) {
+          pass("${mod}::${name} is a valid uncleaned import from ${name}");
+        }
+        else {
+          fail ("${mod}::${name} appears to have entered inheritance chain by import into "
+              . ($via || 'UNKNOWN')
+          );
+        }
       }
     }
 
diff --git a/t/94versioning.t b/t/94versioning.t
index 93fcca7..98491d3 100644
--- a/t/94versioning.t
+++ b/t/94versioning.t
@@ -39,6 +39,11 @@ BEGIN {
 # in case it came from the env
 $ENV{DBIC_NO_VERSION_CHECK} = 0;
 
+# FIXME - work around RT#113965 in combination with -T on older perls:
+# the non-deparsing XS portion of D::D gets confused by some of the IO
+# handles trapped in the debug object of DBIC. What a mess.
+$Data::Dumper::Deparse = 1;
+
 use_ok('DBICVersion_v1');
 
 my $version_table_name = 'dbix_class_schema_versions';
diff --git a/t/storage/debug.t b/t/storage/debug.t
index 6d8e94c..5a43024 100644
--- a/t/storage/debug.t
+++ b/t/storage/debug.t
@@ -10,6 +10,9 @@ use DBIC::DebugObj;
 use DBIC::SqlMakerTest;
 use Path::Class qw/file/;
 
+plan skip_all => "Test is finicky under -T before 5.10"
+  if "$]" < 5.010 and ${^TAINT};
+
 BEGIN { delete @ENV{qw(DBIC_TRACE DBIC_TRACE_PROFILE DBICTEST_SQLITE_USE_FILE)} }
 
 my $schema = DBICTest->init_schema();
@@ -50,7 +53,7 @@ $schema->storage->debugfh(undef);
 }
 
 END {
-  unlink $lfn;
+  unlink $lfn if $lfn;
 }
 
 open(STDERRCOPY, '>&STDERR');