From 21ca1aa78dfe7569a97d588860239ebdc39c4bfe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Thu, 11 May 2017 12:41:12 +0200 Subject: [PATCH] Upgrade to 2.62 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Unbundled from perl-5.25.12. Signed-off-by: Petr Písař --- Storable.pm | 18 ++-- Storable.xs | 312 +++++++++++++++++++++++++++++++++------------------------ t/code.t | 4 +- t/compat01.t | 2 +- t/dclone.t | 2 +- t/destroy.t | 2 +- t/file_magic.t | 2 +- t/forgive.t | 2 +- t/recurse.t | 2 +- t/store.t | 28 +++++- t/testlib.pl | 6 +- 11 files changed, 231 insertions(+), 149 deletions(-) diff --git a/Storable.pm b/Storable.pm index c8f6db1..d8fd740 100644 --- a/Storable.pm +++ b/Storable.pm @@ -22,10 +22,16 @@ package Storable; @ISA = qw(Exporter); use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.56'; +$VERSION = '2.62'; BEGIN { - if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) { + if (eval { + local $SIG{__DIE__}; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + require Log::Agent; + 1; + }) { Log::Agent->import; } # @@ -113,7 +119,7 @@ sub file_magic { my $file = shift; my $fh = IO::File->new; - open($fh, "<". $file) || die "Can't open '$file': $!"; + open($fh, "<", $file) || die "Can't open '$file': $!"; binmode($fh); defined(sysread($fh, my $buf, 32)) || die "Can't read from '$file': $!"; close($fh); @@ -239,7 +245,7 @@ sub _store { logcroak "wrong argument number" unless @_ == 2; # No @foo in arglist local *FILE; if ($use_locking) { - open(FILE, ">>$file") || logcroak "can't write into $file: $!"; + open(FILE, '>>', $file) || logcroak "can't write into $file: $!"; unless (&CAN_FLOCK) { logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O"; @@ -250,7 +256,7 @@ sub _store { truncate FILE, 0; # Unlocking will happen when FILE is closed } else { - open(FILE, ">$file") || logcroak "can't create $file: $!"; + open(FILE, '>', $file) || logcroak "can't create $file: $!"; } binmode FILE; # Archaic systems... my $da = $@; # Don't mess if called from exception handler @@ -367,7 +373,7 @@ sub lock_retrieve { sub _retrieve { my ($file, $use_locking) = @_; local *FILE; - open(FILE, $file) || logcroak "can't open $file: $!"; + open(FILE, '<', $file) || logcroak "can't open $file: $!"; binmode FILE; # Archaic systems... my $self; my $da = $@; # Could be from exception handler diff --git a/Storable.xs b/Storable.xs index 707f530..9ba48be 100644 --- a/Storable.xs +++ b/Storable.xs @@ -417,6 +417,7 @@ static MAGIC *THX_sv_magicext(pTHX_ SV *sv, SV *obj, int type, #define INIT_STCXT \ dSTCXT; \ NEW_STORABLE_CXT_OBJ(cxt); \ + assert(perinterp_sv); \ sv_setiv(perinterp_sv, PTR2IV(cxt->my_sv)) #define SET_STCXT(x) \ @@ -1038,24 +1039,38 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0}; * i should be true iff sv is immortal (ie PL_sv_yes, PL_sv_no or PL_sv_undef) * * SEEN0() is a short-cut where stash is always NULL. + * + * The _NN variants dont check for y being null */ -#define SEEN0(y,i) \ +#define SEEN0_NN(y,i) \ STMT_START { \ - if (!y) \ - return (SV *) 0; \ if (av_store(cxt->aseen, cxt->tagnum++, i ? (SV*)(y) : SvREFCNT_inc(y)) == 0) \ return (SV *) 0; \ - TRACEME(("aseen(#%d) = 0x%"UVxf" (refcnt=%d)", cxt->tagnum-1, \ + TRACEME(("aseen(#%d) = 0x%" UVxf " (refcnt=%d)", cxt->tagnum-1, \ PTR2UV(y), SvREFCNT(y)-1)); \ } STMT_END -#define SEEN(y,stash,i) \ +#define SEEN0(y,i) \ STMT_START { \ - SEEN0(y,i); \ + if (!y) \ + return (SV *) 0; \ + SEEN0_NN(y,i) \ + } STMT_END + +#define SEEN_NN(y,stash,i) \ + STMT_START { \ + SEEN0_NN(y,i); \ if (stash) \ BLESS((SV *) (y), (HV *)(stash)); \ } STMT_END +#define SEEN(y,stash,i) \ + STMT_START { \ + if (!y) \ + return (SV *) 0; \ + SEEN_NN(y,stash, i); \ + } STMT_END + /* * Bless 's' in 'p', via a temporary reference, required by sv_bless(). * "A" magic is added before the sv_bless for overloaded classes, this avoids @@ -1064,7 +1079,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0}; #define BLESS(s,stash) \ STMT_START { \ SV *ref; \ - TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (HvNAME_get(stash)))); \ + TRACEME(("blessing 0x%" UVxf " in %s", PTR2UV(s), (HvNAME_get(stash))));\ ref = newRV_noinc(s); \ if (cxt->in_retrieve_overloaded && Gv_AMG(stash)) \ { \ @@ -1703,6 +1718,7 @@ static int last_op_in_netorder(pTHX) { dSTCXT; + assert(cxt); return cxt->netorder; } @@ -1737,7 +1753,7 @@ static SV *pkg_fetchmeth( gv = gv_fetchmethod_autoload(pkg, method, FALSE); if (gv && isGV(gv)) { sv = newRV((SV*) GvCV(gv)); - TRACEME(("%s->%s: 0x%"UVxf, hvname, method, PTR2UV(sv))); + TRACEME(("%s->%s: 0x%" UVxf, hvname, method, PTR2UV(sv))); } else { sv = newSVsv(&PL_sv_undef); TRACEME(("%s->%s: not found", hvname, method)); @@ -1821,7 +1837,7 @@ static SV *pkg_can( TRACEME(("cached %s->%s: not found", hvname, method)); return (SV *) 0; } else { - TRACEME(("cached %s->%s: 0x%"UVxf, + TRACEME(("cached %s->%s: 0x%" UVxf, hvname, method, PTR2UV(sv))); return sv; } @@ -1863,7 +1879,7 @@ static SV *scalar_call( int i; XPUSHs(ary[0]); /* Frozen string */ for (i = 1; i < cnt; i++) { - TRACEME(("pushing arg #%d (0x%"UVxf")...", + TRACEME(("pushing arg #%d (0x%" UVxf ")...", i, PTR2UV(ary[i]))); XPUSHs(sv_2mortal(newRV(ary[i]))); } @@ -1988,7 +2004,7 @@ static int known_class( static int store_ref(pTHX_ stcxt_t *cxt, SV *sv) { int is_weak = 0; - TRACEME(("store_ref (0x%"UVxf")", PTR2UV(sv))); + TRACEME(("store_ref (0x%" UVxf ")", PTR2UV(sv))); /* * Follow reference, and check if target is overloaded. @@ -1997,14 +2013,16 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv) #ifdef SvWEAKREF if (SvWEAKREF(sv)) is_weak = 1; - TRACEME(("ref (0x%"UVxf") is%s weak", PTR2UV(sv), is_weak ? "" : "n't")); + TRACEME(("ref (0x%" UVxf ") is%s weak", PTR2UV(sv), is_weak + ? "" + : "n't")); #endif sv = SvRV(sv); if (SvOBJECT(sv)) { HV *stash = (HV *) SvSTASH(sv); if (stash && Gv_AMG(stash)) { - TRACEME(("ref (0x%"UVxf") is overloaded", PTR2UV(sv))); + TRACEME(("ref (0x%" UVxf ") is overloaded", PTR2UV(sv))); PUTMARK(is_weak ? SX_WEAKOVERLOAD : SX_OVERLOAD); } else PUTMARK(is_weak ? SX_WEAKREF : SX_REF); @@ -2037,7 +2055,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv) STRLEN len; U32 flags = SvFLAGS(sv); /* "cc -O" may put it in register */ - TRACEME(("store_scalar (0x%"UVxf")", PTR2UV(sv))); + TRACEME(("store_scalar (0x%" UVxf ")", PTR2UV(sv))); /* * For efficiency, break the SV encapsulation by peaking at the flags @@ -2050,7 +2068,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv) TRACEME(("immortal undef")); PUTMARK(SX_SV_UNDEF); } else { - TRACEME(("undef at 0x%"UVxf, PTR2UV(sv))); + TRACEME(("undef at 0x%" UVxf, PTR2UV(sv))); PUTMARK(SX_UNDEF); } return 0; @@ -2125,7 +2143,8 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv) * case. */ if ((flags & SVf_IVisUV) && SvUV(sv) > IV_MAX) { - TRACEME(("large unsigned integer as string, value = %"UVuf, SvUV(sv))); + TRACEME(("large unsigned integer as string, value = %" UVuf, + SvUV(sv))); goto string_readlen; } #endif @@ -2155,7 +2174,8 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv) #endif (iv > (IV)0x7FFFFFFF) || (iv < -(IV)0x80000000)) { /* Bigger than 32 bits. */ - TRACEME(("large network order integer as string, value = %"IVdf, iv)); + TRACEME(("large network order integer as string, value = %" + IVdf, iv)); goto string_readlen; } #endif @@ -2170,7 +2190,8 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv) WRITE(&iv, sizeof(iv)); } - TRACEME(("ok (integer 0x%"UVxf", value = %"IVdf")", PTR2UV(sv), iv)); + TRACEME(("ok (integer 0x%" UVxf ", value = %" IVdf ")", + PTR2UV(sv), iv)); } else if (flags & SVf_NOK) { NV nv; #if (PATCHLEVEL <= 6) @@ -2179,7 +2200,7 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv) * Watch for number being an integer in disguise. */ if (nv == (NV) (iv = I_V(nv))) { - TRACEME(("double %"NVff" is actually integer %"IVdf, nv, iv)); + TRACEME(("double %" NVff " is actually integer %" IVdf, nv, iv)); goto integer; /* Share code above */ } #else @@ -2193,14 +2214,15 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv) #endif if (cxt->netorder) { - TRACEME(("double %"NVff" stored as string", nv)); + TRACEME(("double %" NVff " stored as string", nv)); goto string_readlen; /* Share code below */ } PUTMARK(SX_DOUBLE); WRITE(&nv, sizeof(nv)); - TRACEME(("ok (double 0x%"UVxf", value = %"NVff")", PTR2UV(sv), nv)); + TRACEME(("ok (double 0x%" UVxf ", value = %" NVff ")", + PTR2UV(sv), nv)); } else if (flags & (SVp_POK | SVp_NOK | SVp_IOK)) { #ifdef SvVOK @@ -2232,10 +2254,10 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv) STORE_UTF8STR(pv, wlen); else STORE_SCALAR(pv, wlen); - TRACEME(("ok (scalar 0x%"UVxf" '%s', length = %"IVdf")", + TRACEME(("ok (scalar 0x%" UVxf " '%s', length = %" IVdf ")", PTR2UV(sv), SvPVX(sv), (IV)len)); } else - CROAK(("Can't determine type of %s(0x%"UVxf")", + CROAK(("Can't determine type of %s(0x%" UVxf ")", sv_reftype(sv, FALSE), PTR2UV(sv))); return 0; /* Ok, no recursion on scalars */ @@ -2256,7 +2278,7 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av) I32 i; int ret; - TRACEME(("store_array (0x%"UVxf")", PTR2UV(av))); + TRACEME(("store_array (0x%" UVxf ")", PTR2UV(av))); /* * Signal array by emitting SX_ARRAY, followed by the array length. @@ -2359,10 +2381,10 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv) if (flagged_hash) { /* needs int cast for C++ compilers, doesn't it? */ - TRACEME(("store_hash (0x%"UVxf") (flags %x)", PTR2UV(hv), + TRACEME(("store_hash (0x%" UVxf ") (flags %x)", PTR2UV(hv), (int) hash_flags)); } else { - TRACEME(("store_hash (0x%"UVxf")", PTR2UV(hv))); + TRACEME(("store_hash (0x%" UVxf ")", PTR2UV(hv))); } /* @@ -2475,7 +2497,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv) * Store value first. */ - TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val))); + TRACEME(("(#%d) value 0x%" UVxf, i, PTR2UV(val))); if ((ret = store(aTHX_ cxt, val))) /* Extra () for -Wall, grr... */ goto out; @@ -2595,7 +2617,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv) * Store value first. */ - TRACEME(("(#%d) value 0x%"UVxf, i, PTR2UV(val))); + TRACEME(("(#%d) value 0x%" UVxf, i, PTR2UV(val))); if ((ret = store(aTHX_ cxt, val))) /* Extra () for -Wall, grr... */ goto out; @@ -2644,7 +2666,9 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv) TRACEME(("(#%d) key '%s'", i, key)); } if (flags & SHV_K_ISSV) { - store(aTHX_ cxt, key_sv); + int ret; + if ((ret = store(aTHX_ cxt, key_sv))) + goto out; } else { WLEN(len); if (len) @@ -2653,7 +2677,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv) } } - TRACEME(("ok (hash 0x%"UVxf")", PTR2UV(hv))); + TRACEME(("ok (hash 0x%" UVxf ")", PTR2UV(hv))); out: HvRITER_set(hv, riter); /* Restore hash iterator state */ @@ -2683,7 +2707,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv) int count, reallen; SV *text, *bdeparse; - TRACEME(("store_code (0x%"UVxf")", PTR2UV(cv))); + TRACEME(("store_code (0x%" UVxf ")", PTR2UV(cv))); if ( cxt->deparse == 0 || @@ -2786,7 +2810,7 @@ static int store_tied(pTHX_ stcxt_t *cxt, SV *sv) int svt = SvTYPE(sv); char mtype = 'P'; - TRACEME(("store_tied (0x%"UVxf")", PTR2UV(sv))); + TRACEME(("store_tied (0x%" UVxf ")", PTR2UV(sv))); /* * We have a small run-time penalty here because we chose to factorise @@ -2854,7 +2878,7 @@ static int store_tied_item(pTHX_ stcxt_t *cxt, SV *sv) MAGIC *mg; int ret; - TRACEME(("store_tied_item (0x%"UVxf")", PTR2UV(sv))); + TRACEME(("store_tied_item (0x%" UVxf ")", PTR2UV(sv))); if (!(mg = mg_find(sv, 'p'))) CROAK(("No magic 'p' found while storing reference to tied item")); @@ -2866,12 +2890,14 @@ static int store_tied_item(pTHX_ stcxt_t *cxt, SV *sv) if (mg->mg_ptr) { TRACEME(("store_tied_item: storing a ref to a tied hash item")); PUTMARK(SX_TIED_KEY); - TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj))); + TRACEME(("store_tied_item: storing OBJ 0x%" UVxf, + PTR2UV(mg->mg_obj))); if ((ret = store(aTHX_ cxt, mg->mg_obj))) /* Extra () for -Wall, grr... */ return ret; - TRACEME(("store_tied_item: storing PTR 0x%"UVxf, PTR2UV(mg->mg_ptr))); + TRACEME(("store_tied_item: storing PTR 0x%" UVxf, + PTR2UV(mg->mg_ptr))); if ((ret = store(aTHX_ cxt, (SV *) mg->mg_ptr))) /* Idem, for -Wall */ return ret; @@ -2880,7 +2906,8 @@ static int store_tied_item(pTHX_ stcxt_t *cxt, SV *sv) TRACEME(("store_tied_item: storing a ref to a tied array item ")); PUTMARK(SX_TIED_IDX); - TRACEME(("store_tied_item: storing OBJ 0x%"UVxf, PTR2UV(mg->mg_obj))); + TRACEME(("store_tied_item: storing OBJ 0x%" UVxf, + PTR2UV(mg->mg_obj))); if ((ret = store(aTHX_ cxt, mg->mg_obj))) /* Idem, for -Wall */ return ret; @@ -3136,7 +3163,8 @@ static int store_hook( goto sv_seen; /* Avoid moving code too far to the right */ #endif - TRACEME(("listed object %d at 0x%"UVxf" is unknown", i-1, PTR2UV(xsv))); + TRACEME(("listed object %d at 0x%" UVxf " is unknown", + i-1, PTR2UV(xsv))); /* * We need to recurse to store that object and get it to be known @@ -3205,7 +3233,7 @@ static int store_hook( tag = *svh; #endif ary[i] = tag; - TRACEME(("listed object %d at 0x%"UVxf" is tag #%"UVuf, + TRACEME(("listed object %d at 0x%" UVxf " is tag #%" UVuf, i-1, PTR2UV(xsv), PTR2UV(tag))); } @@ -3252,7 +3280,7 @@ check_done: */ TRACEME(("SX_HOOK (recursed=%d) flags=0x%x " - "class=%"IVdf" len=%"IVdf" len2=%"IVdf" len3=%d", + "class=%" IVdf " len=%" IVdf " len2=%" IVdf " len3=%d", recursed, flags, (IV)classnum, (IV)len, (IV)len2, count-1)); /* SX_HOOK [] */ @@ -3339,8 +3367,8 @@ check_done: (svt == SVt_PVAV) ? "array" : "scalar")); } - TRACEME(("handling the magic object 0x%"UVxf" part of 0x%"UVxf, - PTR2UV(mg->mg_obj), PTR2UV(sv))); + TRACEME(("handling the magic object 0x%" UVxf " part of 0x%" + UVxf, PTR2UV(mg->mg_obj), PTR2UV(sv))); /* * [] @@ -3407,7 +3435,7 @@ static int store_blessed( classname = HvNAME_get(pkg); len = strlen(classname); - TRACEME(("blessed 0x%"UVxf" in %s, no hook: tagged #%d", + TRACEME(("blessed 0x%" UVxf " in %s, no hook: tagged #%d", PTR2UV(sv), classname, cxt->tagnum)); /* @@ -3477,19 +3505,19 @@ static int store_other(pTHX_ stcxt_t *cxt, SV *sv) ) CROAK(("Can't store %s items", sv_reftype(sv, FALSE))); - warn("Can't store item %s(0x%"UVxf")", + warn("Can't store item %s(0x%" UVxf ")", sv_reftype(sv, FALSE), PTR2UV(sv)); /* * Store placeholder string as a scalar instead... */ - (void) sprintf(buf, "You lost %s(0x%"UVxf")%c", sv_reftype(sv, FALSE), + (void) sprintf(buf, "You lost %s(0x%" UVxf ")%c", sv_reftype(sv, FALSE), PTR2UV(sv), (char) 0); len = strlen(buf); STORE_SCALAR(buf, len); - TRACEME(("ok (dummy \"%s\", length = %"IVdf")", buf, (IV) len)); + TRACEME(("ok (dummy \"%s\", length = %" IVdf ")", buf, (IV) len)); return 0; } @@ -3592,7 +3620,7 @@ static int store(pTHX_ stcxt_t *cxt, SV *sv) HV *hseen = cxt->hseen; #endif - TRACEME(("store (0x%"UVxf")", PTR2UV(sv))); + TRACEME(("store (0x%" UVxf ")", PTR2UV(sv))); /* * If object has already been stored, do not duplicate data. @@ -3650,7 +3678,8 @@ static int store(pTHX_ stcxt_t *cxt, SV *sv) tagval = htonl(LOW_32BITS(*svh)); #endif - TRACEME(("object 0x%"UVxf" seen as #%d", PTR2UV(sv), ntohl(tagval))); + TRACEME(("object 0x%" UVxf " seen as #%d", + PTR2UV(sv), ntohl(tagval))); PUTMARK(SX_OBJECT); WRITE_I32(tagval); @@ -3685,7 +3714,7 @@ static int store(pTHX_ stcxt_t *cxt, SV *sv) type = sv_type(aTHX_ sv); undef_special_case: - TRACEME(("storing 0x%"UVxf" tag #%d, type %d...", + TRACEME(("storing 0x%" UVxf " tag #%d, type %d...", PTR2UV(sv), cxt->tagnum, type)); if (SvOBJECT(sv)) { @@ -3694,7 +3723,7 @@ undef_special_case: } else ret = SV_STORE(type)(aTHX_ cxt, sv); - TRACEME(("%s (stored 0x%"UVxf", refcnt=%d, %s)", + TRACEME(("%s (stored 0x%" UVxf ", refcnt=%d, %s)", ret ? "FAILED" : "ok", PTR2UV(sv), SvREFCNT(sv), sv_reftype(sv, FALSE))); @@ -3707,7 +3736,7 @@ undef_special_case: * Write magic number and system information into the file. * Layout is [ * ] where is the length of the byteorder hexa string. - * All size and lenghts are written as single characters here. + * All size and lengths are written as single characters here. * * Note that no byte ordering info is emitted when is true, since * integers will be emitted in network order in that case. @@ -3832,6 +3861,7 @@ static int do_store( * free up memory for them now. */ + assert(cxt); if (cxt->s_dirty) clean_context(aTHX_ cxt); @@ -3933,6 +3963,7 @@ static SV *mbuf2sv(pTHX) { dSTCXT; + assert(cxt); return newSVpv(mbase, MBUF_SIZE()); } @@ -3993,7 +4024,8 @@ static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const 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)); classname = SvPVX(*sva); /* We know it's a PV, by construction */ @@ -4016,7 +4048,7 @@ static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const char *cname) */ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname) { - I32 len; + U32 len; SV *sv; char buf[LG_BLESS + 1]; /* Avoid malloc() if possible */ char *classname = buf; @@ -4037,6 +4069,9 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname) if (len & 0x80) { RLEN(len); TRACEME(("** allocating %d bytes for class name", len+1)); + if (len > I32_MAX) { + CROAK(("Corrupted classname length")); + } New(10003, classname, len+1, char); malloced_classname = classname; } @@ -4087,7 +4122,7 @@ static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname) */ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) { - I32 len; + U32 len; char buf[LG_BLESS + 1]; /* Avoid malloc() if possible */ char *classname = buf; unsigned int flags; @@ -4160,7 +4195,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) default: return retrieve_other(aTHX_ cxt, 0); /* Let it croak */ } - SEEN0(sv, 0); /* Don't bless yet */ + SEEN0_NN(sv, 0); /* Don't bless yet */ /* * Whilst flags tell us to recurse, do so. @@ -4180,7 +4215,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) if (!rv) return (SV *) 0; SvREFCNT_dec(rv); - TRACEME(("retrieve_hook back with rv=0x%"UVxf, + TRACEME(("retrieve_hook back with rv=0x%" UVxf, PTR2UV(rv))); GETMARK(flags); } @@ -4200,8 +4235,8 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const 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)); classname = SvPVX(*sva); /* We know it's a PV, by construction */ TRACEME(("class ID %d => %s", idx, classname)); @@ -4221,6 +4256,10 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) else GETMARK(len); + if (len > I32_MAX) { + CROAK(("Corrupted classname length")); + } + if (len > LG_BLESS) { TRACEME(("** allocating %d bytes for class name", len+1)); New(10003, classname, len+1, char); @@ -4242,6 +4281,11 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("class name: %s", classname)); + if (!(flags & SHF_IDX_CLASSNAME) && classname != buf) { + /* some execution paths can throw an exception */ + SAVEFREEPV(classname); + } + /* * Decode user-frozen string length and read it in an SV. * @@ -4312,8 +4356,9 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) xsv = &PL_sv_undef; svh = &xsv; } else { - CROAK(("Object #%"IVdf" should have been retrieved already", - (IV) tag)); + CROAK(("Object #%" IVdf + " should have been retrieved already", + (IV) tag)); } } xsv = *svh; @@ -4357,11 +4402,9 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) SvREFCNT_dec(sv); /* we need to free RV but preserve value that RV point to */ sv = SvRV(attached); - SEEN0(sv, 0); + SEEN0_NN(sv, 0); SvRV_set(attached, NULL); SvREFCNT_dec(attached); - if (!(flags & SHF_IDX_CLASSNAME) && classname != buf) - Safefree(classname); return sv; } CROAK(("STORABLE_attach did not return a %s object", classname)); @@ -4428,7 +4471,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) * the object itself being already created by the runtime. */ - TRACEME(("calling STORABLE_thaw on %s at 0x%"UVxf" (%"IVdf" args)", + TRACEME(("calling STORABLE_thaw on %s at 0x%" UVxf " (%" IVdf " args)", classname, PTR2UV(sv), (IV) AvFILLp(av) + 1)); rv = newRV(sv); @@ -4442,8 +4485,6 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) SvREFCNT_dec(frozen); av_undef(av); sv_free((SV *) av); - if (!(flags & SHF_IDX_CLASSNAME) && classname != buf) - Safefree(classname); /* * If we had an type, then the object was not as simple, and @@ -4453,11 +4494,11 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) if (!extra_type) return sv; - TRACEME(("retrieving magic object for 0x%"UVxf"...", PTR2UV(sv))); + TRACEME(("retrieving magic object for 0x%" UVxf "...", PTR2UV(sv))); rv = retrieve(aTHX_ cxt, 0); /* Retrieve */ - TRACEME(("restoring the magic object 0x%"UVxf" part of 0x%"UVxf, + TRACEME(("restoring the magic object 0x%" UVxf " part of 0x%" UVxf, PTR2UV(rv), PTR2UV(sv))); switch (extra_type) { @@ -4532,7 +4573,7 @@ static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname) stash = gv_stashpv(cname, GV_ADD); else stash = 0; - SEEN(rv, stash, 0); /* Will return if rv is null */ + SEEN_NN(rv, stash, 0); /* Will return if rv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve */ if (!sv) return (SV *) 0; /* Failed */ @@ -4564,7 +4605,7 @@ static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname) SvRV_set(rv, sv); /* $rv = \$sv */ SvROK_on(rv); - TRACEME(("ok (retrieve_ref at 0x%"UVxf")", PTR2UV(rv))); + TRACEME(("ok (retrieve_ref at 0x%" UVxf ")", PTR2UV(rv))); return rv; } @@ -4612,7 +4653,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname) rv = NEWSV(10002, 0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(rv, stash, 0); /* Will return if rv is null */ + SEEN_NN(rv, stash, 0); /* Will return if rv is null */ cxt->in_retrieve_overloaded = 1; /* so sv_bless doesn't call S_reset_amagic */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve */ cxt->in_retrieve_overloaded = 0; @@ -4633,7 +4674,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname) stash = SvTYPE(sv) ? (HV *) SvSTASH (sv) : 0; if (!stash) { - CROAK(("Cannot restore overloading on %s(0x%"UVxf + CROAK(("Cannot restore overloading on %s(0x%" UVxf ") (package )", sv_reftype(sv, FALSE), PTR2UV(sv))); @@ -4644,7 +4685,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("Going to load module '%s'", package)); load_module(PERL_LOADMOD_NOIMPORT, newSVpv(package, 0), Nullsv); if (!Gv_AMG(stash)) { - CROAK(("Cannot restore overloading on %s(0x%"UVxf + CROAK(("Cannot restore overloading on %s(0x%" UVxf ") (package %s) (even after a \"require %s;\")", sv_reftype(sv, FALSE), PTR2UV(sv), @@ -4654,7 +4695,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname) SvAMAGIC_on(rv); - TRACEME(("ok (retrieve_overloaded at 0x%"UVxf")", PTR2UV(rv))); + TRACEME(("ok (retrieve_overloaded at 0x%" UVxf ")", PTR2UV(rv))); return rv; } @@ -4698,7 +4739,7 @@ static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname) tv = NEWSV(10002, 0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(tv, stash, 0); /* Will return if tv is null */ + SEEN_NN(tv, stash, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve */ if (!sv) return (SV *) 0; /* Failed */ @@ -4708,7 +4749,7 @@ static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname) sv_magic(tv, sv, 'P', (char *)NULL, 0); SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */ - TRACEME(("ok (retrieve_tied_array at 0x%"UVxf")", PTR2UV(tv))); + TRACEME(("ok (retrieve_tied_array at 0x%" UVxf ")", PTR2UV(tv))); return tv; } @@ -4729,7 +4770,7 @@ static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, const char *cname) tv = NEWSV(10002, 0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(tv, stash, 0); /* Will return if tv is null */ + SEEN_NN(tv, stash, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve */ if (!sv) return (SV *) 0; /* Failed */ @@ -4738,7 +4779,7 @@ static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, const char *cname) sv_magic(tv, sv, 'P', (char *)NULL, 0); SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */ - TRACEME(("ok (retrieve_tied_hash at 0x%"UVxf")", PTR2UV(tv))); + TRACEME(("ok (retrieve_tied_hash at 0x%" UVxf ")", PTR2UV(tv))); return tv; } @@ -4759,7 +4800,7 @@ static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, const char *cname) tv = NEWSV(10002, 0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(tv, stash, 0); /* Will return if rv is null */ + SEEN_NN(tv, stash, 0); /* Will return if rv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve */ if (!sv) { return (SV *) 0; /* Failed */ @@ -4776,7 +4817,7 @@ static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, const char *cname) SvREFCNT_dec(obj); } - TRACEME(("ok (retrieve_tied_scalar at 0x%"UVxf")", PTR2UV(tv))); + TRACEME(("ok (retrieve_tied_scalar at 0x%" UVxf ")", PTR2UV(tv))); return tv; } @@ -4798,7 +4839,7 @@ static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, const char *cname) tv = NEWSV(10002, 0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(tv, stash, 0); /* Will return if tv is null */ + SEEN_NN(tv, stash, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve */ if (!sv) return (SV *) 0; /* Failed */ @@ -4832,7 +4873,7 @@ static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, const char *cname) tv = NEWSV(10002, 0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(tv, stash, 0); /* Will return if tv is null */ + SEEN_NN(tv, stash, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve */ if (!sv) return (SV *) 0; /* Failed */ @@ -4863,7 +4904,7 @@ static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname) HV *stash; RLEN(len); - TRACEME(("retrieve_lscalar (#%d), len = %"IVdf, cxt->tagnum, (IV) len)); + TRACEME(("retrieve_lscalar (#%d), len = %" IVdf, cxt->tagnum, (IV) len)); /* * Allocate an empty scalar of the suitable length. @@ -4871,10 +4912,10 @@ static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname) sv = NEWSV(10002, len); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ + SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ if (len == 0) { - sv_setpvn(sv, "", 0); + SvPVCLEAR(sv); return sv; } @@ -4894,8 +4935,8 @@ static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname) if (cxt->s_tainted) /* Is input source tainted? */ SvTAINT(sv); /* External data cannot be trusted */ - TRACEME(("large scalar len %"IVdf" '%s'", (IV) len, SvPVX(sv))); - TRACEME(("ok (retrieve_lscalar at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("large scalar len %" IVdf " '%s'", (IV) len, SvPVX(sv))); + TRACEME(("ok (retrieve_lscalar at 0x%" UVxf ")", PTR2UV(sv))); return sv; } @@ -4924,7 +4965,7 @@ static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname) sv = NEWSV(10002, len); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ + SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ /* * WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation. @@ -4942,7 +4983,7 @@ static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname) } SvGROW(sv, 1); *SvEND(sv) = '\0'; /* Ensure it's null terminated anyway */ - TRACEME(("ok (retrieve_scalar empty at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("ok (retrieve_scalar empty at 0x%" UVxf ")", PTR2UV(sv))); } else { /* * Now, for efficiency reasons, read data directly inside the SV buffer, @@ -4960,7 +5001,7 @@ static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname) if (cxt->s_tainted) /* Is input source tainted? */ SvTAINT(sv); /* External data cannot be trusted */ - TRACEME(("ok (retrieve_scalar at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("ok (retrieve_scalar at 0x%" UVxf ")", PTR2UV(sv))); return sv; } @@ -5049,7 +5090,7 @@ static SV *retrieve_vstring(pTHX_ stcxt_t *cxt, const char *cname) /* 5.10.0 and earlier seem to need this */ SvRMAGICAL_on(sv); - TRACEME(("ok (retrieve_vstring at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("ok (retrieve_vstring at 0x%" UVxf ")", PTR2UV(sv))); return sv; #else VSTRING_CROAK(); @@ -5070,7 +5111,7 @@ static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname) SV *sv; RLEN(len); - TRACEME(("retrieve_lvstring (#%d), len = %"IVdf, + TRACEME(("retrieve_lvstring (#%d), len = %" IVdf, cxt->tagnum, (IV)len)); New(10003, s, len+1, char); @@ -5084,7 +5125,7 @@ static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname) Safefree(s); - TRACEME(("ok (retrieve_lvstring at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("ok (retrieve_lvstring at 0x%" UVxf ")", PTR2UV(sv))); return sv; #else VSTRING_CROAK(); @@ -5109,10 +5150,10 @@ static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname) READ(&iv, sizeof(iv)); sv = newSViv(iv); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ + SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ - TRACEME(("integer %"IVdf, iv)); - TRACEME(("ok (retrieve_integer at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("integer %" IVdf, iv)); + TRACEME(("ok (retrieve_integer at 0x%" UVxf ")", PTR2UV(sv))); return sv; } @@ -5140,9 +5181,9 @@ static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("network integer (as-is) %d", iv)); #endif stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ + SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ - TRACEME(("ok (retrieve_netint at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("ok (retrieve_netint at 0x%" UVxf ")", PTR2UV(sv))); return sv; } @@ -5164,10 +5205,10 @@ static SV *retrieve_double(pTHX_ stcxt_t *cxt, const char *cname) READ(&nv, sizeof(nv)); sv = newSVnv(nv); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ + SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ - TRACEME(("double %"NVff, nv)); - TRACEME(("ok (retrieve_double at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("double %" NVff, nv)); + TRACEME(("ok (retrieve_double at 0x%" UVxf ")", PTR2UV(sv))); return sv; } @@ -5192,10 +5233,10 @@ static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname) tmp = (unsigned char) siv - 128; sv = newSViv(tmp); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ + SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ TRACEME(("byte %d", tmp)); - TRACEME(("ok (retrieve_byte at 0x%"UVxf")", PTR2UV(sv))); + TRACEME(("ok (retrieve_byte at 0x%" UVxf ")", PTR2UV(sv))); return sv; } @@ -5214,7 +5255,7 @@ static SV *retrieve_undef(pTHX_ stcxt_t *cxt, const char *cname) sv = newSV(0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 0); + SEEN_NN(sv, stash, 0); return sv; } @@ -5238,7 +5279,7 @@ static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname) cxt->where_is_undef = cxt->tagnum; } stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 1); + SEEN_NN(sv, stash, 1); return sv; } @@ -5255,7 +5296,7 @@ static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("retrieve_sv_yes")); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 1); + SEEN_NN(sv, stash, 1); return sv; } @@ -5272,7 +5313,7 @@ static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("retrieve_sv_no")); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 1); + SEEN_NN(sv, stash, 1); return sv; } @@ -5289,7 +5330,7 @@ static SV *retrieve_svundef_elem(pTHX_ stcxt_t *cxt, const char *cname) /* SEEN reads the contents of its SV argument, which we are not supposed to do with &PL_sv_placeholder. */ - SEEN(&PL_sv_undef, cname, 1); + SEEN_NN(&PL_sv_undef, cname, 1); return &PL_sv_placeholder; } @@ -5322,7 +5363,7 @@ static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("size = %d", len)); av = newAV(); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(av, stash, 0); /* Will return if array not allocated nicely */ + SEEN_NN(av, stash, 0); /* Will return if array not allocated nicely */ if (len) av_extend(av, len); else @@ -5348,7 +5389,7 @@ static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) } if (seen_null) av_fill(av, len-1); - TRACEME(("ok (retrieve_array at 0x%"UVxf")", PTR2UV(av))); + TRACEME(("ok (retrieve_array at 0x%" UVxf ")", PTR2UV(av))); return (SV *) av; } @@ -5383,7 +5424,7 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("size = %d", len)); hv = newHV(); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(hv, stash, 0); /* Will return if table not allocated properly */ + SEEN_NN(hv, stash, 0); /* Will return if table not allocated properly */ if (len == 0) return (SV *) hv; /* No data follow if table empty */ hv_ksplit(hv, len + 1); /* pre-extend hash to save multiple splits */ @@ -5424,7 +5465,7 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) return (SV *) 0; } - TRACEME(("ok (retrieve_hash at 0x%"UVxf")", PTR2UV(hv))); + TRACEME(("ok (retrieve_hash at 0x%" UVxf ")", PTR2UV(hv))); return (SV *) hv; } @@ -5472,7 +5513,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("size = %d, flags = %d", len, hash_flags)); hv = newHV(); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(hv, stash, 0); /* Will return if table not allocated properly */ + SEEN_NN(hv, stash, 0); /* Will return if table not allocated properly */ if (len == 0) return (SV *) hv; /* No data follow if table empty */ hv_ksplit(hv, len + 1); /* pre-extend hash to save multiple splits */ @@ -5569,7 +5610,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname) SvREADONLY_on(hv); #endif - TRACEME(("ok (retrieve_hash at 0x%"UVxf")", PTR2UV(hv))); + TRACEME(("ok (retrieve_hash at 0x%" UVxf ")", PTR2UV(hv))); return (SV *) hv; } @@ -5602,7 +5643,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) tagnum = cxt->tagnum; sv = newSViv(0); stash = cname ? gv_stashpv(cname, GV_ADD) : 0; - SEEN(sv, stash, 0); + SEEN_NN(sv, stash, 0); /* * Retrieve the source of the code reference @@ -5627,6 +5668,10 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) CROAK(("Unexpected type %d in retrieve_code\n", type)); } + if (!text) { + CROAK(("Unable to retrieve code\n")); + } + /* * prepend "sub " to the source */ @@ -5664,7 +5709,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) SAVETMPS; errsv = get_sv("@", GV_ADD); - sv_setpvn(errsv, "", 0); /* clear $@ */ + SvPVCLEAR(errsv); /* clear $@ */ if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) { PUSHMARK(sp); XPUSHs(sv_2mortal(newSVsv(sub))); @@ -5730,7 +5775,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) RLEN(len); TRACEME(("size = %d", len)); av = newAV(); - SEEN0(av, 0); /* Will return if array not allocated nicely */ + SEEN0_NN(av, 0); /* Will return if array not allocated nicely */ if (len) av_extend(av, len); else @@ -5747,7 +5792,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) continue; /* av_extend() already filled us with undef */ } if (c != SX_ITEM) - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ TRACEME(("(#%d) item", i)); sv = retrieve(aTHX_ cxt, 0); /* Retrieve item */ if (!sv) @@ -5756,7 +5801,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) return (SV *) 0; } - TRACEME(("ok (old_retrieve_array at 0x%"UVxf")", PTR2UV(av))); + TRACEME(("ok (old_retrieve_array at 0x%" UVxf ")", PTR2UV(av))); return (SV *) av; } @@ -5793,7 +5838,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) RLEN(len); TRACEME(("size = %d", len)); hv = newHV(); - SEEN0(hv, 0); /* Will return if table not allocated properly */ + SEEN0_NN(hv, 0); /* Will return if table not allocated properly */ if (len == 0) return (SV *) hv; /* No data follow if table empty */ hv_ksplit(hv, len + 1); /* pre-extend hash to save multiple splits */ @@ -5824,7 +5869,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) if (!sv) return (SV *) 0; } else - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ /* * Get key. @@ -5835,7 +5880,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) GETMARK(c); if (c != SX_KEY) - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ RLEN(size); /* Get key size */ KBUFCHK((STRLEN)size); /* Grow hash key read pool if needed */ if (size) @@ -5851,7 +5896,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) return (SV *) 0; } - TRACEME(("ok (retrieve_hash at 0x%"UVxf")", PTR2UV(hv))); + TRACEME(("ok (retrieve_hash at 0x%" UVxf ")", PTR2UV(hv))); return (SV *) hv; } @@ -6090,7 +6135,7 @@ static SV *retrieve(pTHX_ stcxt_t *cxt, const 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", + CROAK(("Old tag 0x%" UVxf " should have been mapped already", (UV) tag)); tagn = SvIV(*svh); /* Mapped tag number computed earlier below */ @@ -6100,10 +6145,12 @@ static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname) svh = av_fetch(cxt->aseen, tagn, FALSE); if (!svh) - CROAK(("Object #%"IVdf" should have been retrieved already", + CROAK(("Object #%" IVdf + " should have been retrieved already", (IV) tagn)); sv = *svh; - TRACEME(("has retrieved #%d at 0x%"UVxf, tagn, PTR2UV(sv))); + TRACEME(("has retrieved #%d at 0x%" UVxf, tagn, + PTR2UV(sv))); SvREFCNT_inc(sv); /* One more reference to this same sv */ return sv; /* The SV pointer where object was retrieved */ } @@ -6141,10 +6188,11 @@ static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname) tag = ntohl(tag); svh = av_fetch(cxt->aseen, tag, FALSE); if (!svh) - CROAK(("Object #%"IVdf" should have been retrieved already", + CROAK(("Object #%" IVdf + " should have been retrieved already", (IV) tag)); sv = *svh; - TRACEME(("had retrieved #%d at 0x%"UVxf, tag, PTR2UV(sv))); + TRACEME(("had retrieved #%d at 0x%" UVxf, tag, PTR2UV(sv))); SvREFCNT_inc(sv); /* One more reference to this same sv */ return sv; /* The SV pointer where object was retrieved */ } else if (type >= SX_ERROR && cxt->ver_minor > STORABLE_BIN_MINOR) { @@ -6207,7 +6255,7 @@ first_time: /* Will disappear when support for old format is dropped */ } } - TRACEME(("ok (retrieved 0x%"UVxf", refcnt=%d, %s)", PTR2UV(sv), + TRACEME(("ok (retrieved 0x%" UVxf ", refcnt=%d, %s)", PTR2UV(sv), SvREFCNT(sv) - 1, sv_reftype(sv, FALSE))); return sv; /* Ok */ @@ -6250,6 +6298,7 @@ static SV *do_retrieve( * free up memory for them now. */ + assert(cxt); if (cxt->s_dirty) clean_context(aTHX_ cxt); @@ -6393,7 +6442,7 @@ static SV *do_retrieve( #endif } - TRACEME(("retrieve got %s(0x%"UVxf")", + TRACEME(("retrieve got %s(0x%" UVxf ")", sv_reftype(sv, FALSE), PTR2UV(sv))); /* @@ -6496,6 +6545,7 @@ static SV *dclone(pTHX_ SV *sv) * free up memory for them now. */ + assert(cxt); if (cxt->s_dirty) clean_context(aTHX_ cxt); @@ -6533,6 +6583,7 @@ static SV *dclone(pTHX_ SV *sv) * Now, 'cxt' may refer to a new context. */ + assert(cxt); ASSERT(!cxt->s_dirty, ("clean context")); ASSERT(!cxt->entry, ("entry will not cause new context allocation")); @@ -6551,7 +6602,7 @@ static SV *dclone(pTHX_ SV *sv) cxt->s_tainted = SvTAINTED(sv); out = do_retrieve(aTHX_ (PerlIO*) 0, Nullsv, ST_CLONE); - TRACEME(("dclone returns 0x%"UVxf, PTR2UV(out))); + TRACEME(("dclone returns 0x%" UVxf, PTR2UV(out))); return out; } @@ -6696,6 +6747,7 @@ last_op_in_netorder() if (ix) { dSTCXT; + assert(cxt); result = cxt->entry && (cxt->optype & ix) ? TRUE : FALSE; } else { result = !!last_op_in_netorder(aTHX); diff --git a/t/code.t b/t/code.t index 7fc40ba..d31e231 100644 --- a/t/code.t +++ b/t/code.t @@ -71,7 +71,7 @@ local *FOO; \&dclone, # XS function - sub { open FOO, "/" }, + sub { open FOO, '<', "/" }, ); $Storable::Deparse = 1; @@ -191,7 +191,7 @@ is(prototype($thawed->[4]), prototype($obj[0]->[4])); my $devnull = File::Spec->devnull; open(SAVEERR, ">&STDERR"); - open(STDERR, ">$devnull") or + open(STDERR, '>', $devnull) or ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); eval { $freezed = freeze $obj[0]->[0] }; diff --git a/t/compat01.t b/t/compat01.t index 2827676..56d7df6 100644 --- a/t/compat01.t +++ b/t/compat01.t @@ -33,7 +33,7 @@ my $testno; for my $dump (@dumps) { $testno++; - open(FH, ">$file") || die "Can't create $file: $!"; + open(FH, '>', $file) || die "Can't create $file: $!"; binmode(FH); print FH $dump; close(FH) || die "Can't write $file: $!"; diff --git a/t/dclone.t b/t/dclone.t index 1e852a3..af3d7f6 100644 --- a/t/dclone.t +++ b/t/dclone.t @@ -68,7 +68,7 @@ is($$cloned{''}[0], \$$cloned{a}); $$cloned{a} = "blah"; is($$cloned{''}[0], \$$cloned{a}); -# [ID 20020221.007] SEGV in Storable with empty string scalar object +# [ID 20020221.007 (#8624)] SEGV in Storable with empty string scalar object package TestString; sub new { my ($type, $string) = @_; diff --git a/t/destroy.t b/t/destroy.t index e9464fb..dcc3600 100644 --- a/t/destroy.t +++ b/t/destroy.t @@ -7,7 +7,7 @@ BEGIN { package foo; sub new { return bless {} } DESTROY { - open FH, "$file") || die "Can't create $file: $!"; + open(FH, '>', $file) || die "Can't create $file: $!"; binmode(FH); print FH $data; close(FH) || die "Can't write $file: $!"; diff --git a/t/forgive.t b/t/forgive.t index c994211..af7aa1d 100644 --- a/t/forgive.t +++ b/t/forgive.t @@ -45,7 +45,7 @@ $Storable::forgive_me=1; my $devnull = File::Spec->devnull; open(SAVEERR, ">&STDERR"); -open(STDERR, ">$devnull") or +open(STDERR, '>', $devnull) or ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); eval {$result = store ($bad , 'store')}; diff --git a/t/recurse.t b/t/recurse.t index 930a224..399101c 100644 --- a/t/recurse.t +++ b/t/recurse.t @@ -272,7 +272,7 @@ sub set_c2 { $_[0]->{c2} = $_[1] } # # Is the reference count of the extra references returned from a -# STORABLE_freeze hook correct? [ID 20020601.005] +# STORABLE_freeze hook correct? [ID 20020601.005 (#9436)] # package Foo2; diff --git a/t/store.t b/t/store.t index be43299..b25dbd2 100644 --- a/t/store.t +++ b/t/store.t @@ -1,7 +1,7 @@ #!./perl # # Copyright (c) 1995-2000, Raphael Manfredi -# +# # You may redistribute only under the same terms as Perl 5, as specified # in the README file that comes with the distribution. # @@ -19,7 +19,7 @@ sub BEGIN { use Storable qw(store retrieve store_fd nstore_fd fd_retrieve); -use Test::More tests => 21; +use Test::More tests => 25; $a = 'toto'; $b = \$a; @@ -87,5 +87,29 @@ is(&dump($r), &dump(\%a)); eval { $r = fd_retrieve(::OUT); }; isnt($@, ''); +{ + my %test = ( + old_retrieve_array => "\x70\x73\x74\x30\x01\x0a\x02\x02\x02\x02\x00\x3d\x08\x84\x08\x85\x08\x06\x04\x00\x00\x01\x1b", + old_retrieve_hash => "\x70\x73\x74\x30\x01\x0a\x03\x00\xe8\x03\x00\x00\x81\x00\x00\x00\x01\x61", + retrieve_code => "\x70\x73\x74\x30\x05\x0a\x19\xf0\x00\xff\xe8\x03\x1a\x0a\x0e\x01", + ); + + for my $k (sort keys %test) { + open my $fh, '<', \$test{$k}; + eval { Storable::fd_retrieve($fh); }; + is($?, 0, 'RT 130098: no segfault in Storable::fd_retrieve()'); + } +} + +{ + + my $frozen = + "\x70\x73\x74\x30\x04\x0a\x08\x31\x32\x33\x34\x35\x36\x37\x38\x04\x08\x08\x08\x03\xff\x00\x00\x00\x19\x08\xff\x00\x00\x00\x08\x08\xf9\x16\x16\x13\x16\x10\x10\x10\xff\x15\x16\x16\x16\x1e\x16\x16\x16\x16\x16\x16\x16\x16\x16\x16\x13\xf0\x16\x16\x16\xfe\x16\x41\x41\x41\x41\xe8\x03\x41\x41\x41\x41\x41\x41\x41\x41\x51\x41\xa9\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xb8\xac\xac\xac\xac\xac\xac\xac\xac\x9a\xac\xac\xac\xac\xac\xac\xac\xac\xac\x93\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\x00\x64\xac\xa8\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\xac\x2c\xac\x41\x41\x41\x41\x41\x41\x41\x41\x41\x00\x80\x41\x80\x41\x41\x41\x41\x41\x41\x51\x41\xac\xac\xac"; + open my $fh, '<', \$frozen; + eval { Storable::fd_retrieve($fh); }; + pass('RT 130635: no stack smashing error when retrieving hook'); + +} + close OUT or die "Could not close: $!"; END { 1 while unlink 'store' } diff --git a/t/testlib.pl b/t/testlib.pl index 6d885d7..9b07dd4 100644 --- a/t/testlib.pl +++ b/t/testlib.pl @@ -12,7 +12,7 @@ use Storable qw (store retrieve freeze thaw nstore nfreeze); sub slurp { my $file = shift; local (*FH, $/); - open FH, "<$file" or die "Can't open '$file': $!"; + open FH, '<', $file or die "Can't open '$file': $!"; binmode FH; my $contents = ; die "Can't read $file: $!" unless defined $contents; @@ -22,7 +22,7 @@ sub slurp { sub store_and_retrieve { my $data = shift; unlink $file or die "Can't unlink '$file': $!"; - open FH, ">$file" or die "Can't open '$file': $!"; + open FH, '>', $file or die "Can't open '$file': $!"; binmode FH; print FH $data or die "Can't print to '$file': $!"; close FH or die "Can't close '$file': $!"; @@ -35,4 +35,4 @@ sub freeze_and_thaw { return eval {thaw $data}; } -$file; +1; -- 2.9.3