X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2Flib%2Fautovivification%2FTestCases.pm;h=9677a6d87b27d9c68e47e02479c88a5567a69027;hb=fdfce5eb8dd5546bb8cbcd946c68b6d72068feee;hp=87dfd0965fc81da8b35b0f0b6a5f65823b64af5f;hpb=b40a565a6a78eb14572fc60de1807d91662017fd;p=perl%2Fmodules%2Fautovivification.git

diff --git a/t/lib/autovivification/TestCases.pm b/t/lib/autovivification/TestCases.pm
index 87dfd09..9677a6d 100644
--- a/t/lib/autovivification/TestCases.pm
+++ b/t/lib/autovivification/TestCases.pm
@@ -3,7 +3,7 @@ package autovivification::TestCases;
 use strict;
 use warnings;
 
-use Test::More;
+use Test::Leaner;
 
 sub import {
  no strict 'refs';
@@ -12,6 +12,10 @@ sub import {
 
 sub in_strict { (caller 0)[8] & (eval { strict::bits(@_) } || 0) };
 
+sub do_nothing { }
+
+sub set_arg { $_[0] = 1 }
+
 sub generate {
  my ($var, $init, $code, $exp, $use, $opts, $global) = @_;
  my $decl = $global ? "our $var; local $var;" : "my $var;";
@@ -41,9 +45,11 @@ TESTCASE
 sub testcase_ok {
  local $_  = shift;
  my $sigil = shift;
+
  my @chunks = split /#+/, "$_ ";
  s/^\s+//, s/\s+$// for @chunks;
  my ($init, $code, $exp, $opts) = @chunks;
+
  (my $var = $init) =~ s/[^\$@%\w].*//;
  $init = $var eq $init ? '' : "$init;";
  my $use;
@@ -60,38 +66,45 @@ sub testcase_ok {
   $opts = 'default';
   $use  = '';
  }
- my @testcases = (
+
+ my @base = ([ $var, $init, $code, $exp, $use ]);
+ if ($var =~ /\$/) {
+  my ($name) = $var =~ /^\$(.*)/;
+
+  my @oldderef = @{$base[0]};
+  $oldderef[2] =~ s/\Q$var\E\->/\$$var/g;
+  push @base, \@oldderef;
+
+  my @nonref = @{$base[0]};
+  $nonref[0] = $sigil . $name;
+  for ($nonref[1], $nonref[2]) {
+   s/\@\Q$var\E([\[\{])/\@$name$1/g;
+   s/\Q$sigil$var\E/$nonref[0]/g;
+   s/\Q$var\E\->/$var/g;
+  }
+  my $simple      = $nonref[2] !~ /->/;
+  my $plain_deref = $nonref[2] =~ /\Q$nonref[0]\E/;
+  my $empty  = { '@' => '[ ]', '%' => '{ }' }->{$sigil};
+  if (($simple
+       and (   $nonref[3] =~ m!qr/\^Reference vivification forbidden.*?/!
+            or $nonref[3] =~ m!qr/\^Can't vivify reference.*?/!))
+  or ($plain_deref
+       and $nonref[3] =~ m!qr/\^Can't use an undefined value as a.*?/!)) {
+   $nonref[1] = '';
+   $nonref[2] = 1;
+   $nonref[3] = "'', 1, $empty";
+  }
+  $nonref[3] =~ s/,\s*undef\s*$/, $empty/;
+  push @base, \@nonref;
+ }
+
+ my @testcases = map {
+  my ($var, $init, $code, $exp, $use) = @$_;
   [ $var, $init,               $code, $exp, $use, $opts, 0 ],
   [ $var, "use strict; $init", $code, $exp, $use, $opts, 1 ],
   [ $var, "no strict;  $init", $code, $exp, $use, $opts, 1 ],
- );
- my @extra;
- for (@testcases) {
-  my $var = $_->[0];
-  if ($var =~ /\$/) {
-   my @new = @$_;
-   $new[0] =~ s/^\$/$sigil/;
-   for ($new[1], $new[2]) {
-    s/\Q$sigil$var\E/$new[0]/g;
-    s/\Q$var\E\->/$var/g;
-   }
-   my $simple      = $new[2] !~ /->/;
-   my $plain_deref = $new[2] =~ /\Q$new[0]\E/;
-   my $empty  = { '@' => '[ ]', '%' => '{ }' }->{$sigil};
-   if (($simple
-        and (   $new[3] =~ m!qr/\^Reference vivification forbidden.*?/!
-             or $new[3] =~ m!qr/\^Can't vivify reference.*?/!))
-    or ($plain_deref
-        and $new[3] =~ m!qr/\^Can't use an undefined value as a.*?/!)) {
-    $new[1] = '';
-    $new[2] = 1;
-    $new[3] = "'', 1, $empty";
-   }
-   $new[3] =~ s/,\s*undef\s*$/, $empty/;
-   push @extra, \@new;
-  }
- }
- push @testcases, @extra;
+ } @base;
+
  for (@testcases) {
   my ($testcase, $desc) = generate(@$_);
   my @N = (0 .. 9);