/* pp_hot.c
*
- * Copyright (c) 1991-2002, 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.
bool lbyte;
STRLEN rlen;
char* rpv = SvPV(right, rlen); /* mg_get(right) happens here */
- bool rbyte = !SvUTF8(right);
+ bool rbyte = !SvUTF8(right), rcopied = FALSE;
if (TARG == right && right != left) {
right = sv_2mortal(newSVpvn(rpv, rlen));
rpv = SvPV(right, rlen); /* no point setting UTF8 here */
+ rcopied = TRUE;
}
if (TARG != left) {
if (lbyte)
sv_utf8_upgrade_nomg(TARG);
else {
+ if (!rcopied)
+ right = sv_2mortal(newSVpvn(rpv, rlen));
sv_utf8_upgrade_nomg(right);
rpv = SvPV(right, rlen);
}
SETs((SV*)av);
RETURN;
}
+ else if (PL_op->op_flags & OPf_MOD
+ && PL_op->op_private & OPpLVAL_INTRO)
+ Perl_croak(aTHX_ PL_no_localize_ref);
}
else {
if (SvTYPE(sv) == SVt_PVAV) {
RETURN;
}
else if (LVRET) {
- if (GIMME == G_SCALAR)
+ if (GIMME != G_SCALAR)
Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
SETs((SV*)hv);
RETURN;
}
+ else if (PL_op->op_flags & OPf_MOD
+ && PL_op->op_private & OPpLVAL_INTRO)
+ Perl_croak(aTHX_ PL_no_localize_ref);
}
else {
if (SvTYPE(sv) == SVt_PVHV) {
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
- if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+ if ((pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
}
rx->startp[0] = s - truebase;
rx->endp[0] = s - truebase + rx->minlen;
}
- rx->nparens = rx->lastparen = 0; /* used by @- and @+ */
+ rx->nparens = rx->lastparen = rx->lastcloseparen = 0; /* used by @-, @+, and $^N */
LEAVE_SCOPE(oldsave);
RETPUSHYES;
}
if (gimme == G_SCALAR) {
/* undef TARG, and push that undefined value */
- SV_CHECK_THINKFIRST_COW_DROP(TARG);
- (void)SvOK_off(TARG);
+ if (type != OP_RCATLINE) {
+ SV_CHECK_THINKFIRST_COW_DROP(TARG);
+ (void)SvOK_off(TARG);
+ }
PUSHTARG;
}
RETURN;
sv_unref(sv);
(void)SvUPGRADE(sv, SVt_PV);
tmplen = SvLEN(sv); /* remember if already alloced */
- if (!tmplen)
+ if (!tmplen && !SvREADONLY(sv))
Sv_Grow(sv, 80); /* try short-buffering it */
offset = 0;
if (type == OP_RCATLINE && SvOK(sv)) {
}
}
if (gimme == G_SCALAR) {
- SV_CHECK_THINKFIRST_COW_DROP(TARG);
- (void)SvOK_off(TARG);
+ if (type != OP_RCATLINE) {
+ SV_CHECK_THINKFIRST_COW_DROP(TARG);
+ (void)SvOK_off(TARG);
+ }
SPAGAIN;
PUSHTARG;
}
else {
sv = AvARRAY(av)[++cx->blk_loop.iterix];
}
+ if (sv && SvREFCNT(sv) == 0) {
+ *itersvp = Nullsv;
+ Perl_croak(aTHX_
+ "Use of freed value in iteration (perhaps you modified the iterated array within the loop?)");
+ }
+
if (sv)
SvTEMP_off(sv);
else
#ifdef PERL_COPY_ON_WRITE
bool is_cow;
#endif
+ SV *nsv = Nullsv;
/* known replacement string? */
dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
? REXEC_COPY_STR : 0;
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
- if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+ if ((pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
}
if (dstr) {
/* replacement needing upgrading? */
if (DO_UTF8(TARG) && !doutf8) {
- SV *nsv = sv_newmortal();
+ nsv = sv_newmortal();
SvSetSV(nsv, dstr);
if (PL_encoding)
sv_recode_to_utf8(nsv, PL_encoding);
&& !is_cow
#endif
&& (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
- && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)) {
+ && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)
+ && (!doutf8 || SvUTF8(TARG))) {
if (!CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
r_flags | REXEC_CHECKED))
{
if (!c) {
register PERL_CONTEXT *cx;
SPAGAIN;
+ ReREFCNT_inc(rx);
PUSHSUBST(cx);
RETURNOP(cPMOP->op_pmreplroot);
}
strend = s + (strend - m);
}
m = rx->startp[0] + orig;
- sv_catpvn(dstr, s, m-s);
+ if (doutf8 && !SvUTF8(dstr))
+ sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
+ else
+ sv_catpvn(dstr, s, m-s);
s = rx->endp[0] + orig;
if (clen)
sv_catpvn(dstr, c, clen);
break;
} while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
TARG, NULL, r_flags));
- if (doutf8 && !DO_UTF8(dstr)) {
- SV* nsv = sv_2mortal(newSVpvn(s, strend - s));
-
- sv_utf8_upgrade(nsv);
- sv_catpvn(dstr, SvPVX(nsv), SvCUR(nsv));
- }
+ if (doutf8 && !DO_UTF8(TARG))
+ sv_catpvn_utf8_upgrade(dstr, s, strend - s, nsv);
else
sv_catpvn(dstr, s, strend - s);
gimme = GIMME_V;
if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
+ if (CvASSERTION(cv) && PL_DBassertion)
+ sv_setiv(PL_DBassertion, 1);
+
cv = get_db_sub(&sv, cv);
if (!cv)
DIE(aTHX_ "No DBsub routine");
/* this isn't a reference */
packname = Nullch;
+
+ if(SvOK(sv) && (packname = SvPV(sv, packlen))) {
+ HE* he;
+ he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
+ if (he) {
+ stash = INT2PTR(HV*,SvIV(HeVAL(he)));
+ goto fetch;
+ }
+ }
+
if (!SvOK(sv) ||
- !(packname = SvPV(sv, packlen)) ||
+ !(packname) ||
!(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
!(ob=(SV*)GvIO(iogv)))
{
stash = gv_stashpvn(packname, packlen, FALSE);
if (!stash)
packsv = sv;
+ else {
+ SV* ref = newSViv(PTR2IV(stash));
+ hv_store(PL_stashcache, packname, packlen, ref, 0);
+ }
goto fetch;
}
/* it _is_ a filehandle name -- replace with a reference */
/* the method name is unqualified or starts with SUPER:: */
packname = sep ? CopSTASHPV(PL_curcop) :
stash ? HvNAME(stash) : packname;
- packlen = strlen(packname);
+ if (!packname)
+ Perl_croak(aTHX_
+ "Can't use anonymous symbol table for method lookup");
+ else
+ packlen = strlen(packname);
}
else {
/* the method name is qualified */