dSP;
PADOFFSET base = PL_op->op_targ;
int count = (int)(PL_op->op_private) & OPpPADRANGE_COUNTMASK;
- int i;
if (PL_op->op_flags & OPf_SPECIAL) {
/* fake the RHS of my ($x,$y,..) = @_ */
PUSHMARK(SP);
/* note, this is only skipped for compile-time-known void cxt */
if ((PL_op->op_flags & OPf_WANT) != OPf_WANT_VOID) {
+ int i;
+
EXTEND(SP, count);
PUSHMARK(SP);
for (i = 0; i <count; i++)
(base << (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT))
| (count << SAVE_TIGHT_SHIFT)
| SAVEt_CLEARPADRANGE);
+ int i;
+
STATIC_ASSERT_STMT(OPpPADRANGE_COUNTMASK + 1 == (1 << OPpPADRANGE_COUNTSHIFT));
assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
== (Size_t)base);
|| ( PL_op->op_private & OPpMAYBE_TRUEBOOL
&& block_gimme() == G_VOID ))
&& (!SvRMAGICAL(sv) || !mg_find(sv, PERL_MAGIC_tied)))
- SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
+ SETs(HvUSEDKEYS(MUTABLE_HV(sv)) ? &PL_sv_yes : &PL_sv_no);
else if (gimme == G_SCALAR) {
dTARG;
TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv));
lcount = -1;
lelem--; /* no need to unmark this element */
}
- else if (!(do_rc1 && SvREFCNT(svl) == 1) && svl != &PL_sv_undef) {
- assert(!SvIMMORTAL(svl));
+ else if (!(do_rc1 && SvREFCNT(svl) == 1) && !SvIMMORTAL(svl)) {
SvFLAGS(svl) |= SVf_BREAK;
marked = TRUE;
}
assert(svr);
if (UNLIKELY(SvFLAGS(svr) & (SVf_BREAK|SVs_GMG) || copy_all)) {
+ U32 brk = (SvFLAGS(svr) & SVf_BREAK);
#ifdef DEBUGGING
if (fake) {
/* ... but restore afterwards in case it's needed again,
* e.g. ($a,$b,$c) = (1,$a,$a)
*/
- SvFLAGS(svr) |= SVf_BREAK;
+ SvFLAGS(svr) |= brk;
}
if (!lcount)
bool alias = FALSE;
SV *lsv = *lelem++;
+ TAINT_NOT; /* Each item stands on its own, taintwise. */
+
assert(relem <= lastrelem);
if (UNLIKELY(!lsv)) {
alias = TRUE;
tmps_base -= nelems;
- if (SvRMAGICAL(ary) || SvREADONLY(ary) || !AvREAL(ary)) {
+ if (SvMAGICAL(ary) || SvREADONLY(ary) || !AvREAL(ary)) {
/* for arrays we can't cheat with, use the official API */
av_extend(ary, nelems - 1);
for (i = 0; i < nelems; i++) {
default:
if (!SvIMMORTAL(lsv)) {
+ SV *ref;
+
if (UNLIKELY(
SvTEMP(lsv) && !SvSMAGICAL(lsv) && SvREFCNT(lsv) == 1 &&
(!isGV_with_GP(lsv) || SvFAKE(lsv)) && ckWARN(WARN_MISC)
packWARN(WARN_MISC),
"Useless assignment to a temporary"
);
+
+ /* avoid freeing $$lsv if it might be needed for further
+ * elements, e.g. ($ref, $foo) = (1, $$ref) */
+ if ( SvROK(lsv)
+ && ( ((ref = SvRV(lsv)), SvREFCNT(ref)) == 1)
+ && lelem <= lastlelem
+ ) {
+ SSize_t ix;
+ SvREFCNT_inc_simple_void_NN(ref);
+ /* an unrolled sv_2mortal */
+ ix = ++PL_tmps_ix;
+ if (UNLIKELY(ix >= PL_tmps_max))
+ /* speculatively grow enough to cover other
+ * possible refs */
+ ix = tmps_grow_p(ix + (lastlelem - lelem));
+ PL_tmps_stack[ix] = ref;
+ }
+
sv_setsv(lsv, *relem);
*relem = lsv;
SvSETMAGIC(lsv);
/* simplified lelem loop for when there are no relems left */
while (LIKELY(lelem <= lastlelem)) {
SV *lsv = *lelem++;
+
+ TAINT_NOT; /* Each item stands on its own, taintwise. */
+
if (UNLIKELY(!lsv)) {
lsv = *lelem++;
ASSUME(SvTYPE(lsv) == SVt_PVAV);
default:
if (!SvIMMORTAL(lsv)) {
- sv_setsv(lsv, &PL_sv_undef);
+ sv_set_undef(lsv);
SvSETMAGIC(lsv);
*relem++ = lsv;
}
} /* switch */
} /* while */
+ TAINT_NOT; /* result of list assign isn't tainted */
+
if (UNLIKELY(PL_delaymagic & ~DM_DELAY)) {
/* Will be used to set PL_tainting below */
Uid_t tmp_uid = PerlProc_getuid();
if (RX_MINLEN(rx) >= 0 && (STRLEN)RX_MINLEN(rx) > len) {
DEBUG_r(PerlIO_printf(Perl_debug_log, "String shorter than min possible regex match (%"
- UVuf" < %"IVdf")\n",
+ UVuf " < %" IVdf ")\n",
(UV)len, (IV)RX_MINLEN(rx)));
goto nope;
}
if (UNLIKELY(RX_OFFS(rx)[i].end < 0 || RX_OFFS(rx)[i].start < 0
|| len < 0 || len > strend - s))
DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, "
- "start=%ld, end=%ld, s=%p, strend=%p, len=%"UVuf,
+ "start=%ld, end=%ld, s=%p, strend=%p, len=%" UVuf,
(long) i, (long) RX_OFFS(rx)[i].start,
(long)RX_OFFS(rx)[i].end, s, strend, (UV) len);
sv_setpvn(*SP, s, len);
if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv)
&& ckWARN(WARN_MISC)))
Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Use of reference \"%"SVf"\" as array index",
+ "Use of reference \"%" SVf "\" as array index",
SVfARG(elemsv));
/* the only time that S_find_uninit_var() needs this
* is to determine which index value triggered the
It has SvPVX of "" and SvCUR of 0, which is what we want. */
STRLEN maxlen = 0;
const char *max = SvPV_const(end, maxlen);
+ if (DO_UTF8(end) && IN_UNI_8_BIT)
+ maxlen = sv_len_utf8_nomg(end);
if (UNLIKELY(SvNIOK(cur) || SvCUR(cur) > maxlen))
goto retno;
/* anonymous or undef'd function leaves us no recourse */
if (CvLEXICAL(cv) && CvHASGV(cv))
- DIE(aTHX_ "Undefined subroutine &%"SVf" called",
+ DIE(aTHX_ "Undefined subroutine &%" SVf " called",
SVfARG(cv_name(cv, NULL, 0)));
if (CvANON(cv) || !CvHASGV(cv)) {
DIE(aTHX_ "Undefined subroutine called");
if (!cv) {
sub_name = sv_newmortal();
gv_efullname3(sub_name, gv, NULL);
- DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
+ DIE(aTHX_ "Undefined subroutine &%" SVf " called", SVfARG(sub_name));
}
}
items = SP - MARK;
if (UNLIKELY(items - 1 > AvMAX(av))) {
SV **ary = AvALLOC(av);
- AvMAX(av) = items - 1;
Renew(ary, items, SV*);
+ AvMAX(av) = items - 1;
AvALLOC(av) = ary;
AvARRAY(av) = ary;
}
}
if (UNLIKELY((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
!CvLVALUE(cv)))
- DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%"SVf,
+ DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%" SVf,
SVfARG(cv_name(cv, NULL, 0)));
/* warning must come *after* we fully set up the context
* stuff so that __WARN__ handlers can safely dounwind()
& CX_PUSHSUB_GET_LVALUE_MASK(Perl_is_lvalue_sub)
) & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
!CvLVALUE(cv)))
- DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%"SVf,
+ DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%" SVf,
SVfARG(cv_name(cv, NULL, 0)));
if (UNLIKELY(!(PL_op->op_flags & OPf_STACKED) && GvAV(PL_defgv))) {
if (CvANON(cv))
Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
else {
- Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
+ Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%" SVf "\"",
SVfARG(cv_name(cv,NULL,0)));
}
}
if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)))
Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Use of reference \"%"SVf"\" as array index",
+ "Use of reference \"%" SVf "\" as array index",
SVfARG(elemsv));
if (UNLIKELY(SvTYPE(av) != SVt_PVAV))
RETPUSHUNDEF;
return sv;
}
+extern char PL_isa_DOES[];
+
PERL_STATIC_INLINE HV *
S_opmethod_stash(pTHX_ SV* meth)
{
HV* stash;
SV* const sv = PL_stack_base + TOPMARK == PL_stack_sp
- ? (Perl_croak(aTHX_ "Can't call method \"%"SVf"\" without a "
+ ? (Perl_croak(aTHX_ "Can't call method \"%" SVf "\" without a "
"package or object reference", SVfARG(meth)),
(SV *)NULL)
: *(PL_stack_base + TOPMARK + 1);
if (UNLIKELY(!sv))
undefined:
- Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on an undefined value",
+ Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on an undefined value",
SVfARG(meth));
if (UNLIKELY(SvGMAGICAL(sv))) mg_get(sv);
else if (!SvOK(sv)) goto undefined;
else if (isGV_with_GP(sv)) {
if (!GvIO(sv))
- Perl_croak(aTHX_ "Can't call method \"%"SVf"\" "
+ Perl_croak(aTHX_ "Can't call method \"%" SVf "\" "
"without a package or object reference",
SVfARG(meth));
ob = sv;
/* this isn't the name of a filehandle either */
if (!packlen)
{
- Perl_croak(aTHX_ "Can't call method \"%"SVf"\" "
+ Perl_croak(aTHX_ "Can't call method \"%" SVf "\" "
"without a package or object reference",
SVfARG(meth));
}
&& (ob = MUTABLE_SV(GvIO((const GV *)ob)))
&& SvOBJECT(ob))))
{
- Perl_croak(aTHX_ "Can't call method \"%"SVf"\" on unblessed reference",
- SVfARG((SvSCREAM(meth) && strEQ(SvPV_nolen_const(meth),"isa"))
+ Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on unblessed reference",
+ SVfARG((SvPOK(meth) && SvPVX(meth) == PL_isa_DOES)
? newSVpvs_flags("DOES", SVs_TEMP)
: meth));
}
https://perl5.git.perl.org / perl5.git / blobdiff