/* pp_hot.c
*
- * Copyright (c) 1991-2002, Larry Wall
+ * Copyright (c) 1991-2003, Larry Wall
*
* 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) {
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 (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);
+ 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);
+ SvOK_off(TARG);
+ }
SPAGAIN;
PUSHTARG;
}
#ifdef PERL_COPY_ON_WRITE
bool is_cow;
#endif
+ SV *nsv = Nullsv;
/* known replacement string? */
dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
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))
{
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);
}
PUTBACK;
+ LEAVE;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVE;
LEAVESUB(sv);
return pop_return();
}
* the refcounts so the caller gets a live guy. Cannot set
* TEMP, so sv_2mortal is out of question. */
if (!CvLVALUE(cx->blk_sub.cv)) {
+ LEAVE;
POPSUB(cx,sv);
PL_curpm = newpm;
- LEAVE;
LEAVESUB(sv);
DIE(aTHX_ "Can't modify non-lvalue subroutine call");
}
EXTEND_MORTAL(1);
if (MARK == SP) {
if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
+ LEAVE;
POPSUB(cx,sv);
PL_curpm = newpm;
- LEAVE;
LEAVESUB(sv);
DIE(aTHX_ "Can't return %s from lvalue subroutine",
SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
}
}
else { /* Should not happen? */
+ LEAVE;
POPSUB(cx,sv);
PL_curpm = newpm;
- LEAVE;
LEAVESUB(sv);
DIE(aTHX_ "%s returned from lvalue subroutine in scalar context",
(MARK > SP ? "Empty array" : "Array"));
&& SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
/* Might be flattened array after $#array = */
PUTBACK;
+ LEAVE;
POPSUB(cx,sv);
PL_curpm = newpm;
- LEAVE;
LEAVESUB(sv);
DIE(aTHX_ "Can't return a %s from lvalue subroutine",
SvREADONLY(TOPs) ? "readonly value" : "temporary");
}
PUTBACK;
+ LEAVE;
POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
PL_curpm = newpm; /* ... and pop $1 et al */
- LEAVE;
LEAVESUB(sv);
return pop_return();
}