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

Re: Subroutine reference bug in Storable

Thread Previous | Thread Next
From:
Slaven Rezic
Date:
November 14, 2003 14:25
Subject:
Re: Subroutine reference bug in Storable
Message ID:
874qx6zj28.fsf@vran.herceg.de
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 ####

-- 
Slaven Rezic - slaven@rezic.de

    tktimex - project time manager
    http://sourceforge.net/projects/ptktools/

Thread Previous | Thread Next


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