develooper Front page | perl.perl5.porters | Postings from November 2003

Re: Subroutine reference bug in Storable

Thread Previous
From:
Andrew Sterling Hanenkamp
Date:
November 15, 2003 07:44
Subject:
Re: Subroutine reference bug in Storable
Message ID:
3FB64904.3030809@hanenkamp.com
Thank you.  Applying this patch to Storable locally has resulted in 
correct output from all of the test programs I'd created and fixed the 
problem in the original module in which I discovered it.  I haven't seen 
any new problem with the patch either.

Cheers,
Sterling

Slaven Rezic wrote:

>Andrew Sterling Hanenkamp <sterling@hanenkamp.com> writes:
>
>  
>
>>I was writing some code that dinked around with Storable's
>>deparse/eval and I started having problems with some CODE refs turning
>>into SCALAR refs in a hash of hashes.  I don't know what the problem
>>is, but I can recreate the problem with this little snippet:
>>
>>use Storable qw(freeze thaw);
>>use Data::Dumper;
>>
>>$Data::Dumper::Deparse = 1;
>>$Storable::Deparse     = 1;
>>$Storable::Eval        = 1;
>>
>>push @$data, { -foo => sub { "hey foo" }, };
>>push @$data, { -foo => $data->[0]{-foo}, };
>>
>>print Dumper($data);
>>print Dumper(thaw(freeze($data)));
>>
>>This (on my system using Storable 2.08 and Perl 5.8.0) results in this
>>output:
>>
>>$VAR1 = [
>>          {
>>            '-foo' => sub {
>>                            'hey foo';
>>                        }
>>          },
>>          {
>>            '-foo' => $VAR1->[0]{'-foo'}
>>          }
>>        ];
>>$VAR1 = [
>>          {
>>            '-foo' => sub {
>>                            package Storable;
>>                            'hey foo';
>>                        }
>>          },
>>          {
>>            '-foo' => \'{
>>    \'hey foo\';
>>}'
>>          }
>>        ];
>>
>>Note that the second -foo is a reference to the string "{ 'hey foo' }"
>>rather than a CODE ref.  I think I should also mention that when I
>>originally encountered this bug, I had multiple keys in each hash and
>>the second CODE ref that was having the problem would actually pick up
>>a reference to the value of a entirely different key with a scalar
>>value.
>>
>>If this bug has been fixed by 5.8.1 or 5.8.2, I apologize, but I
>>haven't moved to the latest version yet.
>>
>>    
>>
>
>Here's a patch for the problem. Can you check if your other code works
>with the patch, too?
>
>The deparsed code being in the Storable package is also ugly. I'll
>think about a solution for this one...
>
>Regards,
>        Slaven
>
># .
># 
># To apply this patch:
># STEP 1: Chdir to the source directory.
># STEP 2: Run the 'applypatch' program with this patch file as input.
>#
># If you do not have 'applypatch', it is part of the 'makepatch' package
># that you can fetch from the Comprehensive Perl Archive Network:
># http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
># In the above URL, 'x' should be 2 or higher.
>#
># To apply this patch without the use of 'applypatch':
># STEP 1: Chdir to the source directory.
># STEP 2: Run the 'patch' program with this file as input.
>#
>#### End of Preamble ####
>
>#### Patch data follows ####
>diff -up '../../../bleedperl/ext/Storable/Storable.xs' 'Storable.xs'
>Index: ./Storable.xs
>--- ./Storable.xs	Mon Sep  8 16:08:27 2003
>+++ ./Storable.xs	Fri Nov 14 23:17:10 2003
>@@ -1,4 +1,5 @@
>-/*
>+/* -*- mode: C; tab-width: 4; -*-
>+ *
>  *  Store and retrieve mechanism.
>  *
>  *  Copyright (c) 1995-2000, Raphael Manfredi
>@@ -5061,6 +5062,7 @@ static SV *retrieve_code(stcxt_t *cxt, c
> 	FREETMPS;
> 	LEAVE;
> 
>+	cxt->tagnum--; /* undo the tagnum increment in retrieve_l?scalar */
> 	SEEN(sv, cname);
> 	return sv;
> #endif
>diff -up '../../../bleedperl/ext/Storable/t/code.t' 't/code.t'
>Index: ./t/code.t
>--- ./t/code.t	Mon Jul 28 14:52:48 2003
>+++ ./t/code.t	Fri Nov 14 23:15:33 2003
>@@ -38,7 +38,7 @@ BEGIN {
>     }
> }
> 
>-BEGIN { plan tests => 49 }
>+BEGIN { plan tests => 59 }
> 
> use Storable qw(retrieve store nstore freeze nfreeze thaw dclone);
> use Safe;
>@@ -282,3 +282,30 @@ ok(prototype($thawed->[4]), prototype($o
>     }
> }
> 
>+{
>+    # Check internal "seen" code
>+    my $short_sub = sub { "short sub" }; # for SX_SCALAR
>+    # for SX_LSCALAR
>+    my $long_sub_code = 'sub { "' . "x"x255 . '" }';
>+    my $long_sub = eval $long_sub_code; die $@ if $@;
>+    my $sclr = \1;
>+
>+    local $Storable::Deparse = 1;
>+    local $Storable::Eval    = 1;
>+
>+    for my $sub ($short_sub, $long_sub) {
>+	my $res;
>+
>+	$res = thaw freeze [$sub, $sub];
>+	ok(int($res->[0]), int($res->[1]));
>+
>+	$res = thaw freeze [$sclr, $sub, $sub, $sclr];
>+	ok(int($res->[0]), int($res->[3]));
>+	ok(int($res->[1]), int($res->[2]));
>+
>+	$res = thaw freeze [$sub, $sub, $sclr, $sclr];
>+	ok(int($res->[0]), int($res->[1]));
>+	ok(int($res->[2]), int($res->[3]));
>+    }
>+
>+}
>#### End of Patch data ####
>
>#### ApplyPatch data follows ####
># Data version        : 1.0
># Date generated      : Fri Nov 14 23:17:30 2003
># Generated by        : makepatch 2.00_05
># Recurse directories : Yes
># p 'Storable.xs' 158320 1068848230 0100660
># p 't/code.t' 6422 1068848133 0100555
>#### End of ApplyPatch data ####
>
>#### End of Patch kit [created: Fri Nov 14 23:17:30 2003] ####
>#### Patch checksum: 76 2061 17355 ####
>#### Checksum: 94 2686 3392 ####
>
>  
>

-- 
<>< ><> <>< ><> <>< ><> <>< ><> <>< ><> <>< ><> <>< ><> <>< ><> <>< ><>
  Andrew Sterling Hanenkamp
  http://Andrew.Sterling.Hanenkamp.com/
  sterling@hanenkamp.com / sterling@cis.ksu.edu

  Keep me informed on the behaviour of this kernel..  As the
  "BugFree(tm)" series didn't turn out too well, I'm starting a new
  series called the "ItWorksForMe(tm)" series, of which this new 
  kernel is yet another shining example.
                       -- Linus, in the announcement for 1.3.29
	



Thread Previous


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