X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=3f85116a31603439adf925248170de4de84966a7;hb=48f7ee7a00a9cc3c53df2208f08bd3848df9a5b5;hp=7d395141e89fa109a58826840309c1ad76c76349;hpb=01bb7c6d67bc951562ed98068eba189cadd42374;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 7d39514..3f85116 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -146,9 +146,17 @@ PP(pp_concat) dPOPTOPssrl; STRLEN len; U8 *s; - bool left_utf = DO_UTF8(left); - bool right_utf = DO_UTF8(right); + bool left_utf; + bool right_utf; + if (TARG == right && SvGMAGICAL(right)) + mg_get(right); + if (SvGMAGICAL(left)) + mg_get(left); + + left_utf = DO_UTF8(left); + right_utf = DO_UTF8(right); + if (left_utf != right_utf) { if (TARG == right && !right_utf) { sv_utf8_upgrade(TARG); /* Now straight binary copy */ @@ -159,15 +167,19 @@ PP(pp_concat) U8 *l, *c, *olds = NULL; STRLEN targlen; s = (U8*)SvPV(right,len); + right_utf |= DO_UTF8(right); if (TARG == right) { /* Take a copy since we're about to overwrite TARG */ olds = s = (U8*)savepvn((char*)s, len); } - if (SvGMAGICAL(left)) - mg_get(left); - else if (!SvOK(left) && SvTYPE(left) <= SVt_PVMG) - sv_setpv(left, ""); /* Suppress warning. */ + if (!SvOK(left) && SvTYPE(left) <= SVt_PVMG) { + if (SvREADONLY(left)) + left = sv_2mortal(newSVsv(left)); + else + sv_setpv(left, ""); /* Suppress warning. */ + } l = (U8*)SvPV(left, targlen); + left_utf |= DO_UTF8(left); if (TARG != left) sv_setpvn(TARG, (char*)l, targlen); if (!left_utf) @@ -207,8 +219,6 @@ PP(pp_concat) } sv_setpvn(TARG, (char *)s, len); } - else if (SvGMAGICAL(TARG)) - mg_get(TARG); else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) sv_setpv(TARG, ""); /* Suppress warning. */ s = (U8*)SvPV(right,len); @@ -1333,7 +1343,7 @@ Perl_do_readline(pTHX) } else { PerlIO_rewind(tmpfp); - IoTYPE(io) = '<'; + IoTYPE(io) = IoTYPE_RDONLY; IoIFP(io) = fp = tmpfp; IoFLAGS(io) &= ~IOf_UNTAINT; /* maybe redundant */ } @@ -1387,7 +1397,7 @@ Perl_do_readline(pTHX) else if (type == OP_GLOB) SP--; else if (ckWARN(WARN_IO) /* stdout/stderr or other write fh */ - && (IoTYPE(io) == '>' || fp == PerlIO_stdout() + && (IoTYPE(io) == IoTYPE_WRONLY || fp == PerlIO_stdout() || fp == PerlIO_stderr())) { /* integrate with report_evil_fh()? */ @@ -1406,7 +1416,8 @@ Perl_do_readline(pTHX) } } if (!fp) { - if (ckWARN2(WARN_GLOB,WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) { + if (ckWARN2(WARN_GLOB, WARN_CLOSED) + && (!io || !(IoFLAGS(io) & IOf_START))) { if (type == OP_GLOB) Perl_warner(aTHX_ WARN_GLOB, "glob failed (can't start child: %s)", @@ -2774,7 +2785,7 @@ PP(pp_aelem) { djSP; SV** svp; - I32 elem = POPi; + IV elem = POPi; AV* av = (AV*)POPs; U32 lval = PL_op->op_flags & OPf_MOD; U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));