From @samv

Created by @samv

Found a segfault with thawing standard Perl structures with Storable.
This seems to be a bug on all Storable versions I tested, which
includes Perls 5.6.1 - 5.8.3.

Note that it only seems to trigger, if there are back-references to
overloaded objects, *after* something has been deparsed via
B​::Deparse - or is that thawed with eval?

The details of the structure don't seem to matter much, but I've made
the simplest structure I could manage that demonstrates the problem.
Which was a *lot* simpler than my original structure ;-).

Here's a test script, which I've tried to make as similar to the ones
in the Storable distribution as possible​:

#!/usr/bin/perl

sub BEGIN {
  if ($ENV{PERL_CORE}){
  chdir('t') if -d 't';
  @​INC = ('.', '../lib');
  } else {
  unshift @​INC, 't';
  }
  require Config; import Config;
  if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
  print "1..0 # Skip​: Storable was not built\n";
  exit 0;
  }
}

use strict;
BEGIN {
  if (!eval q{
  use Test;
  use B​::Deparse 0.61;
  use 5.006;
  1;
  }) {
  print "1..0 # skip​: tests only work with B​::Deparse 0.61 and at least pe
rl 5.6.0\n";
  exit;
  }
  require File​::Spec;
  if ($File​::Spec​::VERSION < 0.8) {
  print "1..0 # Skip​: newer File​::Spec needed\n";
  exit 0;
  }
}

use Storable qw(retrieve store nstore freeze nfreeze thaw dclone);
use Safe;

#$Storable​::DEBUGME = 1;

print "1..2\n";
{
  package Banana;
  use overload
  '<=>' => \&compare,
  '==' => \&equal,
  fallback => 1;
  sub compare { return int(rand(3))-1 };
  sub equal { return 1 if rand(1) > 0.5 }
}

my (@​a);

my $nasty =
  [
  foo => sub {
  print "Hey, there's some code here!\n";
  },
  ($a[0] = bless [ ], "Banana"),
  ($a[1] = [ ]),
  ];

# this one segfaults every time.
$a[0]->[0] = $a[0];

# this one only segfaults once in a while. Other times, it says​:
# Cannot restore overloading on REF(0x815460c) (package <unknown>)
#$a[1]->[0] = $a[0];

print "not " unless $nasty;
print "ok 1\n";

$Storable​::Deparse = 1;
$Storable​::Eval = 1;

my $schema2 = dclone $nasty;
print "not " unless $nasty;
print "ok 2\n";

Flags:
    category=core
    severity=low

Site configuration information for perl v5.8.1:

Configured by Debian Project at Fri Sep 26 16:57:02 BST 2003.

Summary of my perl5 (revision 5.0 version 8 subversion 1) configuration:
  Platform:
    osname=linux, osvers=2.4.21-c17b, archname=i386-linux-thread-multi
    uname='linux betelgeuse 2.4.21-c17b #2 sat sep 13 01:16:47 bst 2003 i686 unknown '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i386-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8.1 -Darchlib=/usr/lib/perl/5.8.1 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.1 -Dsitearch=/usr/local/lib/perl/5.8.1 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.1 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O3',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='2.95.4 20011002 (Debian prerelease)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lgdbm -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.2.5.so, so=so, useshrplib=true, libperl=libperl.so.5.8.1
    gnulibc_version='2.2.5'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    RC5


@INC for perl v5.8.1:
    /etc/perl
    /usr/local/lib/perl/5.8.1
    /usr/local/share/perl/5.8.1
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.8.1
    /usr/share/perl/5.8.1
    /usr/local/lib/site_perl
    .


Environment for perl v5.8.1:
    HOME=/home/sv
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/sv/bin:/usr/local/kde/bin:/usr/local/bin:/usr/bin:/bin:/usr/bin/X11:/usr/games:/usr/local/sbin:/usr/sbin:/sbin:/usr/local/mozilla
    PERL_BADLANG (unset)
    SHELL=/bin/bash

From @samv

Hmm, about this segfault... I've determined that it's due to the
freeze'ing side, not thaw'ing.

Here's the stream that a freeze of :

do {
  my $a = bless [ ], "Banana"; # Banana has overload
  $a->[0] = $a;
  [ $a, sub { "print "Goodbye, cruel world.\n" } ]
};

produces​:

^D^F^D1234^D^D^D^H^B^D^@​^@​^@​^T^Q^FBanana^B^A^@​^@​^@​^T^@​^@​^@​^@​^B^D^Z
@​{
  use strict 'refs';
  print "Goodbye, cruel world.\n";
}^@​^D^B^@​^@​^@​^@​^D^Z
@​{
  use strict 'refs';
  print "Goodbye, cruel world.\n";
}^@​

The code returned by B​::Deparse is there twice... hmm.

Note that this stream still seems to thaw correctly.

Switching it around;

do {
  my $a = bless [ ], "Banana"; # Banana has overload
  $a->[0] = $a;
  [ sub { "print "Goodbye, cruel world.\n" }, $a ]
};

produces​:

^D^F^D1234^D^D^D^H^B^D^@​^@​^@​^D^Z
@​{
  use strict 'refs';
  print "Goodbye, cruel world.\n";
}^@​^T^Q^FBanana^B^A^@​^@​^@​^T^@​^@​^@​^@​^D^D^B^@​^@​^@​^@​^D^Z
@​{
  use strict 'refs';
  print "Goodbye, cruel world.\n";
}^@​

Then, inside the retrieve_overloaded function, on the circular
reference (ie, the second time retrieve_overloaded is called), the
segfault is on this line​:

  stash = (HV *) SvSTASH (sv);

It's worth noting that at this point, SvTYPE(sv) is NULL; Devel​::Peek
has this to say of sv;

SV = NULL(0x0) at 0x84563b0
  REFCNT = 3
  FLAGS = ()

hmm. Investigating further...
--
Sam Vilain, sam@​vilain.net

Overheard at a supervision :
Supervisor : Do you think you understand the basic ideas of Quantum
  Mechanics ?
Supervisee : Ah! Well,what do we mean by "to understand" in the context
  of Quantum Mechanics?
Supervisor : You mean"No",don't you?
Supervisee : Yes.

From @samv

OK, ignore this. My test case was broken. The sub was really on the
input twice...

So, this may not be a problem with the data stream after all. Still
trying to find my way around this maze of code...

I'll correct the below, after all it's still useful data.

On Tue, 20 Jan 2004 19​:00, Sam Vilain wrote;

  > Hmm, about this segfault... I've determined that it's due to the
  > freeze'ing side, not thaw'ing.
  >
  > Here's the stream that a freeze of :
  >
  > do {
  > my $a = bless [ ], "Banana"; # Banana has overload
  > $a->[0] = $a;
  > [ $a, sub { print "Goodbye, cruel world.\n" }

, sub { print "Goodbye, cruel world.\n" },

  > ]
  > };
  >
  > produces​:
  >
  > ^D^F^D1234^D^D^D^H^B^D^@​^@​^@​^T^Q^FBanana^B^A^@​^@​^@​^T^@​^@​^@​^@​^B^D^Z
  > @​{
  > use strict 'refs';
  > print "Goodbye, cruel world.\n";
  > }^@​^D^B^@​^@​^@​^@​^D^Z
  > @​{
  > use strict 'refs';
  > print "Goodbye, cruel world.\n";
  > }^@​
  >
  > Note that this stream still seems to thaw correctly.
  >
  > Switching it around;
  >
  > do {
  > my $a = bless [ ], "Banana"; # Banana has overload
  > $a->[0] = $a;
  > [ sub { "print "Goodbye, cruel world.\n" }, $a

, sub { print "Goodbye, cruel world.\n" },

  > ]
  > };
  >
  > produces​:
  >
  > ^D^F^D1234^D^D^D^H^B^D^@​^@​^@​^D^Z
  > @​{
  > use strict 'refs';
  > print "Goodbye, cruel world.\n";
  > }^@​^T^Q^FBanana^B^A^@​^@​^@​^T^@​^@​^@​^@​^D^D^B^@​^@​^@​^@​^D^Z
  > @​{
  > use strict 'refs';
  > print "Goodbye, cruel world.\n";
  > }^@​
  >
  > Then, inside the retrieve_overloaded function, on the circular
  > reference (ie, the second time retrieve_overloaded is called), the
  > segfault is on this line​:
  >
  > stash = (HV *) SvSTASH (sv);
  >
  > It's worth noting that at this point, SvTYPE(sv) is NULL; Devel​::Peek
  > has this to say of sv;
  >
  > SV = NULL(0x0) at 0x84563b0
  > REFCNT = 3
  > FLAGS = ()
  >
  > hmm. Investigating further...

--
Sam Vilain, sam@​vilain.net

  Start every day with a smile and get it over with.
W C FIELDS

From @samv

Wohoo! Some progress...

It seems that because retrieve_overloaded() is recursive, if there is
another SX_OVERLOAD with a back-reference seen before the
retrieve_overloaded() back up the stack is finished, then the scalar
in the "aseen" array inside the ctx is still a placeholder (SvTYPE(x)
= 0).

I apologise if that makes about as much sense as a segway.

Here's a fix that stops the segfault, but the AMAGIC bits are missing
on the back-references;

--- Storable.xs.orig    Tue Jan 20 20:04:06 2004
+++ Storable.xs Tue Jan 20 20:04:57 2004
@@ -4202,6 +4202,10 @@
        /*
         * Restore overloading magic.
         */
+       if (!SvTYPE(sv)) {
+               TRACEME(("ok (retrieve_overloaded at 0x%"UVxf") - exiting 

  stash = (HV *) SvSTASH (sv);
  if (!stash || !Gv_AMG(stash))

If I put a sly SvAMAGIC_on(rv) inside that C<if(!...){ }> there, it
segfaults later on, when accessed, because Gv_AMG(stash) hasn't been
done. Whatever that does ;).

From here, it looks like there is a causality problem; so now, I need
to figure out why it doesn't apply in the case when there has been no
$Storable​::Eval beforehand...
--
Sam Vilain, sam@​vilain.net

  If Karl, instead of writing a lot about capital, had made a lot of
it ... it would have been much better.
KARL MARX'S MOTHER

From @samv

Hmm... a snippet from the $Storable​::DEBUGME output​:

aseen(#1) = 0x8490120 (refcnt=1)
retrieve
retrieve type = 26
retrieve_code (#2)
retrieve_scalar (#2), len = 64
aseen(#2) = 0x8437ee4 (refcnt=1)
small scalar len 64 '{
  use strict 'refs';
  print "Goodbye, cruel world.\n";
}'

note that both retrieve_code(#2) and retrieve_scalar(#2) are operating
on the same item number. That was the clue that gave it away.

It looks like the code is quite particular about what it calls the
`tag number' of a stream. Each referable object gets one of these,
and in short, retrieve_code() was counting two (sometimes... depending
on whether $Storable​::Eval was set :->) but store_code() was only
counting one.

I've attached the fix, and included the segfault protection afforded
by the previous patch (it now uses the nearby CROAK code path). I'm
sure that the problem will apply to at least one other piece of the
code so when I stumble across it I'll add the tests to
t/just_plain_nasty.t :-)
--
Sam Vilain, sam@​vilain.net

Real Programmers programs never work right the first time. But if
you throw them on the machine they can be patched into working order
in "only a few" 30-hour debugging sessions.

From @samv

diff -urN Storable-2.09.orig/ChangeLog Storable-2.09/ChangeLog
--- Storable-2.09.orig/ChangeLog	Tue Jan  6 04:43:38 2004
+++ Storable-2.09/ChangeLog	Tue Jan 20 22:23:59 2004
@@ -1,3 +1,11 @@
+`date`  `whoami`  :)
+
+    Version 2.10
+
+	Fix `tag count mismatch' with $Storable::Deparse that was causing
+	all back-references after a stored sub to be off-by-N (where N was
+	the number of code references in between).
+
 Sat Jan  3 18:49:18 GMT 2004   Nicholas Clark <nick@ccl4.org>
 
     Version 2.09
diff -urN Storable-2.09.orig/MANIFEST Storable-2.09/MANIFEST
--- Storable-2.09.orig/MANIFEST	Tue Jan  6 04:43:38 2004
+++ Storable-2.09/MANIFEST	Tue Jan 20 22:13:35 2004
@@ -16,6 +16,7 @@
 t/freeze.t		    See if Storable works
 t/integer.t		    For "use integer" testing
 t/interwork56.t		    Test combatibility kludge for 64bit data under 5.6.x
+t/just_plain_nasty.t	    Corner case corner.
 t/lock.t		    See if Storable works
 t/make_56_interwork.pl	    Make test data for interwork56.t
 t/make_downgrade.pl	    Make test data for downgrade.t
diff -urN Storable-2.09.orig/Storable.xs Storable-2.09/Storable.xs
--- Storable-2.09.orig/Storable.xs	Mon Sep 22 10:32:49 2003
+++ Storable-2.09/Storable.xs	Tue Jan 20 22:15:10 2004
@@ -791,6 +791,13 @@
  * Useful store shortcuts...
  */
 
+/*
+ * Note that if you put more than one mark for storing a particular
+ * type of thing, *and* in the retrieve_foo() function you mark both
+ * the thingy's you get off with SEEN(), you *must* increase the
+ * tagnum with cxt->tagnum++ along with this macro!
+ *     - samv 20Jan04
+ */
 #define PUTMARK(x) 							\
   STMT_START {								\
 	if (!cxt->fio)							\
@@ -2463,6 +2470,7 @@
 	 */
 
 	PUTMARK(SX_CODE);
+	cxt->tagnum++;   /* necessary, as SX_CODE is a SEEN() candidate */
 	TRACEME(("size = %d", len));
 	TRACEME(("code = %s", SvPV_nolen(text)));
 
@@ -4202,10 +4210,11 @@
 	/*
 	 * Restore overloading magic.
 	 */
-
-	stash = (HV *) SvSTASH (sv);
-	if (!stash || !Gv_AMG(stash))
-		CROAK(("Cannot restore overloading on %s(0x%"UVxf") (package %s)",
+	if (!SvTYPE(sv)
+	    || !(stash = (HV *) SvSTASH (sv))
+	    || !Gv_AMG(stash))
+		CROAK(("Cannot restore overloading on %s(0x%"UVxf
+		       ") (package %s)",
 		       sv_reftype(sv, FALSE),
 		       PTR2UV(sv),
 			   stash ? HvNAME(stash) : "<unknown>"));
@@ -4975,13 +4984,24 @@
     CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
 #else
 	dSP;
-	int type, count;
+	int type, count, tagnum;
 	SV *cv;
 	SV *sv, *text, *sub;
 
 	TRACEME(("retrieve_code (#%d)", cxt->tagnum));
 
 	/*
+	 *  Insert dummy SV in the aseen array so that we don't screw
+	 *  up the tag numbers.  We would just make the internal
+	 *  scalar an untagged item in the stream, but
+	 *  retrieve_scalar() calls SEEN().  So we just increase the
+	 *  tag number.
+	 */
+	tagnum = cxt->tagnum;
+	sv = newSViv(0);
+	SEEN(sv, cname);
+
+	/*
 	 * Retrieve the source of the code reference
 	 * as a small or large scalar
 	 */
@@ -5023,6 +5043,8 @@
 			CROAK(("Can't eval, please set $Storable::Eval to a true value"));
 		} else {
 			sv = newSVsv(sub);
+			/* fix up the dummy entry... */
+			av_store(cxt->aseen, tagnum, SvREFCNT_inc(sv));
 			return sv;
 		}
 	}
@@ -5060,8 +5082,9 @@
 
 	FREETMPS;
 	LEAVE;
+	/* fix up the dummy entry... */
+	av_store(cxt->aseen, tagnum, SvREFCNT_inc(sv));
 
-	SEEN(sv, cname);
 	return sv;
 #endif
 }
diff -urN Storable-2.09.orig/t/just_plain_nasty.t Storable-2.09/t/just_plain_nasty.t
--- Storable-2.09.orig/t/just_plain_nasty.t	Thu Jan  1 12:00:00 1970
+++ Storable-2.09/t/just_plain_nasty.t	Tue Jan 20 22:13:58 2004
@@ -0,0 +1,152 @@
+#!/usr/bin/perl
+
+# This is a test suite to cover all the nasty and horrible data
+# structures that cause bizarre corner cases.
+
+#  Everyone's invited! :-D
+
+sub BEGIN {
+    if ($ENV{PERL_CORE}){
+        chdir('t') if -d 't';
+        @INC = ('.', '../lib');
+    } else {
+        unshift @INC, 't';
+    }
+    require Config; import Config;
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
+        print "1..0 # Skip: Storable was not built\n";
+        exit 0;
+    }
+}
+
+use strict;
+BEGIN {
+    if (!eval q{
+        use Test;
+        use B::Deparse 0.61;
+        use 5.006;
+        1;
+    }) {
+        print "1..0 # skip: tests only work with B::Deparse 0.61 and at least pe
+rl 5.6.0\n";
+        exit;
+    }
+    require File::Spec;
+    if ($File::Spec::VERSION < 0.8) {
+        print "1..0 # Skip: newer File::Spec needed\n";
+        exit 0;
+    }
+}
+
+use Storable qw(freeze thaw);
+
+#$Storable::DEBUGME = 1;
+BEGIN {
+    plan tests => 34;
+}
+
+{
+    package Banana;
+    use overload   
+	'<=>' => \&compare,
+	    '==' => \&equal,
+		'""' => \&real,
+		fallback => 1;
+    sub compare { return int(rand(3))-1 };
+    sub equal { return 1 if rand(1) > 0.5 }
+    sub real { return "keep it so" }
+}
+
+my (@a);
+
+for my $dbun (1, 0) {  # dbun - don't be utterly nasty - being utterly
+                       # nasty means having a reference to the object
+                       # directly within itself. otherwise it's in the
+                       # second array.
+    my $nasty = [
+		 ($a[0] = bless [ ], "Banana"),
+		 ($a[1] = [ ]),
+		];
+
+    $a[$dbun]->[0] = $a[0];
+
+    ok(ref($nasty), "ARRAY", "Sanity found (now to play with it :->)");
+
+    $Storable::Deparse = $Storable::Deparse = 1;
+    $Storable::Eval = $Storable::Eval = 1;
+
+    headit("circular overload 1 - freeze");
+    my $icicle = freeze $nasty;
+    #print $icicle;   # cat -ve recommended :)
+    headit("circular overload 1 - thaw");
+    my $oh_dear = thaw $icicle;
+    ok(ref($oh_dear), "ARRAY", "dclone - circular overload");
+    ok($oh_dear->[0], "keep it so", "amagic ok 1");
+    ok($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
+
+    headit("closure dclone - freeze");
+    $icicle = freeze sub { "two" };
+    #print $icicle;
+    headit("closure dclone - thaw");
+    my $sub2 = thaw $icicle;
+    ok($sub2->(), "two", "closures getting dcloned OK");
+
+    headit("circular overload, after closure - freeze");
+    #use Data::Dumper;
+    #print Dumper $nasty;
+    $icicle = freeze $nasty;
+    #print $icicle;
+    headit("circular overload, after closure - thaw");
+    $oh_dear = thaw $icicle;
+    ok(ref($oh_dear), "ARRAY", "dclone - after a closure dclone");
+    ok($oh_dear->[0], "keep it so", "amagic ok 1");
+    ok($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
+
+    push @{$nasty}, sub { print "Goodbye, cruel world.\n" };
+    headit("closure freeze AFTER circular overload");
+    #print Dumper $nasty;
+    $icicle = freeze $nasty;
+    #print $icicle;
+    headit("circular thaw AFTER circular overload");
+    $oh_dear = thaw $icicle;
+    ok(ref($oh_dear), "ARRAY", "dclone - before a closure dclone");
+    ok($oh_dear->[0], "keep it so", "amagic ok 1");
+    ok($oh_dear->[$dbun]->[0], "keep it so", "amagic ok 2");
+
+    @{$nasty} = @{$nasty}[0, 2, 1];
+    headit("closure freeze BETWEEN circular overload");
+    #print Dumper $nasty;
+    $icicle = freeze $nasty;
+    #print $icicle;
+    headit("circular thaw BETWEEN circular overload");
+    $oh_dear = thaw $icicle;
+    ok(ref($oh_dear), "ARRAY", "dclone - between a closure dclone");
+    ok($oh_dear->[0], "keep it so", "amagic ok 1");
+    ok($oh_dear->[$dbun?2:0]->[0], "keep it so", "amagic ok 2");
+
+    @{$nasty} = @{$nasty}[1, 0, 2];
+    headit("closure freeze BEFORE circular overload");
+    #print Dumper $nasty;
+    $icicle = freeze $nasty;
+    #print $icicle;
+    headit("circular thaw BEFORE circular overload");
+    $oh_dear = thaw $icicle;
+    ok(ref($oh_dear), "ARRAY", "dclone - after a closure dclone");
+    ok($oh_dear->[1], "keep it so", "amagic ok 1");
+    ok($oh_dear->[$dbun+1]->[0], "keep it so", "amagic ok 2");
+}
+
+sub headit {
+
+    return;  # comment out to get headings - useful for scanning
+             # output with $Storable::DEBUGME = 1
+
+    my $title = shift;
+
+    my $size_left = (66 - length($title)) >> 1;
+    my $size_right = (67 - length($title)) >> 1;
+
+    print "# ".("-" x $size_left). " $title "
+	.("-" x $size_right)."\n";
+}
+

From @steve-m-hay

Sam Vilain wrote​:

I've attached the fix, and included the segfault protection afforded
by the previous patch (it now uses the nearby CROAK code path). I'm
sure that the problem will apply to at least one other piece of the
code so when I stumble across it I'll add the tests to
t/just_plain_nasty.t :-)

The fix seems to work for me on WinXP with perl-5.8.3​: the new test
breaks with Storable 2.09 and is fixed by the patch.

- Steve

Radan Computational Ltd.

The information contained in this message and any files transmitted with it are confidential and intended for the addressee(s) only. If you have received this message in error or there are any problems, please notify the sender immediately. The unauthorized use, disclosure, copying or alteration of this message is strictly forbidden. Note that any views or opinions presented in this email are solely those of the author and do not necessarily represent those of Radan Computational Ltd. The recipient(s) of this message should check it and any attached files for viruses​: Radan Computational will accept no liability for any damage caused by any virus transmitted by this email.

The RT System itself - Status changed from 'new' to 'open'

From @schwern

[sam@​vilain.net - Tue Jan 20 02​:14​:31 2004]​:

I've attached the fix, and included the segfault protection afforded
by the previous patch (it now uses the nearby CROAK code path). I'm
sure that the problem will apply to at least one other piece of the
code so when I stumble across it I'll add the tests to
t/just_plain_nasty.t :-)

Looks like this patch was applied to Storable 2.10 but the bug left open.

Resolved.

@schwern - Status changed from 'open' to 'resolved'

From @samv

Michael G Schwern via RT wrote​:

I've attached the fix, and included the segfault protection afforded
by the previous patch (it now uses the nearby CROAK code path). I'm
sure that the problem will apply to at least one other piece of the
code so when I stumble across it I'll add the tests to
t/just_plain_nasty.t :-)
Looks like this patch was applied to Storable 2.10 but the bug left open.
Resolved.

This bug is caused anywhere where the PUTMARK count in the stream
mismatches the actual number of thingies dumped... which is why the
minimal test suites never found it.

I think this bug only really manifests with circular references, ie
back references in the stream, plus a bug of the above nature. So,
adding a circular reference at the "end" of each stream pointing to
some other place within the stream, and checking it still points to
the same place on the way out might be a good way to catch some more
of these.

Sam.