X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Favhv.t;h=d301fad6ec237109489d377ea3ac5f5031ab06dd;hb=397cf4b72b64bab2d81c27006b39549ca667b5a8;hp=1ee1da72d649e04cbe26feb9497a8e8dbf374d78;hpb=e43e3698bae0df548586993239e41f4f949a3f78;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/avhv.t b/t/op/avhv.t
index 1ee1da7..d301fad 100755
--- a/t/op/avhv.t
+++ b/t/op/avhv.t
@@ -1,5 +1,8 @@
 #!./perl
 
+# This test was originally for pseudo-hashes.  It now exists to ensure
+# they were properly removed in 5.9.
+
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
@@ -13,11 +16,25 @@ sub TIEARRAY  { bless [], $_[0] }
 sub STORE     { $_[0]->[$_[1]] = $_[2] }
 sub FETCH     { $_[0]->[$_[1]] }
 sub FETCHSIZE { scalar(@{$_[0]})} 
-sub STORESIZE { $#{$_[0]} = $_[1]+1 } 
+sub STORESIZE { $#{$_[0]} = $_[1]+1 }
 
 package main;
 
-print "1..29\n";
+require './test.pl';
+plan(tests => 40);
+
+# Helper function to check the typical error message.
+sub not_hash {
+    my($err) = shift;
+    like( $err, qr/^Not a HASH reference / ) ||
+      printf STDERR "# at %s line %d.\n", (caller)[1,2];
+}
+
+# Something to place inside if blocks and while loops that won't get
+# compiled out.
+my $foo = 42;
+sub no_op { $foo++ }
+
 
 $sch = {
     'abc' => 1,
@@ -29,41 +46,68 @@ $sch = {
 $a = [];
 $a->[0] = $sch;
 
-$a->{'abc'} = 'ABC';
-$a->{'def'} = 'DEF';
-$a->{'jkl'} = 'JKL';
+eval {
+    $a->{'abc'} = 'ABC';
+};
+not_hash($@);
 
-@keys = keys %$a;
-@values = values %$a;
+eval {
+    $a->{'def'} = 'DEF';
+};
+not_hash($@);
 
-if ($#keys == 2 && $#values == 2) {print "ok 1\n";} else {print "not ok 1\n";}
+eval {
+    $a->{'jkl'} = 'JKL';
+};
+not_hash($@);
 
-$i = 0;		# stop -w complaints
+eval {
+    @keys = keys %$a;
+};
+not_hash($@);
+
+eval {
+    @values = values %$a;
+};
+not_hash($@);
 
-while (($key,$value) = each %$a) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-	$key =~ y/a-z/A-Z/;
-	$i++ if $key eq $value;
+eval {
+    while( my($k,$v) = each %$a ) {
+        no_op;
     }
-}
+};
+not_hash($@);
 
-if ($i == 3) {print "ok 2\n";} else {print "not ok 2\n";}
 
 # quick check with tied array
 tie @fake, 'Tie::StdArray';
 $a = \@fake;
 $a->[0] = $sch;
 
-$a->{'abc'} = 'ABC';
-if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
+eval {
+    $a->{'abc'} = 'ABC';
+};
+not_hash($@);
+
+eval {
+    if ($a->{'abc'} eq 'ABC') { no_op(23) } else { no_op(42) }
+};
+not_hash($@);
 
 # quick check with tied array
 tie @fake, 'Tie::BasicArray';
 $a = \@fake;
 $a->[0] = $sch;
 
-$a->{'abc'} = 'ABC';
-if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
+eval {
+    $a->{'abc'} = 'ABC';
+};
+not_hash($@);
+
+eval {
+    if ($a->{'abc'} eq 'ABC') { no_op(23) } else { no_op(42) }
+};
+not_hash($@);
 
 # quick check with tied array & tied hash
 require Tie::Hash;
@@ -71,31 +115,47 @@ tie %fake, Tie::StdHash;
 %fake = %$sch;
 $a->[0] = \%fake;
 
-$a->{'abc'} = 'ABC';
-if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
+eval {
+    $a->{'abc'} = 'ABC';
+};
+not_hash($@);
+
+eval {
+    if ($a->{'abc'} eq 'ABC') { no_op(23) } else { no_op(42) }
+};
+not_hash($@);
+
 
 # hash slice
-my $slice = join('', 'x',@$a{'abc','def'},'x');
-print "not " if $slice ne 'xABCx';
-print "ok 6\n";
+eval {
+    my $slice = join('', 'x',@$a{'abc','def'},'x');
+};
+not_hash($@);
+
 
 # evaluation in scalar context
 my $avhv = [{}];
-print "not " if %$avhv;
-print "ok 7\n";
+
+eval {
+    () = %$avhv;
+};
+not_hash($@);
 
 push @$avhv, "a";
-print "not " if %$avhv;
-print "ok 8\n";
+eval {
+    () = %$avhv;
+};
+not_hash($@);
 
 $avhv = [];
 eval { $a = %$avhv };
-print "not " unless $@ and $@ =~ /^Can't coerce array into hash/;
-print "ok 9\n";
+not_hash($@);
 
 $avhv = [{foo=>1, bar=>2}];
-print "not " unless %$avhv =~ m,^\d+/\d+,;
-print "ok 10\n";
+eval {
+    %$avhv =~ m,^\d+/\d+,;
+};
+not_hash($@);
 
 # check if defelem magic works
 sub f {
@@ -104,81 +164,121 @@ sub f {
     print "ok 11\n";
 }
 $a = [{key => 1}, 'a'];
-f($a->{key});
-print "not " unless $a->[1] eq 'b';
-print "ok 12\n";
+eval {
+    f($a->{key});
+};
+not_hash($@);
 
 # check if exists() is behaving properly
 $avhv = [{foo=>1,bar=>2,pants=>3}];
-print "not " if exists $avhv->{bar};
-print "ok 13\n";
+eval {
+    no_op if exists $avhv->{bar};
+};
+not_hash($@);
+
+eval {
+    $avhv->{pants} = undef;
+};
+not_hash($@);
 
-$avhv->{pants} = undef;
-print "not " unless exists $avhv->{pants};
-print "ok 14\n";
-print "not " if exists $avhv->{bar};
-print "ok 15\n";
+eval {
+    no_op if exists $avhv->{pants};
+};
+not_hash($@);
+
+eval {
+    no_op if exists $avhv->{bar};
+};
+not_hash($@);
 
-$avhv->{bar} = 10;
-print "not " unless exists $avhv->{bar} and $avhv->{bar} == 10;
-print "ok 16\n";
+eval {
+    $avhv->{bar} = 10;
+};
+not_hash($@);
 
-$v = delete $avhv->{bar};
-print "not " unless $v == 10;
-print "ok 17\n";
+eval {
+    no_op unless exists $avhv->{bar} and $avhv->{bar} == 10;
+};
+not_hash($@);
 
-print "not " if exists $avhv->{bar};
-print "ok 18\n";
+eval {
+    $v = delete $avhv->{bar};
+};
+not_hash($@);
 
-$avhv->{foo} = 'xxx';
-$avhv->{bar} = 'yyy';
-$avhv->{pants} = 'zzz';
-@x = delete @{$avhv}{'foo','pants'};
-print "# @x\nnot " unless "@x" eq "xxx zzz";
-print "ok 19\n";
+eval {
+    no_op if exists $avhv->{bar};
+};
+not_hash($@);
 
-print "not " unless "$avhv->{bar}" eq "yyy";
-print "ok 20\n";
+eval {
+    $avhv->{foo} = 'xxx';
+};
+not_hash($@);
+eval {
+    $avhv->{bar} = 'yyy';
+};
+not_hash($@);
+eval {
+    $avhv->{pants} = 'zzz';
+};
+not_hash($@);
+eval {
+    @x = delete @{$avhv}{'foo','pants'};
+};
+not_hash($@);
+eval {
+    no_op unless "$avhv->{bar}" eq "yyy";
+};
+not_hash($@);
 
 # hash assignment
-%$avhv = ();
-print "not " unless ref($avhv->[0]) eq 'HASH';
-print "ok 21\n";
+eval {
+    %$avhv = ();
+};
+not_hash($@);
 
-%hv = %$avhv;
-print "not " if grep defined, values %hv;
-print "ok 22\n";
-print "not " if grep ref, keys %hv;
-print "ok 23\n";
+eval {
+    %hv = %$avhv;
+};
+not_hash($@);
 
-%$avhv = (foo => 29, pants => 2, bar => 0);
-print "not " unless "@$avhv[1..3]" eq '29 0 2';
-print "ok 24\n";
+eval {
+    %$avhv = (foo => 29, pants => 2, bar => 0);
+};
+not_hash($@);
 
 my $extra;
 my @extra;
-($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
-print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and $extra eq 'moo';
-print "ok 25\n";
-
-%$avhv = ();
-(%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
-print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and !defined $extra;
-print "ok 26\n";
-
-@extra = qw(whatever and stuff);
-%$avhv = ();
-(%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
-print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and @extra == 0;
-print "ok 27\n";
-
-%$avhv = ();
-(@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
-print "not " unless ref $avhv->[0] eq 'HASH' and @extra == 6;
-print "ok 28\n";
+eval {
+    ($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
+};
+not_hash($@);
+
+eval {
+    %$avhv = ();
+    (%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
+};
+not_hash($@);
+
+eval {
+    @extra = qw(whatever and stuff);
+    %$avhv = ();
+};
+not_hash($@);
+eval {
+    (%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
+};
+not_hash($@);
+
+eval {
+    (@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
+};
+not_hash($@);
 
 # Check hash slices (BUG ID 20010423.002)
 $avhv = [{foo=>1, bar=>2}];
-@$avhv{"foo", "bar"} = (42, 53);
-print "not " unless $avhv->{foo} == 42 && $avhv->{bar} == 53;
-print "ok 29\n";
+eval {
+    @$avhv{"foo", "bar"} = (42, 53);
+};
+not_hash($@);