X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.c;h=4e6d930ed215c9f0ae0852236d7329b82d250777;hb=ca9279baf07d6843f58a31f1ce3ff7dc875faf1a;hp=effecb7a00b81e0aefc2b86d8b5fd5d8157b8625;hpb=efd8b2bacfee8a05a6684f052b8bf5610dd1fa01;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.c b/sv.c index effecb7..4e6d930 100644 --- a/sv.c +++ b/sv.c @@ -1,6 +1,7 @@ /* sv.c * - * Copyright (c) 1991-2003, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -2889,6 +2890,16 @@ uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob) return ptr; } +/* sv_2pv() is now a macro using Perl_sv_2pv_flags(); + * this function provided for binary compatibility only + */ + +char * +Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) +{ + return sv_2pv_flags(sv, lp, SV_GMAGIC); +} + /* =for apidoc sv_2pv_flags @@ -3058,7 +3069,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) s = "REF"; else s = "SCALAR"; break; - case SVt_PVLV: s = "LVALUE"; break; + case SVt_PVLV: s = SvROK(sv) ? "REF":"LVALUE"; break; case SVt_PVAV: s = "ARRAY"; break; case SVt_PVHV: s = "HASH"; break; case SVt_PVCV: s = "CODE"; break; @@ -3069,7 +3080,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) } tsv = NEWSV(0,0); if (SvOBJECT(sv)) - Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s); + if (HvNAME(SvSTASH(sv))) + Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s); + else + Perl_sv_setpvf(aTHX_ tsv, "__ANON__=%s", s); else sv_setpv(tsv, s); Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv)); @@ -3340,6 +3354,17 @@ Perl_sv_2bool(pTHX_ register SV *sv) } } +/* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags(); + * this function provided for binary compatibility only + */ + + +STRLEN +Perl_sv_utf8_upgrade(pTHX_ register SV *sv) +{ + return sv_utf8_upgrade_flags(sv, SV_GMAGIC); +} + /* =for apidoc sv_utf8_upgrade @@ -3522,6 +3547,16 @@ Perl_sv_utf8_decode(pTHX_ register SV *sv) return TRUE; } +/* sv_setsv() is now a macro using Perl_sv_setsv_flags(); + * this function provided for binary compatibility only + */ + +void +Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) +{ + sv_setsv_flags(dstr, sstr, SV_GMAGIC); +} + /* =for apidoc sv_setsv @@ -3652,8 +3687,16 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) goto glob_assign; } break; - case SVt_PV: case SVt_PVFM: +#ifdef PERL_COPY_ON_WRITE + if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) { + if (dtype < SVt_PVIV) + sv_upgrade(dstr, SVt_PVIV); + break; + } + /* Fall through */ +#endif + case SVt_PV: if (dtype < SVt_PV) sv_upgrade(dstr, SVt_PV); break; @@ -3975,6 +4018,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) /* making another shared SV. */ STRLEN cur = SvCUR(sstr); STRLEN len = SvLEN(sstr); + assert (SvTYPE(dstr) >= SVt_PVIV); if (len) { /* SvIsCOW_normal */ /* splice us in between source and next-after-source. */ @@ -4417,11 +4461,11 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) char *pvx = SvPVX(sv); STRLEN len = SvCUR(sv); U32 hash = SvUVX(sv); + SvFAKE_off(sv); + SvREADONLY_off(sv); SvGROW(sv, len + 1); Move(pvx,SvPVX(sv),len,char); *SvEND(sv) = '\0'; - SvFAKE_off(sv); - SvREADONLY_off(sv); unsharepvn(pvx, SvUTF8(sv) ? -(I32)len : len, hash); } else if (PL_curcop != &PL_compiling) @@ -4457,6 +4501,8 @@ Efficient removal of characters from the beginning of the string buffer. SvPOK(sv) must be true and the C must be a pointer to somewhere inside the string buffer. The C becomes the first character of the adjusted string. Uses the "OOK hack". +Beware: after this function returns, C and SvPVX(sv) may no longer +refer to the same chunk of data. =cut */ @@ -4465,9 +4511,9 @@ void Perl_sv_chop(pTHX_ register SV *sv, register char *ptr) { register STRLEN delta; - if (!ptr || !SvPOKp(sv)) return; + delta = ptr - SvPVX(sv); SV_CHECK_THINKFIRST(sv); if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv,SVt_PVIV); @@ -4487,13 +4533,22 @@ Perl_sv_chop(pTHX_ register SV *sv, register char *ptr) SvFLAGS(sv) |= SVf_OOK; } SvNIOK_off(sv); - delta = ptr - SvPVX(sv); SvLEN(sv) -= delta; SvCUR(sv) -= delta; SvPVX(sv) += delta; SvIVX(sv) += delta; } +/* sv_catpvn() is now a macro using Perl_sv_catpvn_flags(); + * this function provided for binary compatibility only + */ + +void +Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen) +{ + sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC); +} + /* =for apidoc sv_catpvn @@ -4546,6 +4601,16 @@ Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRL SvSETMAGIC(sv); } +/* sv_catsv() is now a macro using Perl_sv_catsv_flags(); + * this function provided for binary compatibility only + */ + +void +Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr) +{ + sv_catsv_flags(dstr, sstr, SV_GMAGIC); +} + /* =for apidoc sv_catsv @@ -5248,34 +5313,37 @@ Perl_sv_clear(pTHX_ register SV *sv) if (PL_defstash) { /* Still have a symbol table? */ dSP; CV* destructor; - SV tmpref; - Zero(&tmpref, 1, SV); - sv_upgrade(&tmpref, SVt_RV); - SvROK_on(&tmpref); - SvREADONLY_on(&tmpref); /* DESTROY() could be naughty */ - SvREFCNT(&tmpref) = 1; + do { stash = SvSTASH(sv); destructor = StashHANDLER(stash,DESTROY); if (destructor) { + SV* tmpref = newRV(sv); + SvREADONLY_on(tmpref); /* DESTROY() could be naughty */ ENTER; PUSHSTACKi(PERLSI_DESTROY); - SvRV(&tmpref) = SvREFCNT_inc(sv); EXTEND(SP, 2); PUSHMARK(SP); - PUSHs(&tmpref); + PUSHs(tmpref); PUTBACK; call_sv((SV*)destructor, G_DISCARD|G_EVAL|G_KEEPERR|G_VOID); - SvREFCNT(sv)--; + + POPSTACK; SPAGAIN; LEAVE; + if(SvREFCNT(tmpref) < 2) { + /* tmpref is not kept alive! */ + SvREFCNT(sv)--; + SvRV(tmpref) = 0; + SvROK_off(tmpref); + } + SvREFCNT_dec(tmpref); } } while (SvOBJECT(sv) && SvSTASH(sv) != stash); - del_XRV(SvANY(&tmpref)); if (SvREFCNT(sv)) { if (PL_in_clean_objs) @@ -5329,7 +5397,13 @@ Perl_sv_clear(pTHX_ register SV *sv) av_undef((AV*)sv); break; case SVt_PVLV: - SvREFCNT_dec(LvTARG(sv)); + if (LvTYPE(sv) == 'T') { /* for tie: return HE to pool */ + SvREFCNT_dec(HeKEY_sv((HE*)LvTARG(sv))); + HeNEXT((HE*)LvTARG(sv)) = PL_hv_fetch_ent_mh; + PL_hv_fetch_ent_mh = (HE*)LvTARG(sv); + } + else if (LvTYPE(sv) != 't') /* unless tie: unrefcnted fake SV** */ + SvREFCNT_dec(LvTARG(sv)); goto freescalar; case SVt_PVGV: gp_free((GV*)sv); @@ -5844,13 +5918,13 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp) mg = mg_find(sv, PERL_MAGIC_utf8); if (mg && mg->mg_ptr) { cache = (STRLEN *) mg->mg_ptr; - if (cache[1] == *offsetp) { + if (cache[1] == (STRLEN)*offsetp) { /* An exact match. */ *offsetp = cache[0]; return; } - else if (cache[1] < *offsetp) { + else if (cache[1] < (STRLEN)*offsetp) { /* We already know part of the way. */ len = cache[0]; s += cache[1]; @@ -5873,13 +5947,15 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp) while (backw--) { p--; - while (UTF8_IS_CONTINUATION(*p)) + while (UTF8_IS_CONTINUATION(*p)) { p--; + backw--; + } ubackw++; } cache[0] -= ubackw; - + *offsetp = cache[0]; return; } } @@ -6238,7 +6314,8 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) I32 rspara = 0; I32 recsize; - SV_CHECK_THINKFIRST_COW_DROP(sv); + if (SvTHINKFIRST(sv)) + sv_force_normal_flags(sv, append ? 0 : SV_COW_DROP_PV); /* XXX. If you make this PVIV, then copy on write can copy scalars read from <>. However, perlbench says it's slower, because the existing swipe code @@ -6283,7 +6360,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) Stat_t st; if (!PerlLIO_fstat(PerlIO_fileno(fp), &st) && S_ISREG(st.st_mode)) { Off_t offset = PerlIO_tell(fp); - if (offset != (Off_t) -1) { + if (offset != (Off_t) -1 && st.st_size + append > offset) { (void) SvGROW(sv, (STRLEN)((st.st_size - offset) + append + 1)); } } @@ -6308,6 +6385,8 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) #else bytesread = PerlIO_read(fp, buffer, recsize); #endif + if (bytesread < 0) + bytesread = 0; SvCUR_set(sv, bytesread += append); buffer[bytesread] = '\0'; goto return_string_or_null; @@ -7473,6 +7552,21 @@ Perl_sv_nv(pTHX_ register SV *sv) return sv_2nv(sv); } +/* sv_pv() is now a macro using SvPV_nolen(); + * this function provided for binary compatibility only + */ + +char * +Perl_sv_pv(pTHX_ SV *sv) +{ + STRLEN n_a; + + if (SvPOK(sv)) + return SvPVX(sv); + + return sv_2pv(sv, &n_a); +} + /* =for apidoc sv_pv @@ -7507,6 +7601,16 @@ Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp) return sv_2pv_flags(sv, lp, 0); } +/* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags(); + * this function provided for binary compatibility only + */ + +char * +Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp) +{ + return sv_pvn_force_flags(sv, lp, SV_GMAGIC); +} + /* =for apidoc sv_pvn_force @@ -7565,6 +7669,17 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) return SvPVX(sv); } +/* sv_pvbyte () is now a macro using Perl_sv_2pv_flags(); + * this function provided for binary compatibility only + */ + +char * +Perl_sv_pvbyte(pTHX_ SV *sv) +{ + sv_utf8_downgrade(sv,0); + return sv_pv(sv); +} + /* =for apidoc sv_pvbyte @@ -7603,6 +7718,17 @@ Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp) return sv_pvn_force(sv,lp); } +/* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags(); + * this function provided for binary compatibility only + */ + +char * +Perl_sv_pvutf8(pTHX_ SV *sv) +{ + sv_utf8_upgrade(sv); + return sv_pv(sv); +} + /* =for apidoc sv_pvutf8 @@ -7653,7 +7779,10 @@ char * Perl_sv_reftype(pTHX_ SV *sv, int ob) { if (ob && SvOBJECT(sv)) { - return HvNAME(SvSTASH(sv)); + if (HvNAME(SvSTASH(sv))) + return HvNAME(SvSTASH(sv)); + else + return "__ANON__"; } else { switch (SvTYPE(sv)) { @@ -7672,7 +7801,7 @@ Perl_sv_reftype(pTHX_ SV *sv, int ob) return "REF"; else return "SCALAR"; - case SVt_PVLV: return "LVALUE"; + case SVt_PVLV: return SvROK(sv) ? "REF" : "LVALUE"; case SVt_PVAV: return "ARRAY"; case SVt_PVHV: return "HASH"; case SVt_PVCV: return "CODE"; @@ -7731,6 +7860,8 @@ Perl_sv_isa(pTHX_ SV *sv, const char *name) sv = (SV*)SvRV(sv); if (!SvOBJECT(sv)) return 0; + if (!HvNAME(SvSTASH(sv))) + return 0; return strEQ(HvNAME(SvSTASH(sv)), name); } @@ -8070,6 +8201,44 @@ Perl_sv_tainted(pTHX_ SV *sv) return FALSE; } +/* +=for apidoc sv_setpviv + +Copies an integer into the given SV, also updating its string value. +Does not handle 'set' magic. See C. + +=cut +*/ + +void +Perl_sv_setpviv(pTHX_ SV *sv, IV iv) +{ + char buf[TYPE_CHARS(UV)]; + char *ebuf; + char *ptr = uiv_2buf(buf, iv, 0, 0, &ebuf); + + sv_setpvn(sv, ptr, ebuf - ptr); +} + +/* +=for apidoc sv_setpviv_mg + +Like C, but also handles 'set' magic. + +=cut +*/ + +void +Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv) +{ + char buf[TYPE_CHARS(UV)]; + char *ebuf; + char *ptr = uiv_2buf(buf, iv, 0, 0, &ebuf); + + sv_setpvn(sv, ptr, ebuf - ptr); + SvSETMAGIC(sv); +} + #if defined(PERL_IMPLICIT_CONTEXT) /* pTHX_ magic can't cope with varargs, so this is a no-context @@ -8358,6 +8527,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV STRLEN zeros = 0; bool has_precis = FALSE; STRLEN precis = 0; + I32 osvix = svix; bool is_utf8 = FALSE; /* is this item utf8? */ #ifdef HAS_LDBL_SPRINTF_BUG /* This is to try to fix a bug with irix/nonstop-ux/powerux and @@ -9109,7 +9279,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV default: unknown: - vectorize = FALSE; if (!args && ckWARN(WARN_PRINTF) && (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) { SV *msg = sv_newmortal(); @@ -9141,6 +9310,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV p += elen; *p = '\0'; SvCUR(sv) = p - SvPVX(sv); + svix = osvix; continue; /* not "break" */ } @@ -9159,6 +9329,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV p = SvEND(sv); *p = '\0'; } + /* Use memchr() instead of strchr(), as eptr is not guaranteed */ + /* to point to a null-terminated string. */ + if (left && ckWARN(WARN_PRINTF) && memchr(eptr, '\n', elen) && + (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) + Perl_warner(aTHX_ packWARN(WARN_PRINTF), + "Newline in left-justified string for %sprintf", + (PL_op->op_type == OP_PRTF) ? "" : "s"); have = esignlen + zeros + elen; need = (have > width ? have : width); @@ -9716,9 +9893,20 @@ Perl_rvpv_dup(pTHX_ SV *dstr, SV *sstr, CLONE_PARAMS* param) /* Special case - not normally malloced for some reason */ if (SvREADONLY(sstr) && SvFAKE(sstr)) { /* A "shared" PV - clone it as unshared string */ - SvFAKE_off(dstr); - SvREADONLY_off(dstr); - SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr)); + if(SvPADTMP(sstr)) { + /* However, some of them live in the pad + and they should not have these flags + turned off */ + + SvPVX(dstr) = sharepvn(SvPVX(sstr), SvCUR(sstr), + SvUVX(sstr)); + SvUVX(dstr) = SvUVX(sstr); + } else { + + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvCUR(sstr)); + SvFAKE_off(dstr); + SvREADONLY_off(dstr); + } } else { /* Some other special case - random pointer */ @@ -9842,7 +10030,12 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) Perl_rvpv_dup(aTHX_ dstr, sstr, param); LvTARGOFF(dstr) = LvTARGOFF(sstr); /* XXX sometimes holds PMOP* when DEBUGGING */ LvTARGLEN(dstr) = LvTARGLEN(sstr); - LvTARG(dstr) = sv_dup_inc(LvTARG(sstr), param); + if (LvTYPE(sstr) == 't') /* for tie: unrefcnted fake (SV**) */ + LvTARG(dstr) = dstr; + else if (LvTYPE(sstr) == 'T') /* for tie: fake HE */ + LvTARG(dstr) = (SV*)he_dup((HE*)LvTARG(sstr), 0, param); + else + LvTARG(dstr) = sv_dup_inc(LvTARG(sstr), param); LvTYPE(dstr) = LvTYPE(sstr); break; case SVt_PVGV: @@ -9897,12 +10090,21 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) IoPAGE(dstr) = IoPAGE(sstr); IoPAGE_LEN(dstr) = IoPAGE_LEN(sstr); IoLINES_LEFT(dstr) = IoLINES_LEFT(sstr); + if(IoFLAGS(sstr) & IOf_FAKE_DIRP) { + /* I have no idea why fake dirp (rsfps) + should be treaded differently but otherwise + we end up with leaks -- sky*/ + IoTOP_GV(dstr) = gv_dup_inc(IoTOP_GV(sstr), param); + IoFMT_GV(dstr) = gv_dup_inc(IoFMT_GV(sstr), param); + IoBOTTOM_GV(dstr) = gv_dup_inc(IoBOTTOM_GV(sstr), param); + } else { + IoTOP_GV(dstr) = gv_dup(IoTOP_GV(sstr), param); + IoFMT_GV(dstr) = gv_dup(IoFMT_GV(sstr), param); + IoBOTTOM_GV(dstr) = gv_dup(IoBOTTOM_GV(sstr), param); + } IoTOP_NAME(dstr) = SAVEPV(IoTOP_NAME(sstr)); - IoTOP_GV(dstr) = gv_dup(IoTOP_GV(sstr), param); IoFMT_NAME(dstr) = SAVEPV(IoFMT_NAME(sstr)); - IoFMT_GV(dstr) = gv_dup(IoFMT_GV(sstr), param); IoBOTTOM_NAME(dstr) = SAVEPV(IoBOTTOM_NAME(sstr)); - IoBOTTOM_GV(dstr) = gv_dup(IoBOTTOM_GV(sstr), param); IoSUBPROCESS(dstr) = IoSUBPROCESS(sstr); IoTYPE(dstr) = IoTYPE(sstr); IoFLAGS(dstr) = IoFLAGS(sstr); @@ -10802,6 +11004,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* internal state */ PL_tainting = proto_perl->Itainting; + PL_taint_warn = proto_perl->Itaint_warn; PL_maxo = proto_perl->Imaxo; if (proto_perl->Iop_mask) PL_op_mask = SAVEPVN(proto_perl->Iop_mask, PL_maxo); @@ -10879,7 +11082,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_origalen = proto_perl->Iorigalen; PL_pidstatus = newHV(); /* XXX flag for cloning? */ PL_osname = SAVEPV(proto_perl->Iosname); - PL_sh_path = proto_perl->Ish_path; /* XXX never deallocated */ + PL_sh_path_compat = proto_perl->Ish_path_compat; /* XXX never deallocated */ PL_sighandlerp = proto_perl->Isighandlerp; @@ -11011,6 +11214,40 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_utf8_idstart = sv_dup_inc(proto_perl->Iutf8_idstart, param); PL_utf8_idcont = sv_dup_inc(proto_perl->Iutf8_idcont, param); + /* Did the locale setup indicate UTF-8? */ + PL_utf8locale = proto_perl->Iutf8locale; + /* Unicode features (see perlrun/-C) */ + PL_unicode = proto_perl->Iunicode; + + /* Pre-5.8 signals control */ + PL_signals = proto_perl->Isignals; + + /* times() ticks per second */ + PL_clocktick = proto_perl->Iclocktick; + + /* Recursion stopper for PerlIO_find_layer */ + PL_in_load_module = proto_perl->Iin_load_module; + + /* sort() routine */ + PL_sort_RealCmp = proto_perl->Isort_RealCmp; + + /* Not really needed/useful since the reenrant_retint is "volatile", + * but do it for consistency's sake. */ + PL_reentrant_retint = proto_perl->Ireentrant_retint; + + /* Hooks to shared SVs and locks. */ + PL_sharehook = proto_perl->Isharehook; + PL_lockhook = proto_perl->Ilockhook; + PL_unlockhook = proto_perl->Iunlockhook; + PL_threadhook = proto_perl->Ithreadhook; + + PL_runops_std = proto_perl->Irunops_std; + PL_runops_dbg = proto_perl->Irunops_dbg; + +#ifdef THREADS_HAVE_PIDS + PL_ppid = proto_perl->Ippid; +#endif + /* swatch cache */ PL_last_swash_hv = Nullhv; /* reinits on demand */ PL_last_swash_klen = 0; @@ -11152,9 +11389,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_protect = proto_perl->Tprotect; #endif PL_errors = sv_dup_inc(proto_perl->Terrors, param); - PL_av_fetch_sv = Nullsv; - PL_hv_fetch_sv = Nullsv; - Zero(&PL_hv_fetch_ent_mh, 1, HE); /* XXX */ + PL_hv_fetch_ent_mh = Nullhe; PL_modcount = proto_perl->Tmodcount; PL_lastgotoprobe = Nullop; PL_dumpindent = proto_perl->Tdumpindent; @@ -11232,6 +11467,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* Pluggable optimizer */ PL_peepp = proto_perl->Tpeepp; + PL_stashcache = newHV(); + if (!(flags & CLONEf_KEEP_PTR_TABLE)) { ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; @@ -11344,8 +11581,8 @@ bool Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding, SV *ssv, int *offset, char *tstr, int tlen) { + bool ret = FALSE; if (SvPOK(ssv) && SvPOK(dsv) && SvROK(encoding) && offset) { - bool ret = FALSE; SV *offsv; dSP; ENTER; @@ -11366,8 +11603,9 @@ Perl_sv_cat_decode(pTHX_ SV *dsv, SV *encoding, PUTBACK; FREETMPS; LEAVE; - return ret; } - Perl_croak(aTHX_ "Invalid argument to sv_cat_decode."); + else + Perl_croak(aTHX_ "Invalid argument to sv_cat_decode"); + return ret; }