From: Vincent Pit <vince@profvince.com>
Date: Wed, 17 Jun 2009 22:04:34 +0000 (+0200)
Subject: Really test non-ref arrays and hashes
X-Git-Tag: v0.03~13
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fautovivification.git;a=commitdiff_plain;h=8a182537fdb8be2aedbb391151fffb79ad4fb75d

Really test non-ref arrays and hashes
---

diff --git a/t/20-hash.t b/t/20-hash.t
index aac9f97..e7a1703 100644
--- a/t/20-hash.t
+++ b/t/20-hash.t
@@ -118,12 +118,12 @@ $x->{a} = 1 # 1 for $x->{b}; () # '', undef, { a => 1, b => undef } # +store
 
 --- dereferencing ---
 
-$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/Can't use an undefined value as a HASH reference/ : ''), undef, undef
-$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/Can't use an undefined value as a HASH reference/ : ''), undef, undef #
-$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/Can't use an undefined value as a HASH reference/ : ''), undef, undef # +fetch
-$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/Can't use an undefined value as a HASH reference/ : ''), undef, undef # +exists
-$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/Can't use an undefined value as a HASH reference/ : ''), undef, undef # +delete
-$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/Can't use an undefined value as a HASH reference/ : ''), undef, undef # +store
+$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/^Can't use an undefined value as a HASH reference/ : ''), undef, undef
+$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/^Can't use an undefined value as a HASH reference/ : ''), undef, undef #
+$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/^Can't use an undefined value as a HASH reference/ : ''), undef, undef # +fetch
+$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/^Can't use an undefined value as a HASH reference/ : ''), undef, undef # +exists
+$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/^Can't use an undefined value as a HASH reference/ : ''), undef, undef # +delete
+$x # no warnings 'uninitialized'; my @a = %$x; () # ($strict ? qr/^Can't use an undefined value as a HASH reference/ : ''), undef, undef # +store
 
 $x->{a} = 1 # my @a = %$x; () # '', undef, { a => 1 } # +fetch
 $x->{a} = 1 # my @a = %$x; () # '', undef, { a => 1 } # +exists
diff --git a/t/21-array.t b/t/21-array.t
index eeb8811..744c492 100644
--- a/t/21-array.t
+++ b/t/21-array.t
@@ -118,12 +118,12 @@ $x->[0] = 1 # 1 for $x->[1]; () # '', undef, [ 1, undef ] # +store
 
 --- dereferencing ---
 
-$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/Can't use an undefined value as an ARRAY reference/ : ''), undef, undef
-$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/Can't use an undefined value as an ARRAY reference/ : ''), undef, undef #
-$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/Can't use an undefined value as an ARRAY reference/ : ''), undef, undef # +fetch
-$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/Can't use an undefined value as an ARRAY reference/ : ''), undef, undef # +exists
-$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/Can't use an undefined value as an ARRAY reference/ : ''), undef, undef # +delete
-$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/Can't use an undefined value as an ARRAY reference/ : ''), undef, undef # +store
+$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/^Can't use an undefined value as an ARRAY reference/ : ''), undef, undef
+$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/^Can't use an undefined value as an ARRAY reference/ : ''), undef, undef #
+$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/^Can't use an undefined value as an ARRAY reference/ : ''), undef, undef # +fetch
+$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/^Can't use an undefined value as an ARRAY reference/ : ''), undef, undef # +exists
+$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/^Can't use an undefined value as an ARRAY reference/ : ''), undef, undef # +delete
+$x # no warnings 'uninitialized'; my @a = @$x; () # ($strict ? qr/^Can't use an undefined value as an ARRAY reference/ : ''), undef, undef # +store
 
 $x->[0] = 1 # my @a = @$x; () # '', undef, [ 1 ] # +fetch
 $x->[0] = 1 # my @a = @$x; () # '', undef, [ 1 ] # +exists
diff --git a/t/lib/autovivification/TestCases.pm b/t/lib/autovivification/TestCases.pm
index 4170a37..73faad8 100644
--- a/t/lib/autovivification/TestCases.pm
+++ b/t/lib/autovivification/TestCases.pm
@@ -68,9 +68,24 @@ sub testcase_ok {
   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;
   }
  }