diff --git a/t/op/tie.t b/t/op/tie.t index 565518c027e2..bfcafce87ad3 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -21,48 +21,6 @@ done_testing(); __END__ -######## -# tied hash in list context -use Tie::Hash; -my %tied; -tie %tied, "Tie::StdHash"; -%tied = qw(perl rules beer foamy); -my @a = %tied; -if ($a[0] eq 'beer') { - print "@a\n"; -} else { - # Must do this explicitly (not sort) to spot if keys and values are muddled - print "$a[2] $a[3] $a[0] $a[1]\n" -} - -EXPECT -beer foamy perl rules -######## -# tied hash keys in list context -use Tie::Hash; -my %tied; -tie %tied, "Tie::StdHash"; -%tied = qw(perl rules beer foamy); -my @a = keys %tied; -@a = sort @a; -print "@a\n"; - -EXPECT -beer perl -######## -# tied hash values in list context -use Tie::Hash; -my %tied; -tie %tied, "Tie::StdHash"; -%tied = qw(perl rules beer foamy); -my @a = values %tied; -@a = sort @a; -print "@a\n"; - -EXPECT -foamy rules -######## - # standard behaviour, without any extra references use Tie::Hash ; tie %h, Tie::StdHash; diff --git a/t/op/tiehash.t b/t/op/tiehash.t index daa0c30c16c7..c2e5b29757d5 100644 --- a/t/op/tiehash.t +++ b/t/op/tiehash.t @@ -150,4 +150,43 @@ package TestIterators { is("@have", "@want", "tie/untie resets the hash iterator"); } +{ + require Tie::Hash; + my $count; + + package Tie::Count { + use parent -norequire, 'Tie::StdHash'; + sub FETCH { + ++$count; + return $_[0]->SUPER::FETCH($_[1]); + } + } + + $count = 0; + my %tied; + tie %tied, "Tie::Count"; + %tied = qw(perl rules beer foamy); + my @a = %tied; + if ($a[0] eq 'beer') { + is("@a", "beer foamy perl rules", "tied hash in list context"); + } else { + is("@a", "perl rules beer foamy", "tied hash in list context"); + } + is($count, 2, "two FETCHes for tied hash in list context"); + + $count = 0; + + @a = keys %tied; + @a = sort @a; + is("@a", "beer perl", "tied hash keys in list context"); + is($count, 0, "no FETCHes for tied hash keys in list context"); + + $count = 0; + @a = values %tied; + @a = sort @a; + + is("@a", "foamy rules", "tied hash values in list context"); + is($count, 2, "two FETCHes for tied hash values in list context"); +} + done_testing();