Also test arrays without aelemfast optimization

[perl/modules/autovivification.git] / t / lib / autovivification / TestCases.pm

diff --git a/t/lib/autovivification/TestCases.pm b/t/lib/autovivification/TestCases.pm
index 4170a3736ddc4da3139ea09091fa2df5c3ab7d04..87dfd0965fc81da8b35b0f0b6a5f65823b64af5f 100644 (file)
--- a/t/lib/autovivification/TestCases.pm
+++ b/t/lib/autovivification/TestCases.pm
@@ -12,11 +12,13 @@ sub import {
 
 sub in_strict { (caller 0)[8] & (eval { strict::bits(@_) } || 0) };
 
-sub source {
- my ($var, $init, $code, $exp, $use, $global) = @_;
+sub generate {
+ my ($var, $init, $code, $exp, $use, $opts, $global) = @_;
  my $decl = $global ? "our $var; local $var;" : "my $var;";
  my $test = $var =~ /^[@%]/ ? "\\$var" : $var;
- return <<TESTCASE;
+ my $desc = join('; ', map { my $x = $_; $x=~ s,;\s*$,,; $x }
+                                   grep /\S/, $decl, $init, $code) . " <$opts>";
+ return <<TESTCASE, $desc;
 $decl
 $init
 my \$strict = autovivification::TestCases::in_strict('refs');
@@ -59,26 +61,40 @@ sub testcase_ok {
   $use  = '';
  }
  my @testcases = (
-  [ $var, $init,               $code, $exp, $use, 0 ],
-  [ $var, "use strict; $init", $code, $exp, $use, 1 ],
-  [ $var, "no strict;  $init", $code, $exp, $use, 1 ],
+  [ $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/;
-   $new[1] =~ s/$var\->/$var/g;
-   $new[2] =~ s/$var\->/$var/g;
+   $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;
  for (@testcases) {
-  my $testcase = source(@$_);
-  my ($var, $init, $code) = @$_;
-  my $desc = do { (my $x = "$var | $init") =~ s,;\s+$,,; $x } . " | $code | $opts";
+  my ($testcase, $desc) = generate(@$_);
+  my @N = (0 .. 9);
   eval $testcase;
   diag "== This testcase failed to compile ==\n$testcase\n## Reason: $@" if $@;
  }