From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 26 Jul 2011 13:21:02 +0000 (+0200)
Subject: Moar stresstesting
X-Git-Tag: 0.21~11
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8de3b21ee8035f8a29a2fa3794e8aa9c87af9eb7;hp=017bd598b6a69299db79e5c59b35f10d047c2d81;p=p5sagit%2Fnamespace-clean.git

Moar stresstesting
---

diff --git a/t/05-explicit-cleanee.t b/t/05-explicit-cleanee.t
index 3556a5d..3cd3bd5 100644
--- a/t/05-explicit-cleanee.t
+++ b/t/05-explicit-cleanee.t
@@ -4,7 +4,7 @@ use strict;
 
 use FindBin;
 use lib "$FindBin::Bin/lib";
-use Test::More tests => 19;
+use Test::More tests => 2019;
 
 use_ok('CleaneeTarget');
 
@@ -23,3 +23,43 @@ ok !CleaneeTarget->can('d_baz'),    'directly removed disappeared (2/2)';
 my @values = qw( 23 27 17 XFOO XBAR XBAZ 7 8 9 );
 is(CleaneeTarget->summary->[ $_ ], $values[ $_ ], sprintf('testing sub in cleanee (%d/%d)', $_ + 1, scalar @values))
     for 0 .. $#values;
+
+
+# some torture
+SKIP: {
+
+  skip "This part of the test segfaults perl $] with both tie() and B::H::EOS."
+    . ' Actual code (e.g. DBIx::Class) works fine so did not investigate further',
+    2000 if $] < 5.008003;
+
+  local @INC = @INC;
+  my @code;
+  unshift @INC, sub {
+
+    if ($_[1] =~ /CleaneeTarget\/No(\d+)/) {
+      my @code = (
+        "package CleaneeTarget::No${1};",
+        "sub x_foo { 'XFOO' }",
+        "sub x_bar { 'XBAR' }",
+
+        "use CleaneeBridgeExplicit;",
+
+        "1;",
+      );
+
+      return sub { return 0 unless @code; $_ = shift @code; 1; }
+    }
+    else {
+      return ();
+    }
+  };
+
+  for (1..1000) {
+    my $pkg = "CleaneeTarget::No${_}";
+
+    my @val = require "CleaneeTarget/No${_}.pm";
+
+    ok !$pkg->can('x_foo'),    'explicitely removed disappeared';
+    ok  $pkg->can('x_bar'),    'not in explicit removal and still there';
+  }
+}