From: Jarkko Hietaniemi Date: Sun, 1 Jul 2001 14:04:20 +0000 (+0000) Subject: Upgrade to Storable 1.0.12, from Raphael Manfredi. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e993d95c6e24a91b7f3eb45e4b27ff04efa2e0f6;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Storable 1.0.12, from Raphael Manfredi. p4raw-id: //depot/perl@11060 --- diff --git a/ext/Storable/ChangeLog b/ext/Storable/ChangeLog index bed6cec..3f07731 100644 --- a/ext/Storable/ChangeLog +++ b/ext/Storable/ChangeLog @@ -1,3 +1,21 @@ +Sun Jul 1 13:27:32 MEST 2001 Raphael Manfredi + +. Description: + + Systematically use "=over 4" for POD linters. + Apparently, POD linters are much stricter than would + otherwise be needed, but that's OK. + + Fixed memory corruption on croaks during thaw(). Thanks + to Claudio Garcia for reproducing this bug and providing the + code to exercise it. Added test cases for this bug, adapted + from Claudio's code. + + Made code compile cleanly with -Wall (from Jarkko Hietaniemi). + + Changed tagnum and classnum from I32 to IV in context. Also + from Jarkko. + Thu Mar 15 01:22:32 MET 2001 Raphael Manfredi . Description: diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm index fa15b01..6bc2a75 100644 --- a/ext/Storable/Storable.pm +++ b/ext/Storable/Storable.pm @@ -1,4 +1,4 @@ -;# $Id: Storable.pm,v 1.0.1.10 2001/03/15 00:20:25 ram Exp $ +;# $Id: Storable.pm,v 1.0.1.11 2001/07/01 11:22:14 ram Exp $ ;# ;# Copyright (c) 1995-2000, Raphael Manfredi ;# @@ -6,6 +6,10 @@ ;# in the README file that comes with the distribution. ;# ;# $Log: Storable.pm,v $ +;# Revision 1.0.1.11 2001/07/01 11:22:14 ram +;# patch12: systematically use "=over 4" for POD linters +;# patch12: updated version number +;# ;# Revision 1.0.1.10 2001/03/15 00:20:25 ram ;# patch11: updated version number ;# @@ -59,7 +63,7 @@ package Storable; @ISA = qw(Exporter DynaLoader); use AutoLoader; use vars qw($forgive_me $VERSION); -$VERSION = '1.011'; +$VERSION = '1.012'; *AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr... # diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index f045acb..3c79eb6 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -3,7 +3,7 @@ */ /* - * $Id: Storable.xs,v 1.0.1.8 2001/03/15 00:20:55 ram Exp $ + * $Id: Storable.xs,v 1.0.1.9 2001/07/01 11:25:02 ram Exp $ * * Copyright (c) 1995-2000, Raphael Manfredi * @@ -11,6 +11,11 @@ * in the README file that comes with the distribution. * * $Log: Storable.xs,v $ + * Revision 1.0.1.9 2001/07/01 11:25:02 ram + * patch12: fixed memory corruption on croaks during thaw() + * patch12: made code compile cleanly with -Wall (Jarkko Hietaniemi) + * patch12: changed tagnum and classnum from I32 to IV in context + * * Revision 1.0.1.8 2001/03/15 00:20:55 ram * patch11: last version was wrongly compiling with assertions on * @@ -47,6 +52,7 @@ #include #include +#include /* Perl's one, needed since 5.6 */ #include #if 0 @@ -74,21 +80,18 @@ */ #ifndef PERL_VERSION /* For perls < 5.6 */ -#include -#define PERL_REVISION 5 -#define PERL_VERSION PATCHLEVEL -#define PERL_SUBVERSION SUBVERSION +#define PERL_VERSION PATCHLEVEL #ifndef newRV_noinc #define newRV_noinc(sv) ((Sv = newRV(sv)), --SvREFCNT(SvRV(Sv)), Sv) #endif -#if (PERL_VERSION <= 4) /* Older perls (<= 5.004) lack PL_ namespace */ +#if (PATCHLEVEL <= 4) /* Older perls (<= 5.004) lack PL_ namespace */ #define PL_sv_yes sv_yes #define PL_sv_no sv_no #define PL_sv_undef sv_undef -#if (PERL_SUBVERSION <= 4) /* 5.004_04 has been reported to lack newSVpvn */ +#if (SUBVERSION <= 4) /* 5.004_04 has been reported to lack newSVpvn */ #define newSVpvn newSVpv #endif -#endif /* PERL_VERSION <= 4 */ +#endif /* PATCHLEVEL <= 4 */ #ifndef HvSHAREKEYS_off #define HvSHAREKEYS_off(hv) /* Ignore */ #endif @@ -274,21 +277,23 @@ typedef unsigned long stag_t; /* Used by pre-0.6 binary format */ typedef struct stcxt { int entry; /* flags recursion */ int optype; /* type of traversal operation */ - HV *hseen; /* which objects have been seen, store time */ - AV *hook_seen; /* which SVs were returned by STORABLE_freeze() */ - AV *aseen; /* which objects have been seen, retrieve time */ - HV *hclass; /* which classnames have been seen, store time */ - AV *aclass; /* which classnames have been seen, retrieve time */ - HV *hook; /* cache for hook methods per class name */ - IV tagnum; /* incremented at store time for each seen object */ - IV classnum; /* incremented at store time for each seen classname */ - int netorder; /* true if network order used */ - int s_tainted; /* true if input source is tainted, at retrieve time */ - int forgive_me; /* whether to be forgiving... */ - int canonical; /* whether to store hashes sorted by key */ + HV *hseen; /* which objects have been seen, store time */ + AV *hook_seen; /* which SVs were returned by STORABLE_freeze() */ + AV *aseen; /* which objects have been seen, retrieve time */ + HV *hclass; /* which classnames have been seen, store time */ + AV *aclass; /* which classnames have been seen, retrieve time */ + HV *hook; /* cache for hook methods per class name */ + IV tagnum; /* incremented at store time for each seen object */ + IV classnum; /* incremented at store time for each seen classname */ + int netorder; /* true if network order used */ + int s_tainted; /* true if input source is tainted, at retrieve time */ + int forgive_me; /* whether to be forgiving... */ + int canonical; /* whether to store hashes sorted by key */ int s_dirty; /* context is dirty due to CROAK() -- can be cleaned */ - struct extendable keybuf; /* for hash key retrieval */ - struct extendable membuf; /* for memory store/retrieve operations */ + int membuf_ro; /* true means membuf is read-only and msaved is rw */ + struct extendable keybuf; /* for hash key retrieval */ + struct extendable membuf; /* for memory store/retrieve operations */ + struct extendable msaved; /* where potentially valid mbuf is saved */ PerlIO *fio; /* where I/O are performed, NULL for memory */ int ver_major; /* major of version for retrieved object */ int ver_minor; /* minor of version for retrieved object */ @@ -298,7 +303,7 @@ typedef struct stcxt { #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI) -#if (PERL_VERSION <= 4) && (PERL_SUBVERSION < 68) +#if (PATCHLEVEL <= 4) && (SUBVERSION < 68) #define dSTCXT_SV \ SV *perinterp_sv = perl_get_sv(MY_VERSION, FALSE) #else /* >= perl5.004_68 */ @@ -402,7 +407,7 @@ static stcxt_t *Context_ptr = &Context; } while (0) #define KBUFCHK(x) do { \ if (x >= ksiz) { \ - TRACEME(("** extending kbuf to %d bytes", x+1)); \ + TRACEME(("** extending kbuf to %d bytes (had %d)", x+1, ksiz)); \ Renew(kbuf, x+1, char); \ ksiz = x+1; \ } \ @@ -443,10 +448,34 @@ static stcxt_t *Context_ptr = &Context; #define MBUF_SIZE() (mptr - mbase) /* + * MBUF_SAVE_AND_LOAD + * MBUF_RESTORE + * + * Those macros are used in do_retrieve() to save the current memory + * buffer into cxt->msaved, before MBUF_LOAD() can be used to retrieve + * data from a string. + */ +#define MBUF_SAVE_AND_LOAD(in) do { \ + ASSERT(!cxt->membuf_ro, ("mbase not already saved")); \ + cxt->membuf_ro = 1; \ + TRACEME(("saving mbuf")); \ + StructCopy(&cxt->membuf, &cxt->msaved, struct extendable); \ + MBUF_LOAD(in); \ +} while (0) + +#define MBUF_RESTORE() do { \ + ASSERT(cxt->membuf_ro, ("mbase is read-only")); \ + cxt->membuf_ro = 0; \ + TRACEME(("restoring mbuf")); \ + StructCopy(&cxt->msaved, &cxt->membuf, struct extendable); \ +} while (0) + +/* * Use SvPOKp(), because SvPOK() fails on tainted scalars. * See store_scalar() for other usage of this workaround. */ #define MBUF_LOAD(v) do { \ + ASSERT(cxt->membuf_ro, ("mbase is read-only")); \ if (!SvPOKp(v)) \ CROAK(("Not a scalar string")); \ mptr = mbase = SvPV(v, msiz); \ @@ -456,7 +485,9 @@ static stcxt_t *Context_ptr = &Context; #define MBUF_XTEND(x) do { \ int nsz = (int) round_mgrow((x)+msiz); \ int offset = mptr - mbase; \ - TRACEME(("** extending mbase to %d bytes", nsz)); \ + ASSERT(!cxt->membuf_ro, ("mbase is not read-only")); \ + TRACEME(("** extending mbase from %d to %d bytes (wants %d new)", \ + msiz, nsz, (x))); \ Renew(mbase, nsz, char); \ msiz = nsz; \ mptr = mbase + offset; \ @@ -929,6 +960,19 @@ static void init_perinterp(void) } /* + * reset_context + * + * Called at the end of every context cleaning, to perform common reset + * operations. + */ +static void reset_context(stcxt_t *cxt) +{ + cxt->entry = 0; + cxt->s_dirty = 0; + cxt->optype &= ~(ST_STORE|ST_RETRIEVE); /* Leave ST_CLONE alone */ +} + +/* * init_store_context * * Initialize a new store context for real recursion. @@ -1038,13 +1082,17 @@ static void clean_store_context(stcxt_t *cxt) * Insert real values into hashes where we stored faked pointers. */ - hv_iterinit(cxt->hseen); - while ((he = hv_iternext(cxt->hseen))) - HeVAL(he) = &PL_sv_undef; + if (cxt->hseen) { + hv_iterinit(cxt->hseen); + while ((he = hv_iternext(cxt->hseen))) /* Extra () for -Wall, grr.. */ + HeVAL(he) = &PL_sv_undef; + } - hv_iterinit(cxt->hclass); - while ((he = hv_iternext(cxt->hclass))) - HeVAL(he) = &PL_sv_undef; + if (cxt->hclass) { + hv_iterinit(cxt->hclass); + while ((he = hv_iternext(cxt->hclass))) /* Extra () for -Wall, grr.. */ + HeVAL(he) = &PL_sv_undef; + } /* * And now dispose of them... @@ -1084,8 +1132,7 @@ static void clean_store_context(stcxt_t *cxt) sv_free((SV *) hook_seen); } - cxt->entry = 0; - cxt->s_dirty = 0; + reset_context(cxt); } /* @@ -1165,8 +1212,7 @@ static void clean_retrieve_context(stcxt_t *cxt) sv_free((SV *) hseen); /* optional HV, for backward compat. */ } - cxt->entry = 0; - cxt->s_dirty = 0; + reset_context(cxt); } /* @@ -1174,19 +1220,26 @@ static void clean_retrieve_context(stcxt_t *cxt) * * A workaround for the CROAK bug: cleanup the last context. */ -static void clean_context(cxt) -stcxt_t *cxt; +static void clean_context(stcxt_t *cxt) { TRACEME(("clean_context")); ASSERT(cxt->s_dirty, ("dirty context")); + if (cxt->membuf_ro) + MBUF_RESTORE(); + + ASSERT(!cxt->membuf_ro, ("mbase is not read-only")); + if (cxt->optype & ST_RETRIEVE) clean_retrieve_context(cxt); - else + else if (cxt->optype & ST_STORE) clean_store_context(cxt); + else + reset_context(cxt); ASSERT(!cxt->s_dirty, ("context is clean")); + ASSERT(cxt->entry == 0, ("context is reset")); } /* @@ -1208,6 +1261,11 @@ stcxt_t *parent_cxt; cxt->prev = parent_cxt; SET_STCXT(cxt); + TRACEME(("kbuf has %d bytes at 0x%x", ksiz, kbuf)); + TRACEME(("mbuf has %d bytes at 0x%x", msiz, mbase)); + + ASSERT(!cxt->s_dirty, ("clean context")); + return cxt; } @@ -1234,6 +1292,8 @@ stcxt_t *cxt; Safefree(cxt); SET_STCXT(prev); + + ASSERT(cxt, ("context not void")); } /*** @@ -1768,7 +1828,7 @@ static int store_array(stcxt_t *cxt, AV *av) continue; } TRACEME(("(#%d) item", i)); - if ((ret = store(cxt, *sav))) + if ((ret = store(cxt, *sav))) /* Extra () for -Wall, grr... */ return ret; } @@ -1876,7 +1936,7 @@ static int store_hash(stcxt_t *cxt, HV *hv) TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val))); - if ((ret = store(cxt, val))) + if ((ret = store(cxt, val))) /* Extra () for -Wall, grr... */ goto out; /* @@ -1922,7 +1982,7 @@ static int store_hash(stcxt_t *cxt, HV *hv) TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val))); - if ((ret = store(cxt, val))) + if ((ret = store(cxt, val))) /* Extra () for -Wall, grr... */ goto out; /* @@ -2005,7 +2065,7 @@ static int store_tied(stcxt_t *cxt, SV *sv) * accesses on the retrieved object will indeed call the magic methods... */ - if ((ret = store(cxt, mg->mg_obj))) + if ((ret = store(cxt, mg->mg_obj))) /* Extra () for -Wall, grr... */ return ret; TRACEME(("ok (tied)")); @@ -2044,12 +2104,12 @@ static int store_tied_item(stcxt_t *cxt, SV *sv) PUTMARK(SX_TIED_KEY); TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj))); - if ((ret = store(cxt, mg->mg_obj))) + if ((ret = store(cxt, mg->mg_obj))) /* Extra () for -Wall, grr... */ return ret; TRACEME(("store_tied_item: storing PTR 0x%"UVxf, PTR2UV(mg->mg_ptr))); - if ((ret = store(cxt, (SV *) mg->mg_ptr))) + if ((ret = store(cxt, (SV *) mg->mg_ptr))) /* Idem, for -Wall */ return ret; } else { I32 idx = mg->mg_len; @@ -2058,7 +2118,7 @@ static int store_tied_item(stcxt_t *cxt, SV *sv) PUTMARK(SX_TIED_IDX); TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj))); - if ((ret = store(cxt, mg->mg_obj))) + if ((ret = store(cxt, mg->mg_obj))) /* Idem, for -Wall */ return ret; TRACEME(("store_tied_item: storing IDX %d", idx)); @@ -2138,8 +2198,8 @@ static int store_hook( I32 classnum; int ret; int clone = cxt->optype & ST_CLONE; - char mtype = 0; /* for blessed ref to tied structures */ - unsigned char eflags = 0; /* used when object type is SHT_EXTRA */ + char mtype = '\0'; /* for blessed ref to tied structures */ + unsigned char eflags = '\0'; /* used when object type is SHT_EXTRA */ TRACEME(("store_hook, class \"%s\", tagged #%d", HvNAME(pkg), cxt->tagnum)); @@ -2305,7 +2365,7 @@ static int store_hook( } else PUTMARK(flags); - if ((ret = store(cxt, xsv))) /* Given by hook for us to store */ + if ((ret = store(cxt, xsv))) /* Given by hook for us to store */ return ret; svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE); @@ -2482,7 +2542,7 @@ static int store_hook( * [] */ - if ((ret = store(cxt, mg->mg_obj))) + if ((ret = store(cxt, mg->mg_obj))) /* Extra () for -Wall, grr... */ return ret; } @@ -2620,7 +2680,7 @@ static int store_other(stcxt_t *cxt, SV *sv) */ (void) sprintf(buf, "You lost %s(0x%"UVxf")%c", sv_reftype(sv, FALSE), - PTR2UV(sv), (char)0); + PTR2UV(sv), (char) 0); len = strlen(buf); STORE_SCALAR(buf, len); @@ -3001,7 +3061,6 @@ static SV *mbuf2sv(void) */ SV *mstore(SV *sv) { - dSTCXT; SV *out; TRACEME(("mstore")); @@ -3020,7 +3079,6 @@ SV *mstore(SV *sv) */ SV *net_mstore(SV *sv) { - dSTCXT; SV *out; TRACEME(("net_mstore")); @@ -3086,8 +3144,7 @@ static SV *retrieve_idx_blessed(stcxt_t *cxt, char *cname) sva = av_fetch(cxt->aclass, idx, FALSE); if (!sva) - CROAK(("Class name #%"IVdf" should have been seen already", - (IV)idx)); + CROAK(("Class name #%"IVdf" should have been seen already", (IV) idx)); class = SvPVX(*sva); /* We know it's a PV, by construction */ @@ -3281,8 +3338,8 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname) sva = av_fetch(cxt->aclass, idx, FALSE); if (!sva) - CROAK(("Class name #%"IVdf" should have been seen already", - (IV)idx)); + CROAK(("Class name #%"IVdf" should have been seen already", + (IV) idx)); class = SvPVX(*sva); /* We know it's a PV, by construction */ TRACEME(("class ID %d => %s", idx, class)); @@ -3383,7 +3440,8 @@ static SV *retrieve_hook(stcxt_t *cxt, char *cname) tag = ntohl(tag); svh = av_fetch(cxt->aseen, tag, FALSE); if (!svh) - CROAK(("Object #%"IVdf" should have been retrieved already", (IV)tag)); + CROAK(("Object #%"IVdf" should have been retrieved already", + (IV) tag)); xsv = *svh; ary[i] = SvREFCNT_inc(xsv); } @@ -4007,16 +4065,14 @@ static SV *retrieve_byte(stcxt_t *cxt, char *cname) { SV *sv; int siv; - signed char tmp; /* must use temp var to work around - an AIX compiler bug --H.Merijn Brand */ + signed char tmp; /* Workaround for AIX cc bug --H.Merijn Brand */ TRACEME(("retrieve_byte (#%d)", cxt->tagnum)); GETMARK(siv); TRACEME(("small integer read as %d", (unsigned char) siv)); - tmp = ((unsigned char)siv) - 128; - sv = newSViv (tmp); - + tmp = (unsigned char) siv - 128; + sv = newSViv(tmp); SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */ TRACEME(("byte %d", tmp)); @@ -4285,7 +4341,7 @@ static SV *old_retrieve_hash(stcxt_t *cxt, char *cname) I32 size; I32 i; HV *hv; - SV *sv=NULL; + SV *sv = (SV *) 0; int c; static SV *sv_h_undef = (SV *) 0; /* hv_store() bug */ @@ -4461,7 +4517,7 @@ magic_ok: * information to check. */ - if ((cxt->netorder = (use_network_order & 0x1))) + if ((cxt->netorder = (use_network_order & 0x1))) /* Extra () for -Wall */ return &PL_sv_undef; /* No byte ordering info */ sprintf(byteorder, "%lx", (unsigned long) BYTEORDER); @@ -4532,7 +4588,8 @@ static SV *retrieve(stcxt_t *cxt, char *cname) I32 tagn; svh = hv_fetch(cxt->hseen, (char *) &tag, sizeof(tag), FALSE); if (!svh) - CROAK(("Old tag 0x%"UVxf" should have been mapped already", (UV)tag)); + CROAK(("Old tag 0x%"UVxf" should have been mapped already", + (UV) tag)); tagn = SvIV(*svh); /* Mapped tag number computed earlier below */ /* @@ -4541,7 +4598,8 @@ static SV *retrieve(stcxt_t *cxt, char *cname) svh = av_fetch(cxt->aseen, tagn, FALSE); if (!svh) - CROAK(("Object #%"IVdf" should have been retrieved already", (IV)tagn)); + CROAK(("Object #%"IVdf" should have been retrieved already", + (IV) tagn)); sv = *svh; TRACEME(("has retrieved #%d at 0x%"UVxf, tagn, PTR2UV(sv))); SvREFCNT_inc(sv); /* One more reference to this same sv */ @@ -4567,7 +4625,6 @@ static SV *retrieve(stcxt_t *cxt, char *cname) * Regular post-0.6 binary format. */ -again: GETMARK(type); TRACEME(("retrieve type = %d", type)); @@ -4582,8 +4639,8 @@ again: tag = ntohl(tag); svh = av_fetch(cxt->aseen, tag, FALSE); if (!svh) - CROAK(("Object #%"IVdf" should have been retrieved already", - (IV)tag)); + CROAK(("Object #%"IVdf" should have been retrieved already", + (IV) tag)); sv = *svh; TRACEME(("had retrieved #%d at 0x%"UVxf, tag, PTR2UV(sv))); SvREFCNT_inc(sv); /* One more reference to this same sv */ @@ -4654,7 +4711,7 @@ static SV *do_retrieve( dSTCXT; SV *sv; int is_tainted; /* Is input source tainted? */ - struct extendable msave; /* Where potentially valid mbuf is saved */ + int pre_06_fmt = 0; /* True with pre Storable 0.6 formats */ TRACEME(("do_retrieve (optype = 0x%x)", optype)); @@ -4702,11 +4759,8 @@ static SV *do_retrieve( KBUFINIT(); /* Allocate hash key reading pool once */ - if (!f && in) { - StructCopy(&cxt->membuf, &msave, struct extendable); - MBUF_LOAD(in); - } - + if (!f && in) + MBUF_SAVE_AND_LOAD(in); /* * Magic number verifications. @@ -4748,7 +4802,9 @@ static SV *do_retrieve( */ if (!f && in) - StructCopy(&msave, &cxt->membuf, struct extendable); + MBUF_RESTORE(); + + pre_06_fmt = cxt->hseen != NULL; /* Before we clean context */ /* * The "root" context is never freed. @@ -4777,15 +4833,15 @@ static SV *do_retrieve( * * Build a reference to the SV returned by pretrieve even if it is * already one and not a scalar, for consistency reasons. - * - * NB: although context might have been cleaned, the value of `cxt->hseen' - * remains intact, and can be used as a flag. */ - if (cxt->hseen) { /* Was not handling overloading by then */ + if (pre_06_fmt) { /* Was not handling overloading by then */ SV *rv; - if (sv_type(sv) == svis_REF && (rv = SvRV(sv)) && SvOBJECT(rv)) + TRACEME(("fixing for old formats -- pre 0.6")); + if (sv_type(sv) == svis_REF && (rv = SvRV(sv)) && SvOBJECT(rv)) { + TRACEME(("ended do_retrieve() with an object -- pre 0.6")); return sv; + } } /* @@ -4806,15 +4862,18 @@ static SV *do_retrieve( */ if (SvOBJECT(sv)) { - HV *stash = (HV *) SvSTASH (sv); + HV *stash = (HV *) SvSTASH(sv); SV *rv = newRV_noinc(sv); if (stash && Gv_AMG(stash)) { SvAMAGIC_on(rv); TRACEME(("restored overloading on root reference")); } + TRACEME(("ended do_retrieve() with an object")); return rv; } + TRACEME(("regular do_retrieve() end")); + return newRV_noinc(sv); } diff --git a/ext/Storable/t/freeze.t b/ext/Storable/t/freeze.t index 37631ed..9f64487 100644 --- a/ext/Storable/t/freeze.t +++ b/ext/Storable/t/freeze.t @@ -1,6 +1,6 @@ #!./perl -# $Id: freeze.t,v 1.0 2000/09/01 19:40:41 ram Exp $ +# $Id: freeze.t,v 1.0.1.1 2001/07/01 11:25:16 ram Exp $ # # Copyright (c) 1995-2000, Raphael Manfredi # @@ -8,6 +8,9 @@ # in the README file that comes with the distribution. # # $Log: freeze.t,v $ +# Revision 1.0.1.1 2001/07/01 11:25:16 ram +# patch12: added test cases for mem corruption during thaw() +# # Revision 1.0 2000/09/01 19:40:41 ram # Baseline for first official release. # @@ -22,12 +25,12 @@ sub BEGIN { exit 0; } require 'lib/st-dump.pl'; + sub ok; } - use Storable qw(freeze nfreeze thaw); -print "1..15\n"; +print "1..19\n"; $a = 'toto'; $b = \$a; @@ -117,3 +120,26 @@ eval { freeze($foo) }; print "not " if $@; print "ok 15\n"; +# Test cleanup bug found by Claudio Garcia -- RAM, 08/06/2001 +my $thaw_me = 'asdasdasdasd'; + +eval { + my $thawed = thaw $thaw_me; +}; +ok 16, $@; + +my %to_be_frozen = (foo => 'bar'); +my $frozen; +eval { + $frozen = freeze \%to_be_frozen; +}; +ok 17, !$@; + +freeze {}; +eval { thaw $thaw_me }; +eval { $frozen = freeze { foo => {} } }; +ok 18, !$@; + +thaw $frozen; # used to segfault here +ok 19, 1; +