Here's a patch for op/avhv.t ro remove the 'print "not "' in bleadperl.
You wanted us to send them to you, not to p5p, right?
--- Joe M.
*** avhv.t Wed Aug 29 10:59:00 2001
--- avhv.t.new Wed Aug 29 10:56:40 2001
***************
*** 19,24 ****
--- 19,38 ----
print "1..29\n";
+ my $test = 1;
+
+ sub ok {
+ my ($msg,$ok) = reverse @_;
+
+ $ok
+ ? print "ok $test\n"
+ : print "not ok $test # $msg\n";
+
+ $test++;
+ return $ok;
+
+ }
+
$sch = {
'abc' => 1,
'def' => 2,
***************
*** 36,42 ****
@keys = keys %$a;
@values = values %$a;
! if ($#keys == 2 && $#values == 2) {print "ok 1\n";} else {print "not ok 1\n";}
$i = 0; # stop -w complaints
--- 50,56 ----
@keys = keys %$a;
@values = values %$a;
! ok($#keys == 2 && $#values == 2,"key/value count");
$i = 0; # stop -w complaints
***************
*** 47,53 ****
}
}
! if ($i == 3) {print "ok 2\n";} else {print "not ok 2\n";}
# quick check with tied array
tie @fake, 'Tie::StdArray';
--- 61,67 ----
}
}
! ok($i == 3, "each()");
# quick check with tied array
tie @fake, 'Tie::StdArray';
***************
*** 55,61 ****
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
! if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
# quick check with tied array
tie @fake, 'Tie::BasicArray';
--- 69,75 ----
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
! ok($a->{'abc'} eq 'ABC',"Tie::StdArray");
# quick check with tied array
tie @fake, 'Tie::BasicArray';
***************
*** 63,69 ****
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
! if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
# quick check with tied array & tied hash
require Tie::Hash;
--- 77,83 ----
$a->[0] = $sch;
$a->{'abc'} = 'ABC';
! ok($a->{'abc'} eq 'ABC',"Tie::BasicArray");
# quick check with tied array & tied hash
require Tie::Hash;
***************
*** 72,184 ****
$a->[0] = \%fake;
$a->{'abc'} = 'ABC';
! if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
# hash slice
my $slice = join('', 'x',@$a{'abc','def'},'x');
! print "not " if $slice ne 'xABCx';
! print "ok 6\n";
# evaluation in scalar context
my $avhv = [{}];
! print "not " if %$avhv;
! print "ok 7\n";
push @$avhv, "a";
! print "not " if %$avhv;
! print "ok 8\n";
$avhv = [];
eval { $a = %$avhv };
! print "not " unless $@ and $@ =~ /^Can't coerce array into hash/;
! print "ok 9\n";
$avhv = [{foo=>1, bar=>2}];
! print "not " unless %$avhv =~ m,^\d+/\d+,;
! print "ok 10\n";
# check if defelem magic works
sub f {
! print "not " unless $_[0] eq 'a';
$_[0] = 'b';
- print "ok 11\n";
}
$a = [{key => 1}, 'a'];
! f($a->{key});
! print "not " unless $a->[1] eq 'b';
! print "ok 12\n";
# check if exists() is behaving properly
$avhv = [{foo=>1,bar=>2,pants=>3}];
! print "not " if exists $avhv->{bar};
! print "ok 13\n";
$avhv->{pants} = undef;
! print "not " unless exists $avhv->{pants};
! print "ok 14\n";
! print "not " if exists $avhv->{bar};
! print "ok 15\n";
$avhv->{bar} = 10;
! print "not " unless exists $avhv->{bar} and $avhv->{bar} == 10;
! print "ok 16\n";
$v = delete $avhv->{bar};
! print "not " unless $v == 10;
! print "ok 17\n";
!
! print "not " if exists $avhv->{bar};
! print "ok 18\n";
$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";
!
! print "not " unless "$avhv->{bar}" eq "yyy";
! print "ok 20\n";
# hash assignment
%$avhv = ();
! print "not " unless ref($avhv->[0]) eq 'HASH';
! print "ok 21\n";
%hv = %$avhv;
! print "not " if grep defined, values %hv;
! print "ok 22\n";
! print "not " if grep ref, keys %hv;
! print "ok 23\n";
%$avhv = (foo => 29, pants => 2, bar => 0);
! print "not " unless "@$avhv[1..3]" eq '29 0 2';
! print "ok 24\n";
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";
# 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";
--- 86,177 ----
$a->[0] = \%fake;
$a->{'abc'} = 'ABC';
! ok($a->{'abc'} eq 'ABC',"Tie::StdHash failure");
# hash slice
my $slice = join('', 'x',@$a{'abc','def'},'x');
! ok($slice eq 'xABCx',"hash slice");
# evaluation in scalar context
my $avhv = [{}];
! ok(!%$avhv,"empty scalar context");
!
push @$avhv, "a";
! ok(!%$avhv,"single scalar context");
$avhv = [];
eval { $a = %$avhv };
! ok($@ and $@ =~ /^Can't coerce array into hash/,"invalid coercion");
$avhv = [{foo=>1, bar=>2}];
! ok(%$avhv =~ m{^\d+/\d+}, "hash in scalar context");
# check if defelem magic works
sub f {
! my $failed = 0;
! $failed = 1 unless $_[0] eq 'a';
$_[0] = 'b';
}
$a = [{key => 1}, 'a'];
! ok(f($a->{key}) && $a->[1] eq 'b', "defelem magic");
# check if exists() is behaving properly
$avhv = [{foo=>1,bar=>2,pants=>3}];
! ok(!exists $avhv->{bar},"exists() with subhash");
$avhv->{pants} = undef;
! ok(exists $avhv->{pants},"exists() with undef assignment");
! ok(!exists $avhv->{bar},"exists() after undef assignment");
$avhv->{bar} = 10;
! ok(exists $avhv->{bar} and $avhv->{bar} == 10,"hash reassignment");
$v = delete $avhv->{bar};
! ok($v == 10,"delete() value check");
! ok(!exists $avhv->{bar},"exists() after delete()");
$avhv->{foo} = 'xxx';
$avhv->{bar} = 'yyy';
$avhv->{pants} = 'zzz';
@x = delete @{$avhv}{'foo','pants'};
! ok("@x" eq "xxx zzz","slice delete");
! ok("$avhv->{bar}" eq "yyy","check after slice delete");
# hash assignment
%$avhv = ();
! ok(ref($avhv->[0]) eq 'HASH', "hash assignment");
%hv = %$avhv;
! ok(!grep(defined, values %hv),"grep defined(), empty hash");
! ok(!grep(ref, keys %hv),"grep ref(), empty hash");
%$avhv = (foo => 29, pants => 2, bar => 0);
! ok("@$avhv[1..3]" eq '29 0 2', "array deref");
my $extra;
my @extra;
($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
! ok("@$avhv[1..3]" eq '42 HIKE! 53' and $extra eq 'moo',
! "proper distribution, list assign");
%$avhv = ();
(%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
! ok("@$avhv[1..3]" eq '42 HIKE! 53' and !defined $extra,
! "undef assign from list to scalar");
@extra = qw(whatever and stuff);
%$avhv = ();
(%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
! ok("@$avhv[1..3]" eq '42 HIKE! 53' and @extra == 0,
! "undef assign from list to array");
%$avhv = ();
(@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
! ok(ref $avhv->[0] eq 'HASH' and @extra == 6,
! "undef assign from list to hash");
# Check hash slices (BUG ID 20010423.002)
$avhv = [{foo=>1, bar=>2}];
@$avhv{"foo", "bar"} = (42, 53);
! ok($avhv->{foo} == 42 && $avhv->{bar} == 53, "hash slice assign from list");
