char *s;
s = SvPV(TOPs,len);
sv_setpvn(TARG,s,len);
- if (SvUTF8(TOPs) && !IN_BYTE)
+ if (SvUTF8(TOPs))
SvUTF8_on(TARG);
+ else
+ SvUTF8_off(TARG);
SETTARG;
RETURN;
}
djSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
{
dPOPTOPssrl;
- STRLEN len, llen, rlen;
- U8 *s, *l, *r;
- bool left_utf8;
- bool right_utf8;
-
- r = (U8*)SvPV(right,rlen);
+ SV* rcopy = Nullsv;
- if (TARG != left)
- l = (U8*)SvPV(left,llen);
- else if (SvGMAGICAL(left))
+ if (SvGMAGICAL(left))
mg_get(left);
+ if (TARG == right && SvGMAGICAL(right))
+ mg_get(right);
- left_utf8 = DO_UTF8(left);
- right_utf8 = DO_UTF8(right);
+ if (TARG == right && left != right)
+ /* Clone since otherwise we cannot prepend. */
+ rcopy = sv_2mortal(newSVsv(right));
- if (!left_utf8 && !right_utf8 && SvUTF8(TARG)) {
- SvUTF8_off(TARG);
- }
+ if (TARG != left)
+ sv_setsv(TARG, left);
- if (left_utf8 != right_utf8 && !IN_BYTE) {
- if (TARG == right && !right_utf8) {
- sv_utf8_upgrade(TARG); /* Now straight binary copy */
- SvUTF8_on(TARG);
- }
- else {
- /* Set TARG to PV(left), then add right */
- U8 *c, *olds = NULL;
- STRLEN targlen;
- s = r; len = rlen;
- if (TARG == right) {
- /* Take a copy since we're about to overwrite TARG */
- olds = s = (U8*)savepvn((char*)s, len);
- }
- if (!SvOK(left) && SvTYPE(left) <= SVt_PVMG) {
- if (SvREADONLY(left))
- left = sv_2mortal(newSVsv(left));
- else
- sv_setpv(left, ""); /* Suppress warning. */
- }
- if (TARG != left)
- sv_setpvn(TARG, (char*)l, llen);
- if (!left_utf8) {
- SvUTF8_off(TARG);
- sv_utf8_upgrade(TARG);
- }
- /* Extend TARG to length of right (s) */
- targlen = SvCUR(TARG) + len;
- if (!right_utf8) {
- /* plus one for each hi-byte char if we have to upgrade */
- for (c = s; c < s + len; c++) {
- if (UTF8_IS_CONTINUED(*c))
- targlen++;
- }
- }
- SvGROW(TARG, targlen+1);
- /* And now copy, maybe upgrading right to UTF8 on the fly */
- if (right_utf8)
- Copy(s, SvEND(TARG), len, U8);
- else {
- for (c = (U8*)SvEND(TARG); len--; s++)
- c = uv_to_utf8(c, *s);
- }
- SvCUR_set(TARG, targlen);
- *SvEND(TARG) = '\0';
- SvUTF8_on(TARG);
- SETs(TARG);
- Safefree(olds);
- RETURN;
- }
- }
-
- if (TARG != left) {
- if (TARG == right) {
- sv_insert(TARG, 0, 0, (char*)l, llen);
- SETs(TARG);
- RETURN;
+ if (TARG == right) {
+ if (left == right) {
+ /* $right = $right . $right; */
+ STRLEN rlen;
+ char *rpv = SvPV(right, rlen);
+
+ sv_catpvn(TARG, rpv, rlen);
}
- sv_setpvn(TARG, (char *)l, llen);
+ else /* $right = $left . $right; */
+ sv_catsv(TARG, rcopy);
+ }
+ else {
+ if (!SvOK(TARG)) /* Avoid warning when concatenating to undef. */
+ sv_setpv(TARG, "");
+ /* $other = $left . $right; */
+ /* $left = $left . $right; */
+ sv_catsv(TARG, right);
}
- else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG)
- sv_setpv(TARG, ""); /* Suppress warning. */
- s = r; len = rlen;
- if (SvOK(TARG)) {
+
#if defined(PERL_Y2KWARN)
- if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) {
- STRLEN n;
- char *s = SvPV(TARG,n);
- if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
- && (n == 2 || !isDIGIT(s[n-3])))
- {
- Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
- "about to append an integer to '19'");
- }
+ if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) {
+ STRLEN n;
+ char *s = SvPV(TARG,n);
+ if (n >= 2 && s[n-2] == '1' && s[n-1] == '9'
+ && (n == 2 || !isDIGIT(s[n-3])))
+ {
+ Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s",
+ "about to append an integer to '19'");
}
-#endif
- sv_catpvn(TARG, (char *)s, len);
}
- else
- sv_setpvn(TARG, (char *)s, len); /* suppress warning */
- if (left_utf8 && !IN_BYTE)
- SvUTF8_on(TARG);
+#endif
+
SETTARG;
RETURN;
}
SETs((SV*)av);
RETURN;
}
+ else if (LVRET) {
+ if (GIMME == G_SCALAR)
+ Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
+ SETs((SV*)av);
+ RETURN;
+ }
}
else {
if (SvTYPE(sv) == SVt_PVAV) {
SETs((SV*)av);
RETURN;
}
+ else if (LVRET) {
+ if (GIMME == G_SCALAR)
+ Perl_croak(aTHX_ "Can't return array to lvalue"
+ " scalar context");
+ SETs((SV*)av);
+ RETURN;
+ }
}
else {
GV *gv;
SETs((SV*)av);
RETURN;
}
+ else if (LVRET) {
+ if (GIMME == G_SCALAR)
+ Perl_croak(aTHX_ "Can't return array to lvalue"
+ " scalar context");
+ SETs((SV*)av);
+ RETURN;
+ }
}
}
SETs((SV*)hv);
RETURN;
}
+ else if (LVRET) {
+ if (GIMME == G_SCALAR)
+ Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
+ SETs((SV*)hv);
+ RETURN;
+ }
}
else {
if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) {
SETs((SV*)hv);
RETURN;
}
+ else if (LVRET) {
+ if (GIMME == G_SCALAR)
+ Perl_croak(aTHX_ "Can't return hash to lvalue"
+ " scalar context");
+ SETs((SV*)hv);
+ RETURN;
+ }
}
else {
GV *gv;
SETs((SV*)hv);
RETURN;
}
+ else if (LVRET) {
+ if (GIMME == G_SCALAR)
+ Perl_croak(aTHX_ "Can't return hash to lvalue"
+ " scalar context");
+ SETs((SV*)hv);
+ RETURN;
+ }
}
}
SV **svp;
SV *keysv = POPs;
HV *hv = (HV*)POPs;
- U32 lval = PL_op->op_flags & OPf_MOD;
+ U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
if (!preeminent) {
STRLEN keylen;
char *key = SvPV(keysv, keylen);
- save_delete(hv, key, keylen);
+ SAVEDELETE(hv, savepvn(key,keylen), keylen);
} else
save_helem(hv, keysv, svp);
}
SV* elemsv = POPs;
IV elem = SvIV(elemsv);
AV* av = (AV*)POPs;
- U32 lval = PL_op->op_flags & OPf_MOD;
+ U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
SV *sv;
!(ob=(SV*)GvIO(iogv)))
{
if (!packname ||
- ((*(U8*)packname >= 0xc0 && DO_UTF8(sv))
+ ((UTF8_IS_START(*packname) && DO_UTF8(sv))
? !isIDFIRST_utf8((U8*)packname)
: !isIDFIRST(*packname)
))
projects / p5sagit/p5-mst-13.2.git / blobdiff