From: Vincent Pit 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/?a=commitdiff_plain;h=8a182537fdb8be2aedbb391151fffb79ad4fb75d;p=perl%2Fmodules%2Fautovivification.git 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; } }