From: Vincent Pit <vince@profvince.com>
Date: Sun, 9 Sep 2012 10:14:22 +0000 (+0200)
Subject: Factor our verbose is() in Scope::Upper::TestGenerator
X-Git-Tag: v0.20~19
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=824b421b73e313d2eb4fd950c231272c1a52ed58

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

diff --git a/t/11-reap-level.t b/t/11-reap-level.t
index d5f639e..2844541 100644
--- 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 fda9aca..c76e066 100644
--- 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 e51d519..b091eee 100644
--- 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 b32d251..80dcc38 100644
--- 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 b9c3e6b..cd700c7 100644
--- 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 7760831..82cabc7 100644
--- 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 ddc78e8..88bc65d 100644
--- 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 8415632..c71b8f3 100644
--- 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;