diff options
author | Nicholas Clark <nick@ccl4.org> | 2021-08-18 07:45:10 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2021-08-27 13:53:22 +0000 |
commit | 19f584d5cb1041bace4e1d2d58fdb9f2c6084e0e (patch) | |
tree | 3bfe40a79ac6ec5bbdc5dfff47d2cfebd595df26 /t | |
parent | 013a76a28a7d7563cd3b604f421d2356f31b3196 (diff) | |
download | perl-19f584d5cb1041bace4e1d2d58fdb9f2c6084e0e.tar.gz |
Move the tied hash FETCH count tests to t/op/tiehash.t
This file is a better fit for them than t/op/tie.t
Diffstat (limited to 't')
-rw-r--r-- | t/op/tie.t | 42 | ||||
-rw-r--r-- | t/op/tiehash.t | 39 |
2 files changed, 39 insertions, 42 deletions
diff --git a/t/op/tie.t b/t/op/tie.t index 565518c027..bfcafce87a 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 daa0c30c16..c2e5b29757 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(); |