develooper Front page | perl.perl5.porters | Postings from September 2010

[perl #35865] tied hash bug (still present in 5.8.7-to-be), Test::More attached

From:
Father Chrysostomos via RT
Date:
September 26, 2010 20:14
Subject:
[perl #35865] tied hash bug (still present in 5.8.7-to-be), Test::More attached
Message ID:
rt-3.6.HEAD-24759-1285557243-866.35865-15-0@perl.org
On Wed May 18 06:03:54 2005, merlyn@stonehenge.com wrote:
> #!perl
> 
> use Test::More no_plan;
> use strict;
> 
> BEGIN { require_ok('Tie::Hash') }
> 
> my @RECORDER;
> 
> BEGIN {
>   package Tie::Test;
>   use base 'Tie::StdHash';
> 
>   sub FETCH {
>     my $self = shift;
>     push @RECORDER, [$self, 'FETCH', @_];
>     $self->SUPER::FETCH(@_);
>   }
> 
>   sub STORE {
>     my $self = shift;
>     push @RECORDER, [$self, 'STORE', @_];
>     $self->SUPER::STORE(@_);
>   }
> }
> 
> tie my %tiedhash, Tie::Test::;
> 
> ## direct assignments properly call STORE
> 
> @RECORDER = ();
> $tiedhash{flintstone} = 'fred';
> is_deeply(\@RECORDER, [[tied %tiedhash, 'STORE', 'flintstone', 'fred']]);
> 
> ## however, this autoviv *should* first call FETCH to notice
> ## that $tiedhash{rubble} is undef, then call STORE to
> ## try to put a new anon hash into the slot (it doesn't), then
> ## call FETCH to fetch this new anon hash (it doesn't), which
> ## is then used to plug barney with short.
> ##
> ## instead, it calls FETCH to notice that $tiedhash{rubble} is undef,
> ## and then STORE with a newly populated hashref that already has
> ## { barney => 'short' }.  I say this is a bug!

But you are saving a *reference* to the hash in your STORE method. The
hash is then modified by the assignment. Then you check it after it has
been modified. If you add Storable::dclone to your STORE method, then
the tests should pass.

However, I do still believe it to be a bug that the autovivification
does not immediately do a FETCH after storing that empty hash ref, but
simply assumes that the tied hash would have returned the same.

See also bug #43011. This causes problems for JE::Object, too.


> 
> @RECORDER = ();
> $tiedhash{rubble}{barney} = 'short';
> is($_, tied %tiedhash, 'action is against %tiedhash')
>   for map $_->[0], @RECORDER;
> 
> is($RECORDER[0][1], 'FETCH', 'first op is a fetch') and
>   is($RECORDER[0][2], 'rubble', 'fetching key of rubble') and
>   is($RECORDER[1][1], 'STORE', 'second op is a store') and
>   is($RECORDER[1][2], 'rubble', 'storing key of rubble') and
>   isa_ok($RECORDER[1][3], 'HASH', 'storing an anonhash') and
>   is(keys %{$RECORDER[1][3]}, 0, 'empty anonhash') and
>   is($RECORDER[2][1], 'FETCH', 'third op is a fetch') and
>   is($RECORDER[2][2], 'rubble', 'fetching key of rubble') and
>   is(@RECORDER, 3, 'only 3 steps');
> 
> use Data::Dumper;
> diag(Dumper [\@RECORDER]);







nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About