STRLEN cur1 = SvCUR(sv);
const char *pv2 = pv;
STRLEN cur2 = pvlen;
- if (PL_encoding) {
+ if (IN_ENCODING) {
SV* svrecode = NULL;
if (SvUTF8(sv)) {
svrecode = newSVpvn(pv2, cur2);
- sv_recode_to_utf8(svrecode, PL_encoding);
+ sv_recode_to_utf8(svrecode, _get_encoding());
pv2 = SvPV_const(svrecode, cur2);
}
else {
svrecode = newSVpvn(pv1, cur1);
- sv_recode_to_utf8(svrecode, PL_encoding);
+ sv_recode_to_utf8(svrecode, _get_encoding());
pv1 = SvPV_const(svrecode, cur1);
}
SvREFCNT_dec_NN(svrecode);
#ifdef DEBUGGING
void
-Perl_set_padlist(pTHX_ CV * cv, PADLIST *padlist){
+Perl_set_padlist(CV * cv, PADLIST *padlist){
PERL_ARGS_ASSERT_SET_PADLIST;
# if PTRSIZE == 8
if((Size_t)padlist == UINT64_C(0xEFEFEFEFEFEFEFEF)){
fake_offset = offset; /* in case we don't find a real one */
continue;
}
- /* is seq within the range _LOW to _HIGH ?
- * This is complicated by the fact that PL_cop_seqmax
- * may have wrapped around at some point */
- if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
- continue; /* not yet introduced */
-
- if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
- /* in compiling scope */
- if (
- (seq > COP_SEQ_RANGE_LOW(namesv))
- ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
- : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
- )
- break;
- }
- else if (
- (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
- ?
- ( seq > COP_SEQ_RANGE_LOW(namesv)
- || seq <= COP_SEQ_RANGE_HIGH(namesv))
-
- : ( seq > COP_SEQ_RANGE_LOW(namesv)
- && seq <= COP_SEQ_RANGE_HIGH(namesv))
- )
- break;
+ if (PadnameIN_SCOPE(namesv, seq))
+ break;
}
}
);
}
}
- PL_cop_seqmax++;
- if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
- PL_cop_seqmax++;
+ COP_SEQMAX_INC;
PL_min_intro_pending = 0;
PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
}
}
}
- PL_cop_seqmax++;
- if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
- PL_cop_seqmax++;
+ COP_SEQMAX_INC;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
return o;
CvNAME_HEK_set(
sv,
share_hek(SvPVX_const(namesv)+1,
- SvCUR(namesv) - 1
+ (SvCUR(namesv) - 1)
* (SvUTF8(namesv) ? -1 : 1),
hash)
);
* so try to grab the current const value, and if successful,
* turn into a const sub:
*/
- SV* const const_sv = op_const_sv(CvSTART(cv), cv, outside, TRUE);
+ SV* const_sv;
+ OP *o = CvSTART(cv);
assert(newcv);
- if (const_sv) {
+ for (; o; o = o->op_next)
+ if (o->op_type == OP_PADSV)
+ break;
+ ASSUME(o->op_type == OP_PADSV);
+ const_sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
+ /* the candidate should have 1 ref from this pad and 1 ref
+ * from the parent */
+ if (const_sv && SvREFCNT(const_sv) == 2) {
const bool was_method = cBOOL(CvMETHOD(cv));
+ bool copied = FALSE;
+ if (outside) {
+ PADNAME * const pn =
+ PadlistNAMESARRAY(CvPADLIST(outside))
+ [PARENT_PAD_INDEX(PadlistNAMESARRAY(
+ CvPADLIST(cv))[o->op_targ])];
+ assert(PadnameOUTER(PadlistNAMESARRAY(CvPADLIST(cv))
+ [o->op_targ]));
+ if (PadnameLVALUE(pn)) {
+ /* We have a lexical that is potentially modifiable
+ elsewhere, so making a constant will break clo-
+ sure behaviour. If this is a ‘simple lexical
+ op tree’, i.e., sub(){$x}, emit a deprecation
+ warning, but continue to exhibit the old behav-
+ iour of making it a constant based on the ref-
+ count of the candidate variable.
+
+ A simple lexical op tree looks like this:
+
+ leavesub
+ lineseq
+ nextstate
+ padsv
+ */
+ if (OP_SIBLING(
+ cUNOPx(cUNOPx(CvROOT(cv))->op_first)->op_first
+ ) == o
+ && !OP_SIBLING(o))
+ {
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_DEPRECATED),
+ "Constants from lexical "
+ "variables potentially "
+ "modified elsewhere are "
+ "deprecated");
+ /* We *copy* the lexical variable, and donate the
+ copy to newCONSTSUB. Yes, this is ugly, and
+ should be killed. We need to do this for the
+ time being, however, because turning on SvPADTMP
+ on a lexical will have observable effects
+ elsewhere. */
+ const_sv = newSVsv(const_sv);
+ copied = TRUE;
+ }
+ else
+ goto constoff;
+ }
+ }
+ if (!copied)
+ SvREFCNT_inc_simple_void_NN(const_sv);
+ /* If the lexical is not used elsewhere, it is safe to turn on
+ SvPADTMP, since it is only when it is used in lvalue con-
+ text that the difference is observable. */
+ SvREADONLY_on(const_sv);
+ SvPADTMP_on(const_sv);
SvREFCNT_dec_NN(cv);
- /* For this calling case, op_const_sv returns a *copy*, which
- we donate to newCONSTSUB. Yes, this is ugly, and should be
- killed. We need to fix how we decide whether this optimisa-
- tion is possible to eliminate this. */
cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
if (was_method)
CvMETHOD_on(cv);
}
else {
+ constoff:
CvCONST_off(cv);
}
}