but that is really the callers pad (a slot of which is allocated by
every entersub).
-The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
-is managed "manual" (mostly in pad.c) rather than normal av.c rules.
+The CvPADLIST AV has the REFCNT of its component items managed "manually"
+(mostly in pad.c) rather than by normal av.c rules. So we turn off AvREAL
+just before freeing it, to let av.c know not to touch the entries.
The items in the AV are not SVs as for a normal AV, but other AVs:
0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
#endif
/*
+This is basically sv_eq_flags() in sv.c, but we avoid the magic
+and bytes checking.
+*/
+
+static bool
+sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U32 flags) {
+ if ( (SvUTF8(sv) & SVf_UTF8 ) != (flags & SVf_UTF8) ) {
+ const char *pv1 = SvPVX_const(sv);
+ STRLEN cur1 = SvCUR(sv);
+ const char *pv2 = pv;
+ STRLEN cur2 = pvlen;
+ if (PL_encoding) {
+ SV* svrecode = NULL;
+ if (SvUTF8(sv)) {
+ svrecode = newSVpvn(pv2, cur2);
+ sv_recode_to_utf8(svrecode, PL_encoding);
+ pv2 = SvPV_const(svrecode, cur2);
+ }
+ else {
+ svrecode = newSVpvn(pv1, cur1);
+ sv_recode_to_utf8(svrecode, PL_encoding);
+ pv1 = SvPV_const(svrecode, cur1);
+ }
+ SvREFCNT_dec(svrecode);
+ }
+ if (flags & SVf_UTF8)
+ return (bytes_cmp_utf8(
+ (const U8*)pv1, cur1,
+ (const U8*)pv2, cur2) == 0);
+ else
+ return (bytes_cmp_utf8(
+ (const U8*)pv2, cur2,
+ (const U8*)pv1, cur1) == 0);
+ }
+ else
+ return ((SvPVX_const(sv) == pv)
+ || memEQ(SvPVX_const(sv), pv, pvlen));
+}
+
+
+/*
=for apidoc Am|PADLIST *|pad_new|int flags
Create a new padlist, updating the global variables for the
av_store(pad, 0, NULL);
}
- AvREAL_off(padlist);
/* Most subroutines never recurse, hence only need 2 entries in the padlist
array - names, and depth=1. The default for av_store() is to allocate
0..3, and even an explicit call to av_extend() with <3 will be rounded
{
dVAR;
const PADLIST *padlist = CvPADLIST(cv);
+ bool const slabbed = !!CvSLABBED(cv);
PERL_ARGS_ASSERT_CV_UNDEF;
PTR2UV(cv), PTR2UV(PL_comppad))
);
-#ifdef USE_ITHREADS
- if (CvFILE(cv) && !CvISXSUB(cv)) {
- /* for XSUBs CvFILE point directly to static memory; __FILE__ */
+ if (CvFILE(cv) && CvDYNFILE(cv)) {
Safefree(CvFILE(cv));
}
CvFILE(cv) = NULL;
-#endif
+ CvSLABBED_off(cv);
if (!CvISXSUB(cv) && CvROOT(cv)) {
if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
Perl_croak(aTHX_ "Can't undef active subroutine");
PAD_SAVE_SETNULLPAD();
+#ifndef PL_OP_SLAB_ALLOC
+ if (slabbed) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(cv)));
+#endif
op_free(CvROOT(cv));
CvROOT(cv) = NULL;
CvSTART(cv) = NULL;
LEAVE;
}
+#ifndef PL_OP_SLAB_ALLOC
+ else if (slabbed && CvSTART(cv)) {
+ ENTER;
+ PAD_SAVE_SETNULLPAD();
+
+ /* discard any leaked ops */
+ opslab_force_free((OPSLAB *)CvSTART(cv));
+ CvSTART(cv) = NULL;
+
+ LEAVE;
+ }
+# ifdef DEBUGGING
+ else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
+# endif
+#endif
SvPOK_off(MUTABLE_SV(cv)); /* forget prototype */
CvGV_set(cv, NULL);
CV * const innercv = MUTABLE_CV(curpad[ix]);
U32 inner_rc = SvREFCNT(innercv);
assert(inner_rc);
+ assert(SvTYPE(innercv) != SVt_PVFM);
namepad[ix] = NULL;
SvREFCNT_dec(namesv);
PL_comppad_name = NULL;
SvREFCNT_dec(sv);
}
+ AvREAL_off(CvPADLIST(cv));
SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
CvPADLIST(cv) = NULL;
}
CvXSUB(cv) = NULL;
}
/* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
- * ref status of CvOUTSIDE and CvGV */
- CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
+ * ref status of CvOUTSIDE and CvGV, and ANON, which pp_entersub uses
+ * to choose an error message */
+ CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON);
}
+#ifndef PL_OP_SLAB_ALLOC
+void
+Perl_cv_forget_slab(pTHX_ CV *cv)
+{
+ const bool slabbed = !!CvSLABBED(cv);
+
+ PERL_ARGS_ASSERT_CV_FORGET_SLAB;
+
+ if (!slabbed) return;
+
+ CvSLABBED_off(cv);
+
+ if (CvROOT(cv)) OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
+ else if (CvSTART(cv)) OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
+# ifdef DEBUGGING
+ else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
+# endif
+}
+#endif
+
/*
=for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash
-Allocates a place in the currently-compiling pad (via L</pad_alloc>) and
+Allocates a place in the currently-compiling
+pad (via L<perlapi/pad_alloc>) and
then stores a name for that entry. I<namesv> is adopted and becomes the
name entry; it must already contain the name string and be sufficiently
upgraded. I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
-added to I<namesv>. None of the other processing of L</pad_add_name_pvn>
+added to I<namesv>. None of the other
+processing of L<perlapi/pad_add_name_pvn>
is done. Returns the offset of the allocated pad slot.
=cut
dVAR;
PADOFFSET offset;
SV *namesv;
+ bool is_utf8;
PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
- if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK))
+ if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK|padadd_UTF8_NAME))
Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
(UV)flags);
namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
+
+ if ((is_utf8 = ((flags & padadd_UTF8_NAME) != 0))) {
+ namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
+ }
+
sv_setpvn(namesv, namepv, namelen);
+ if (is_utf8) {
+ flags |= padadd_UTF8_NAME;
+ SvUTF8_on(namesv);
+ }
+ else
+ flags &= ~padadd_UTF8_NAME;
+
if ((flags & padadd_NO_DUP_CHECK) == 0) {
/* check for duplicate declaration */
pad_check_dup(namesv, flags & padadd_OUR, ourstash);
}
- offset = pad_alloc_name(namesv, flags, typestash, ourstash);
+ offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
/* not yet introduced */
COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
PADOFFSET
Perl_pad_add_name_pv(pTHX_ const char *name,
- U32 flags, HV *typestash, HV *ourstash)
+ const U32 flags, HV *typestash, HV *ourstash)
{
PERL_ARGS_ASSERT_PAD_ADD_NAME_PV;
return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash);
STRLEN namelen;
PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
namepv = SvPV(name, namelen);
+ if (SvUTF8(name))
+ flags |= padadd_UTF8_NAME;
return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
}
/* XXX DAPM integrate alloc(), add_name() and add_anon(),
* or at least rationalise ??? */
-/* And flag whether the incoming name is UTF8 or 8 bit?
- Could do this either with the +ve/-ve hack of the HV code, or expanding
- the flag bits. Either way, this makes proper Unicode safe pad support.
- NWC
-*/
PADOFFSET
Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
ASSERT_CURPAD_ACTIVE("pad_alloc");
if (AvARRAY(PL_comppad) != PL_curpad)
- Perl_croak(aTHX_ "panic: pad_alloc");
+ Perl_croak(aTHX_ "panic: pad_alloc, %p!=%p",
+ AvARRAY(PL_comppad), PL_curpad);
if (PL_pad_reset_pending)
pad_reset();
if (tmptype & SVs_PADMY) {
ix = pad_alloc(optype, SVs_PADMY);
av_store(PL_comppad_name, ix, name);
/* XXX DAPM use PL_curpad[] ? */
- av_store(PL_comppad, ix, (SV*)func);
+ if (SvTYPE(func) == SVt_PVCV || !CvOUTSIDE(func))
+ av_store(PL_comppad, ix, (SV*)func);
+ else {
+ SV *rv = newRV_inc((SV *)func);
+ sv_rvweaken(rv);
+ assert (SvTYPE(func) == SVt_PVFM);
+ av_store(PL_comppad, ix, rv);
+ }
SvPADMY_on((SV*)func);
/* to avoid ref loops, we never have parent + child referencing each
* other simultaneously */
- if (CvOUTSIDE(func)) {
+ if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
assert(!CvWEAKOUTSIDE(func));
CvWEAKOUTSIDE_on(func);
SvREFCNT_dec(CvOUTSIDE(func));
}
/*
-=for apidoc m|pad_check_dup|SV *name|U32 flags|const HV *ourstash
+=for apidoc pad_check_dup
Check for duplicate declarations: report any of:
+
* a my in the current scope with the same name;
- * an our (anywhere in the pad) with the same name and the same stash
- as C<ourstash>
-C<is_our> indicates that the name to check is an 'our' declaration
+ * an our (anywhere in the pad) with the same name and the
+ same stash as C<ourstash>
+
+C<is_our> indicates that the name to check is an 'our' declaration.
=cut
*/
pad_peg("pad_findmy_pvn");
- if (flags)
+ if (flags & ~padadd_UTF8_NAME)
Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
(UV)flags);
+ if (flags & padadd_UTF8_NAME) {
+ bool is_utf8 = TRUE;
+ namepv = (const char*)bytes_from_utf8((U8*)namepv, &namelen, &is_utf8);
+
+ if (is_utf8)
+ flags |= padadd_UTF8_NAME;
+ else
+ flags &= ~padadd_UTF8_NAME;
+ }
+
offset = pad_findlex(namepv, namelen, flags,
PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags);
if ((PADOFFSET)offset != NOT_IN_PAD)
&& !SvFAKE(namesv)
&& (SvPAD_OUR(namesv))
&& SvCUR(namesv) == namelen
- && memEQ(SvPVX_const(namesv), namepv, namelen)
+ && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
+ flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
&& COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
)
return offset;
STRLEN namelen;
PERL_ARGS_ASSERT_PAD_FINDMY_SV;
namepv = SvPV(name, namelen);
+ if (SvUTF8(name))
+ flags |= padadd_UTF8_NAME;
return pad_findmy_pvn(namepv, namelen, flags);
}
return PAD_SVl(po);
}
+SV *
+Perl_find_rundefsv2(pTHX_ CV *cv, U32 seq)
+{
+ SV *namesv;
+ int flags;
+ PADOFFSET po;
+
+ PERL_ARGS_ASSERT_FIND_RUNDEFSV2;
+
+ po = pad_findlex("$_", 2, 0, cv, seq, 1,
+ NULL, &namesv, &flags);
+
+ if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
+ return DEFSV;
+
+ return AvARRAY((PAD*) (AvARRAY(CvPADLIST(cv))[CvDEPTH(cv)]))[po];
+}
+
/*
=for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32 flags|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int *out_flags
PERL_ARGS_ASSERT_PAD_FINDLEX;
+ if (flags & ~padadd_UTF8_NAME)
+ Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf,
+ (UV)flags);
+
*out_flags = 0;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
- PTR2UV(cv), namelen, namepv, (int)seq,
+ PTR2UV(cv), (int)namelen, namepv, (int)seq,
out_capture ? " capturing" : "" ));
/* first, search this pad */
const SV * const namesv = name_svp[offset];
if (namesv && namesv != &PL_sv_undef
&& SvCUR(namesv) == namelen
- && memEQ(SvPVX_const(namesv), namepv, namelen))
+ && sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
+ flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
{
if (SvFAKE(namesv)) {
fake_offset = offset; /* in case we don't find a real one */
{
if (warn)
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%.*s\" is not available",
- namelen, namepv);
+ "Variable \"%"SVf"\" is not available",
+ newSVpvn_flags(namepv, namelen,
+ SVs_TEMP |
+ (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
+
*out_capture = NULL;
}
&& warn && ckWARN(WARN_CLOSURE)) {
newwarn = 0;
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%.*s\" will not stay shared",
- namelen, namepv);
+ "Variable \"%"SVf"\" will not stay shared",
+ newSVpvn_flags(namepv, namelen,
+ SVs_TEMP |
+ (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
}
if (fake_offset && CvANON(cv)
&& !SvPAD_STATE(name_svp[offset]))
{
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%.*s\" is not available",
- namelen, namepv);
+ "Variable \"%"SVf"\" is not available",
+ newSVpvn_flags(namepv, namelen,
+ SVs_TEMP |
+ (flags & padadd_UTF8_NAME ? SVf_UTF8 : 0)));
*out_capture = NULL;
}
}
/*
=for apidoc m|U32|intro_my
-"Introduce" my variables to visible status.
+"Introduce" my variables to visible status. This is called during parsing
+at the end of each statement to make lexical variables visible to
+subsequent statements.
=cut
*/
if (!PL_curpad)
return;
if (AvARRAY(PL_comppad) != PL_curpad)
- Perl_croak(aTHX_ "panic: pad_swipe curpad");
- if (!po)
- Perl_croak(aTHX_ "panic: pad_swipe po");
+ Perl_croak(aTHX_ "panic: pad_swipe curpad, %p!=%p",
+ AvARRAY(PL_comppad), PL_curpad);
+ if (!po || ((SSize_t)po) > AvFILLp(PL_comppad))
+ Perl_croak(aTHX_ "panic: pad_swipe po=%ld, fill=%ld",
+ (long)po, (long)AvFILLp(PL_comppad));
DEBUG_X(PerlIO_printf(Perl_debug_log,
"Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
dVAR;
#ifdef USE_BROKEN_PAD_RESET
if (AvARRAY(PL_comppad) != PL_curpad)
- Perl_croak(aTHX_ "panic: pad_reset curpad");
+ Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p",
+ AvARRAY(PL_comppad), PL_curpad);
DEBUG_X(PerlIO_printf(Perl_debug_log,
"Pad 0x%"UVxf"[0x%"UVxf"] reset: padix %ld -> %ld",
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
CvCLONE_on(cv);
+ CvHASEVAL_on(cv);
}
}
}
if (!PL_curpad)
return;
if (AvARRAY(PL_comppad) != PL_curpad)
- Perl_croak(aTHX_ "panic: pad_free curpad");
+ Perl_croak(aTHX_ "panic: pad_free curpad, %p!=%p",
+ AvARRAY(PL_comppad), PL_curpad);
if (!po)
Perl_croak(aTHX_ "panic: pad_free po");
);
if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
- SvPADTMP_off(PL_curpad[po]);
+ SvFLAGS(PL_curpad[po]) &= ~SVs_PADTMP; /* also clears SVs_PADSTALE */
}
if ((I32)po < PL_padix)
PL_padix = po - 1;
assert(!CvUNIQUE(proto));
- /* Since cloneable anon subs can be nested, CvOUTSIDE may point
+ /* Anonymous subs have a weak CvOUTSIDE pointer, so its value is not
+ * reliable. The currently-running sub is always the one we need to
+ * close over.
+ * Note that in general for formats, CvOUTSIDE != find_runcv.
+ * Since formats may be nested inside closures, CvOUTSIDE may point
* to a prototype; we instead want the cloned parent who called us.
- * Note that in general for formats, CvOUTSIDE != find_runcv */
+ */
- outside = CvOUTSIDE(proto);
- if (outside && CvCLONE(outside) && ! CvCLONED(outside))
+ if (SvTYPE(proto) == SVt_PVCV)
outside = find_runcv(NULL);
+ else {
+ outside = CvOUTSIDE(proto);
+ if (CvCLONE(outside) && ! CvCLONED(outside)) {
+ CV * const runcv = find_runcv_where(
+ FIND_RUNCV_root_eq, (void *)CvROOT(outside), NULL
+ );
+ if (runcv) outside = runcv;
+ }
+ }
depth = CvDEPTH(outside);
assert(depth || SvTYPE(proto) == SVt_PVFM);
if (!depth)
depth = 1;
- assert(CvPADLIST(outside));
+ assert(CvPADLIST(outside) || SvTYPE(proto) == SVt_PVFM);
ENTER;
SAVESPTR(PL_compcv);
cv = PL_compcv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
- CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC);
+ CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
+ |CVf_SLABBED);
CvCLONED_on(cv);
-#ifdef USE_ITHREADS
- CvFILE(cv) = CvISXSUB(proto) ? CvFILE(proto)
- : savepv(CvFILE(proto));
-#else
- CvFILE(cv) = CvFILE(proto);
-#endif
+ CvFILE(cv) = CvDYNFILE(proto) ? savepv(CvFILE(proto))
+ : CvFILE(proto);
CvGV_set(cv,CvGV(proto));
CvSTASH_set(cv, CvSTASH(proto));
OP_REFCNT_LOCK;
CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
OP_REFCNT_UNLOCK;
CvSTART(cv) = CvSTART(proto);
- CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
+ if (CvHASEVAL(cv))
+ CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
if (SvPOK(proto))
sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
+ if (SvMAGIC(proto))
+ mg_copy((SV *)proto, (SV *)cv, 0, 0);
CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
PL_curpad = AvARRAY(PL_comppad);
- outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
+ outpad = CvPADLIST(outside)
+ ? AvARRAY(AvARRAY(CvPADLIST(outside))[depth])
+ : NULL;
for (ix = fpad; ix > 0; ix--) {
SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
SV *sv = NULL;
if (namesv && namesv != &PL_sv_undef) { /* lexical */
if (SvFAKE(namesv)) { /* lexical from outside? */
- sv = outpad[PARENT_PAD_INDEX(namesv)];
- assert(sv);
- /* formats may have an inactive parent,
+ /* formats may have an inactive, or even undefined, parent,
while my $x if $false can leave an active var marked as
stale. And state vars are always available */
- if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
+ if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)])
+ || (SvPADSTALE(sv) && !SvPAD_STATE(namesv))) {
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" is not available", SvPVX_const(namesv));
+ "Variable \"%"SVf"\" is not available", namesv);
sv = NULL;
}
else
if (namesv && namesv != &PL_sv_undef
&& *SvPVX_const(namesv) == '&')
{
+ if (SvTYPE(curpad[ix]) == SVt_PVCV) {
CV * const innercv = MUTABLE_CV(curpad[ix]);
assert(CvWEAKOUTSIDE(innercv));
assert(CvOUTSIDE(innercv) == old_cv);
CvOUTSIDE(innercv) = new_cv;
+ }
+ else { /* format reference */
+ SV * const rv = curpad[ix];
+ CV *innercv;
+ if (!SvOK(rv)) continue;
+ assert(SvROK(rv));
+ assert(SvWEAKREF(rv));
+ innercv = (CV *)SvRV(rv);
+ assert(!CvWEAKOUTSIDE(innercv));
+ SvREFCNT_dec(CvOUTSIDE(innercv));
+ CvOUTSIDE(innercv) = (CV *)SvREFCNT_inc_simple_NN(new_cv);
+ }
}
}
}
if (!srcpad)
return NULL;
- assert(!AvREAL(srcpad));
-
if (param->flags & CLONEf_COPY_STACKS
|| SvREFCNT(AvARRAY(srcpad)[1]) > 1) {
- /* XXX padlists are real, but pretend to be not */
- AvREAL_on(srcpad);
dstpad = av_dup_inc(srcpad, param);
- AvREAL_off(srcpad);
- AvREAL_off(dstpad);
assert (SvREFCNT(AvARRAY(srcpad)[1]) == 1);
} else {
/* CvDEPTH() on our subroutine will be set to 0, so there's no need
SV **names;
SV **pad1a;
AV *args;
- /* look for it in the table first.
- I *think* that it shouldn't be possible to find it there.
- Well, except for how Perl_sv_compile_2op() "works" :-( */
+ /* Look for it in the table first, as the padlist may have ended up
+ as an element of @DB::args (or theoretically even @_), so it may
+ may have been cloned already. */
dstpad = (AV*)ptr_table_fetch(PL_ptr_table, srcpad);
if (dstpad)
- return dstpad;
+ return (AV *)SvREFCNT_inc_simple_NN(dstpad);
dstpad = newAV();
ptr_table_store(PL_ptr_table, srcpad, dstpad);
- AvREAL_off(dstpad);
av_extend(dstpad, 1);
AvARRAY(dstpad)[0] = MUTABLE_SV(av_dup_inc(AvARRAY(srcpad)[0], param));
names = AvARRAY(AvARRAY(dstpad)[0]);
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff