Factor our verbose is() in Scope::Upper::TestGenerator

diff --git a/t/11-reap-level.t b/t/11-reap-level.t
index d5f639eb5de05537c7a666cafbb72983ee57a83b..2844541e923d86a0d14692ff794313410061a419 100644 (file)
--- a/t/11-reap-level.t
+++ b/t/11-reap-level.t
@@ -19,37 +19,19 @@ local $Scope::Upper::TestGenerator::call = sub {
 local $Scope::Upper::TestGenerator::test = sub {
  my ($height, $level, $i) = @_;
  my $j = $i < $height - $level ? 1 : 'undef';
- return "is(\$main::y, $j, 'y h=$height, l=$level, i=$i');\n";
+ return "verbose_is(\$main::y, $j, 'y h=$height, l=$level, i=$i');\n";
 };
 
 our ($x, $y, $testcase);
 
 sub check { $y = 0 unless defined $y; ++$y }
 
-{
- no warnings 'redefine';
- *is = sub ($$;$) {
-  my ($a, $b, $desc) = @_;
-  if (defined $testcase
-      and (defined $b) ? (not defined $a or $a != $b) : defined $a) {
-   diag <<DIAG;
-=== This testcase failed ===
-$testcase
-==== vvvvv Errors vvvvvv ===
-DIAG
-   undef $testcase;
-  }
-  Test::Leaner::is($a, $b, $desc);
- }
-}
-
 for my $level (0 .. 2) {
  for my $height ($level + 1 .. $level + 2) {
   my $tests = Scope::Upper::TestGenerator::gen($height, $level);
-  for (@$tests) {
-   $testcase = $_;
+  for $testcase (@$tests) {
    $x = $y = undef;
-   eval;
+   eval $testcase;
    diag $@ if $@;
   }
  }

diff --git a/t/12-reap-block.t b/t/12-reap-block.t
index fda9aca7d12686cea427af58d8df21c905b605aa..c76e066ec7667c2aa59e753eb1f5bb01657489c1 100644 (file)
--- a/t/12-reap-block.t
+++ b/t/12-reap-block.t
@@ -19,7 +19,7 @@ local $Scope::Upper::TestGenerator::call = sub {
 local $Scope::Upper::TestGenerator::test = sub {
  my ($height, $level, $i, $x) = @_;
  my $j = $i < $height - $level ? 0 : (defined $x ? $x : 'undef');
- return "is(\$x, $j, 'x h=$height, l=$level, i=$i');\n";
+ return "verbose_is(\$x, $j, 'x h=$height, l=$level, i=$i');\n";
 };
 
 local $Scope::Upper::TestGenerator::local_decl = sub {
@@ -35,30 +35,12 @@ our ($x, $testcase);
 
 sub check { $x = (defined $x) ? ($x ? 0 : $x . 'x') : 0 }
 
-{
- no warnings 'redefine';
- *is = sub ($$;$) {
-  my ($a, $b, $desc) = @_;
-  if (defined $testcase
-      and (defined $b) ? (not defined $a or $a != $b) : defined $a) {
-   diag <<DIAG;
-=== This testcase failed ===
-$testcase
-==== vvvvv Errors vvvvvv ===
-DIAG
-   undef $testcase;
-  }
-  Test::Leaner::is($a, $b, $desc);
- }
-}
-
 for my $level (0 .. 1) {
  my $height = $level + 1;
  my $tests = Scope::Upper::TestGenerator::gen($height, $level);
- for (@$tests) {
-  $testcase = $_;
+ for $testcase (@$tests) {
   $x = undef;
-  eval;
+  eval $testcase;
   diag $@ if $@;
  }
 }

diff --git a/t/21-localize-level.t b/t/21-localize-level.t
index e51d519a362e585cb882f87ce50f155fe7bc71c3..b091eeecc077b95d748d0bbbb2bddc84572d1484 100644 (file)
--- a/t/21-localize-level.t
+++ b/t/21-localize-level.t
@@ -19,35 +19,17 @@ local $Scope::Upper::TestGenerator::call = sub {
 local $Scope::Upper::TestGenerator::test = sub {
  my ($height, $level, $i) = @_;
  my $j = ($i == $height - $level) ? 1 : 'undef';
- return "is(\$main::y, $j, 'y h=$height, l=$level, i=$i');\n";
+ return "verbose_is(\$main::y, $j, 'y h=$height, l=$level, i=$i');\n";
 };
 
 our ($x, $y, $testcase);
 
-{
- no warnings 'redefine';
- *is = sub ($$;$) {
-  my ($a, $b, $desc) = @_;
-  if (defined $testcase
-      and (defined $b) ? (not defined $a or $a != $b) : defined $a) {
-   diag <<DIAG;
-=== This testcase failed ===
-$testcase
-==== vvvvv Errors vvvvvv ===
-DIAG
-   undef $testcase;
-  }
-  Test::Leaner::is($a, $b, $desc);
- }
-}
-
 for my $level (0 .. 2) {
  for my $height ($level + 1 .. $level + 2) {
   my $tests = Scope::Upper::TestGenerator::gen($height, $level);
-  for (@$tests) {
-   $testcase = $_;
+  for $testcase (@$tests) {
    $x = $y = undef;
-   eval;
+   eval $testcase;
    diag $@ if $@;
   }
  }

diff --git a/t/22-localize-block.t b/t/22-localize-block.t
index b32d25113a8cc12a60270b13cd1f002efaad5a22..80dcc3841190959d6d0bfa685af9ef085e5a16c8 100644 (file)
--- a/t/22-localize-block.t
+++ b/t/22-localize-block.t
@@ -19,7 +19,7 @@ local $Scope::Upper::TestGenerator::call = sub {
 local $Scope::Upper::TestGenerator::test = sub {
  my ($height, $level, $i, $x) = @_;
  my $j = ($i == $height - $level) ? 0 : (defined $x ? $x : 'undef');
- return "is(\$x, $j, 'x h=$height, l=$level, i=$i');\n";
+ return "verbose_is(\$x, $j, 'x h=$height, l=$level, i=$i');\n";
 };
 
 local $Scope::Upper::TestGenerator::local_test = sub { '' };
@@ -28,30 +28,12 @@ local $Scope::Upper::TestGenerator::allblocks = 1;
 
 our ($x, $testcase);
 
-{
- no warnings 'redefine';
- *is = sub ($$;$) {
-  my ($a, $b, $desc) = @_;
-  if (defined $testcase
-      and (defined $b) ? (not defined $a or $a != $b) : defined $a) {
-   diag <<DIAG;
-=== This testcase failed ===
-$testcase
-==== vvvvv Errors vvvvvv ===
-DIAG
-   undef $testcase;
-  }
-  Test::Leaner::is($a, $b, $desc);
- }
-}
-
 for my $level (0 .. 1) {
  my $height = $level + 1;
  my $tests = Scope::Upper::TestGenerator::gen($height, $level);
- for (@$tests) {
-  $testcase = $_;
+ for $testcase (@$tests) {
   $x = undef;
-  eval;
+  eval $testcase;
   diag $@ if $@;
  }
 }

diff --git a/t/31-localize_elem-level.t b/t/31-localize_elem-level.t
index b9c3e6bbdd88f5ca4a62c11b8e0302912b8c5032..cd700c7a4cb8a74c5b671a3ef2458944d315eddb 100644 (file)
--- a/t/31-localize_elem-level.t
+++ b/t/31-localize_elem-level.t
@@ -29,11 +29,10 @@ our @a;
 for my $level (0 .. 2) {
  for my $height ($level + 1 .. $level + 2) {
   my $tests = Scope::Upper::TestGenerator::gen($height, $level);
-  for (@$tests) {
-   $testcase = $_;
+  for $testcase (@$tests) {
    $x = undef;
    @a = (1, 2);
-   eval;
+   eval $testcase;
    diag $@ if $@;
   }
  }
@@ -56,11 +55,10 @@ our %h;
 for my $level (0 .. 2) {
  for my $height ($level + 1 .. $level + 2) {
   my $tests = Scope::Upper::TestGenerator::gen($height, $level);
-  for (@$tests) {
-   $testcase = $_;
+  for $testcase (@$tests) {
    $x = undef;
    %h = ();
-   eval;
+   eval $testcase;
    diag $@ if $@;
   }
  }

diff --git a/t/32-localize_elem-block.t b/t/32-localize_elem-block.t
index 776083105348c4c0517249f78077038ee9704a76..82cabc7ce515fd2419c031a5c7484b7d30a8e0e0 100644 (file)
--- a/t/32-localize_elem-block.t
+++ b/t/32-localize_elem-block.t
@@ -25,7 +25,7 @@ local $Scope::Upper::TestGenerator::call = sub {
 local $Scope::Upper::TestGenerator::test = sub {
  my ($height, $level, $i, $x) = @_;
  my $j = ($i == $height - $level) ? 0 : (defined $x ? $x : 11);
- return "is(\$a[1], $j, 'x h=$height, l=$level, i=$i');\n";
+ return "verbose_is(\$a[1], $j, 'x h=$height, l=$level, i=$i');\n";
 };
 
 local $Scope::Upper::TestGenerator::local_var = '$a[1]';
@@ -35,10 +35,9 @@ our @a;
 for my $level (0 .. 1) {
  my $height = $level + 1;
  my $tests = Scope::Upper::TestGenerator::gen($height, $level);
- for (@$tests) {
-  $testcase = $_;
+ for $testcase (@$tests) {
   @a = (10, 11);
-  eval;
+  eval $testcase;
   diag $@ if $@;
  }
 }
@@ -52,7 +51,7 @@ local $Scope::Upper::TestGenerator::call = sub {
 local $Scope::Upper::TestGenerator::test = sub {
  my ($height, $level, $i, $x) = @_;
  my $j = ($i == $height - $level) ? 0 : (defined $x ? $x : 'undef');
- return "is(\$h{a}, $j, 'x h=$height, l=$level, i=$i');\n";
+ return "verbose_is(\$h{a}, $j, 'x h=$height, l=$level, i=$i');\n";
 };
 
 local $Scope::Upper::TestGenerator::local_var = '$h{a}';
@@ -62,10 +61,9 @@ our %h;
 for my $level (0 .. 1) {
  my $height = $level + 1;
  my $tests = Scope::Upper::TestGenerator::gen($height, $level);
- for (@$tests) {
-  $testcase = $_;
+ for $testcase (@$tests) {
   %h = ();
-  eval;
+  eval $testcase;
   diag $@ if $@;
  }
 }

diff --git a/t/81-stress-level.t b/t/81-stress-level.t
index ddc78e8274237260cde0e64aa92bb5362c297a9c..88bc65d298d796754b7952858c2ea28af80589eb 100644 (file)
--- a/t/81-stress-level.t
+++ b/t/81-stress-level.t
@@ -19,37 +19,19 @@ local $Scope::Upper::TestGenerator::call = sub {
 local $Scope::Upper::TestGenerator::test = sub {
  my ($height, $level, $i) = @_;
  my $j = $i < $height - $level ? 1 : 'undef';
- return "is(\$main::y, $j, 'y h=$height, l=$level, i=$i');\n";
+ return "verbose_is(\$main::y, $j, 'y h=$height, l=$level, i=$i');\n";
 };
 
 our ($x, $y, $testcase);
 
 sub check { $y = 0 unless defined $y; ++$y }
 
-{
- no warnings 'redefine';
- *is = sub ($$;$) {
-  my ($a, $b, $desc) = @_;
-  if (defined $testcase
-      and (defined $b) ? (not defined $a or $a != $b) : defined $a) {
-   diag <<DIAG;
-=== This testcase failed ===
-$testcase
-==== vvvvv Errors vvvvvv ===
-DIAG
-   undef $testcase;
-  }
-  Test::Leaner::is($a, $b, $desc);
- }
-}
-
 for my $level (0 .. 4) {
  for my $height ($level + 1 .. $level + 2) {
   my $tests = Scope::Upper::TestGenerator::gen($height, $level);
-  for (@$tests) {
-   $testcase = $_;
+  for $testcase (@$tests) {
    $x = $y = undef;
-   eval;
+   eval $testcase;
    diag $@ if $@;
   }
  }

diff --git a/t/lib/Scope/Upper/TestGenerator.pm b/t/lib/Scope/Upper/TestGenerator.pm
index 8415632cc349a3a6859d53572f2f0ba3fe7f9d27..c71b8f36f2f7c925f79b0679a2b56fe8501e28f6 100644 (file)
--- a/t/lib/Scope/Upper/TestGenerator.pm
+++ b/t/lib/Scope/Upper/TestGenerator.pm
@@ -32,16 +32,43 @@ my @blocks = (
  [ 'eval q[',   '];' ],
 );
 
+push @blocks, [ 'given (1) {', '}' ] if "$]" >= 5.010_001;
+
+my %exports = (
+ verbose_is => \&verbose_is,
+);
+
 sub import {
  if ("$]" >= 5.010_001) {
-  push @blocks, [ 'given (1) {', '}' ];
   require feature;
   feature->import('switch');
  }
+
+ my $pkg = caller;
+ while (my ($name, $code) = each %exports) {
+  no strict 'refs';
+  *{$pkg.'::'.$name} = $code;
+ }
 }
 
 @blocks = map [ map "$_\n", @$_ ], @blocks;
 
+sub verbose_is ($$;$) {
+ my ($a, $b, $desc) = @_;
+
+ if (defined $::testcase
+      and (defined $b) ? (not defined $a or $a ne $b) : defined $a) {
+  Test::Leaner::diag(<<DIAG);
+=== This testcase failed ===
+$::testcase
+==== vvvvv Errors vvvvvv ===
+DIAG
+  undef $::testcase;
+ }
+
+ Test::Leaner::is($a, $b, $desc);
+}
+
 sub _block {
  my ($height, $level, $i) = @_;
  my $j = $height - $i;