X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=6df5420db7f5fbffb0bc39432488cd668bc920f5;hb=0df67ae6657908368da0106eaece7afb31cc07d7;hp=d2eef9b84ad22eac9119dcc93d078dc1ed00ce16;hpb=10c8fecdc2f0a2ef9c548abff5961fa25cd83eca;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_hot.c b/pp_hot.c
index d2eef9b..6df5420 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -107,7 +107,6 @@ PP(pp_and)
 PP(pp_sassign)
 {
     djSP; dPOPTOPssrl;
-    MAGIC *mg;
 
     if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
 	SV *temp;
@@ -147,6 +146,53 @@ PP(pp_concat)
     dPOPTOPssrl;
     STRLEN len;
     char *s;
+    bool left_utf = DO_UTF8(left);
+    bool right_utf = DO_UTF8(right);
+
+    if (left_utf != right_utf) {
+        if (TARG == right && !right_utf) {
+            sv_utf8_upgrade(TARG); /* Now straight binary copy */
+            SvUTF8_on(TARG);
+        }
+        else {
+            /* Set TARG to PV(left), then add right */
+            char *l, *c;
+            STRLEN targlen;
+            if (TARG == right)
+                /* Need a safe copy elsewhere since we're just about to
+                   write onto TARG */
+                s = strdup(SvPV(right,len));
+            else
+                s = SvPV(right,len);
+            l = SvPV(left, targlen);
+            if (TARG != left)
+                sv_setpvn(TARG,l,targlen);
+            if (!left_utf)
+                sv_utf8_upgrade(TARG);
+            /* Extend TARG to length of right (s) */
+            targlen = SvCUR(TARG) + len;
+            if (!right_utf) {
+                /* plus one for each hi-byte char if we have to upgrade */
+                for (c = s; *c; c++)  {
+                    if (*c & 0x80)
+                        targlen++;
+                }
+            }
+            SvGROW(TARG, targlen+1);
+            /* And now copy, maybe upgrading right to UTF8 on the fly */
+            for (c = SvEND(TARG); *s; s++) {
+                 if (*s & 0x80 && !right_utf)
+                     c = (char*)uv_to_utf8((U8*)c, *s);
+                 else
+                     *c++ = *s;
+            }
+            SvCUR_set(TARG, targlen);
+            *SvEND(TARG) = '\0';
+            SvUTF8_on(TARG);
+            SETs(TARG);
+            RETURN;
+        }
+    }
 
     if (TARG != left) {
 	s = SvPV(left,len);
@@ -159,10 +205,8 @@ PP(pp_concat)
     }
     else if (SvGMAGICAL(TARG))
 	mg_get(TARG);
-    else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) {
+    else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG)
 	sv_setpv(TARG, "");	/* Suppress warning. */
-	s = SvPV_force(TARG, len);
-    }
     s = SvPV(right,len);
     if (SvOK(TARG)) {
 #if defined(PERL_Y2KWARN)
@@ -177,19 +221,12 @@ PP(pp_concat)
 	    }
 	}
 #endif
-	if (DO_UTF8(right))
-	    sv_utf8_upgrade(TARG);
 	sv_catpvn(TARG,s,len);
-	if (!IN_BYTE) {
-	    if (SvUTF8(right))
-		SvUTF8_on(TARG);
-	}
-	else if (!SvUTF8(right)) {
-	    SvUTF8_off(TARG);
-	}
     }
     else
 	sv_setpvn(TARG,s,len);	/* suppress warning */
+    if (left_utf)
+	SvUTF8_on(TARG);
     SETTARG;
     RETURN;
   }
@@ -335,7 +372,7 @@ PP(pp_print)
 	gv = (GV*)*++MARK;
     else
 	gv = PL_defoutgv;
-    if (mg = SvTIED_mg((SV*)gv, 'q')) {
+    if ((mg = SvTIED_mg((SV*)gv, 'q'))) {
 	if (MARK == ORIGMARK) {
 	    /* If using default handle then we need to make space to 
 	     * pass object as 1st arg, so move other args up ...
@@ -456,7 +493,7 @@ PP(pp_rv2av)
 	    
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
-		STRLEN n_a;
+		STRLEN len;
 
 		if (SvGMAGICAL(sv)) {
 		    mg_get(sv);
@@ -475,13 +512,17 @@ PP(pp_rv2av)
 		    }
 		    RETSETUNDEF;
 		}
-		sym = SvPV(sv,n_a);
+		sym = SvPV(sv,len);
 		if ((PL_op->op_flags & OPf_SPECIAL) &&
 		    !(PL_op->op_flags & OPf_MOD))
 		{
 		    gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV);
-		    if (!gv)
+		    if (!gv
+			&& (!is_gv_magical(sym,len,0)
+			    || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV))))
+		    {
 			RETSETUNDEF;
+		    }
 		}
 		else {
 		    if (PL_op->op_private & HINT_STRICT_REFS)
@@ -556,7 +597,7 @@ PP(pp_rv2hv)
 	    
 	    if (SvTYPE(sv) != SVt_PVGV) {
 		char *sym;
-		STRLEN n_a;
+		STRLEN len;
 
 		if (SvGMAGICAL(sv)) {
 		    mg_get(sv);
@@ -575,13 +616,17 @@ PP(pp_rv2hv)
 		    }
 		    RETSETUNDEF;
 		}
-		sym = SvPV(sv,n_a);
+		sym = SvPV(sv,len);
 		if ((PL_op->op_flags & OPf_SPECIAL) &&
 		    !(PL_op->op_flags & OPf_MOD))
 		{
 		    gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV);
-		    if (!gv)
+		    if (!gv
+			&& (!is_gv_magical(sym,len,0)
+			    || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV))))
+		    {
 			RETSETUNDEF;
+		    }
 		}
 		else {
 		    if (PL_op->op_private & HINT_STRICT_REFS)
@@ -626,7 +671,6 @@ S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem,
 		 SV **lastrelem)
 {
     OP *leftop;
-    SV *tmpstr;
     I32 i;
 
     leftop = ((BINOP*)PL_op)->op_last;
@@ -655,7 +699,7 @@ S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem,
 	    sv_setsv(tmpstr,relem[1]);	/* value */
 	    relem[1] = tmpstr;
 	    if (avhv_store_ent(ary,relem[0],tmpstr,0))
-		SvREFCNT_inc(tmpstr);
+		(void)SvREFCNT_inc(tmpstr);
 	    if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr))
 		mg_set(tmpstr);
 	    relem += 2;
@@ -689,7 +733,7 @@ S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
 	    /* pseudohash */
 	    tmpstr = sv_newmortal();
 	    if (avhv_store_ent((AV*)hash,*relem,tmpstr,0))
-		SvREFCNT_inc(tmpstr);
+		(void)SvREFCNT_inc(tmpstr);
 	    if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr))
 		mg_set(tmpstr);
 	}
@@ -737,7 +781,7 @@ PP(pp_aassign)
 	EXTEND_MORTAL(lastrelem - firstrelem + 1);
 	for (relem = firstrelem; relem <= lastrelem; relem++) {
 	    /*SUPPRESS 560*/
-	    if (sv = *relem) {
+	    if ((sv = *relem)) {
 		TAINT_NOT;	/* Each item is independent */
 		*relem = sv_mortalcopy(sv);
 	    }
@@ -979,7 +1023,7 @@ PP(pp_match)
     truebase = t = s;
 
     /* XXXX What part of this is needed with true \G-support? */
-    if (global = pm->op_pmflags & PMf_GLOBAL) {
+    if ((global = pm->op_pmflags & PMf_GLOBAL)) {
 	rx->startp[0] = -1;
 	if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 	    MAGIC* mg = mg_find(TARG, 'g');
@@ -1023,7 +1067,8 @@ play_it_again:
 	     && !PL_sawampersand 
 	     && ((rx->reganch & ROPT_NOSCAN)
 		 || !((rx->reganch & RE_INTUIT_TAIL)
-		      && (r_flags & REXEC_SCREAM))))
+		      && (r_flags & REXEC_SCREAM)))
+	     && !SvROK(TARG))	/* Cannot trust since INTUIT cannot guess ^ */
 	    goto yup;
     }
     if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
@@ -1059,6 +1104,10 @@ play_it_again:
 		len = rx->endp[i] - rx->startp[i];
 		s = rx->startp[i] + truebase;
 		sv_setpvn(*SP, s, len);
+		if ((pm->op_pmdynflags & PMdf_UTF8) && !IN_BYTE) {
+		    SvUTF8_on(*SP);
+		    sv_utf8_downgrade(*SP, TRUE);
+		}
 	    }
 	}
 	if (global) {
@@ -1157,7 +1206,7 @@ Perl_do_readline(pTHX)
     I32 gimme = GIMME_V;
     MAGIC *mg;
 
-    if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
+    if ((mg = SvTIED_mg((SV*)PL_last_in_gv, 'q'))) {
 	PUSHMARK(SP);
 	XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
 	PUTBACK;
@@ -1372,8 +1421,7 @@ Perl_do_readline(pTHX)
 /* delay EOF state for a snarfed empty file */
 #define SNARF_EOF(gimme,rs,io,sv) \
     (gimme != G_SCALAR || SvCUR(sv)					\
-     || !RsSNARF(rs) || (IoFLAGS(io) & IOf_NOLINE)			\
-     || ((IoFLAGS(io) |= IOf_NOLINE), FALSE))
+     || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))
 
     for (;;) {
 	if (!sv_gets(sv, fp, offset)
@@ -1406,6 +1454,7 @@ Perl_do_readline(pTHX)
 	    SvTAINTED_on(sv);
 	}
 	IoLINES(io)++;
+	IoFLAGS(io) |= IOf_NOLINE;
 	SvSETMAGIC(sv);
 	XPUSHs(sv);
 	if (type == OP_GLOB) {
@@ -1659,9 +1708,9 @@ PP(pp_iter)
 
     SvREFCNT_dec(*itersvp);
 
-    if (sv = (SvMAGICAL(av)) 
-	    ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) 
-	    : AvARRAY(av)[++cx->blk_loop.iterix])
+    if ((sv = SvMAGICAL(av)
+	      ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) 
+	      : AvARRAY(av)[++cx->blk_loop.iterix]))
 	SvTEMP_off(sv);
     else
 	sv = &PL_sv_undef;
@@ -1712,7 +1761,6 @@ PP(pp_subst)
     STRLEN len;
     int force_on_match = 0;
     I32 oldsave = PL_savestack_ix;
-    I32 update_minmatch = 1;
 
     /* known replacement string? */
     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
@@ -1818,7 +1866,7 @@ PP(pp_subst)
 		SvCUR_set(TARG, m - s);
 	    }
 	    /*SUPPRESS 560*/
-	    else if (i = m - s) {	/* faster from front */
+	    else if ((i = m - s)) {	/* faster from front */
 		d -= clen;
 		m = d;
 		sv_chop(TARG, d-i);
@@ -1847,7 +1895,7 @@ PP(pp_subst)
 		rxtainted |= RX_MATCH_TAINTED(rx);
 		m = rx->startp[0] + orig;
 		/*SUPPRESS 560*/
-		if (i = m - s) {
+		if ((i = m - s)) {
 		    if (s != d)
 			Move(s, d, i, char);
 		    d += i;
@@ -1870,7 +1918,7 @@ PP(pp_subst)
 	    SPAGAIN;
 	    PUSHs(sv_2mortal(newSViv((I32)iters)));
 	}
-	(void)SvPOK_only(TARG);
+	(void)SvPOK_only_UTF8(TARG);
 	TAINT_IF(rxtainted);
 	if (SvSMAGICAL(TARG)) {
 	    PUTBACK;
@@ -2015,8 +2063,10 @@ PP(pp_leavesub)
 		    sv_2mortal(*MARK);
 		}
 		else {
+		    sv = SvREFCNT_inc(TOPs);	/* FREETMPS could clobber it */
 		    FREETMPS;
-		    *MARK = sv_mortalcopy(TOPs);
+		    *MARK = sv_mortalcopy(sv);
+		    SvREFCNT_dec(sv);
 		}
 	    }
 	    else
@@ -2145,7 +2195,6 @@ PP(pp_leavesublv)
 			: "an uninitialized value");
 		}
 		else {
-		    mortalize:
 		    /* Can be a localized value subject to deletion. */
 		    PL_tmps_stack[++PL_tmps_ix] = *mark;
 		    (void)SvREFCNT_inc(*mark);
@@ -2165,8 +2214,10 @@ PP(pp_leavesublv)
 			sv_2mortal(*MARK);
 		    }
 		    else {
+			sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
 			FREETMPS;
-			*MARK = sv_mortalcopy(TOPs);
+			*MARK = sv_mortalcopy(sv);
+			SvREFCNT_dec(sv);
 		    }
 		}
 		else
@@ -2216,15 +2267,17 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 		    && (gv = (GV*)*svp) ))) {
 	    /* Use GV from the stack as a fallback. */
 	    /* GV is potentially non-unique, or contain different CV. */
-	    sv_setsv(dbsv, newRV((SV*)cv));
+	    SV *tmp = newRV((SV*)cv));
+	    sv_setsv(dbsv, tmp);
+	    SvREFCNT_dec(tmp);
 	}
 	else {
 	    gv_efullname3(dbsv, gv, Nullch);
 	}
     }
     else {
-	SvUPGRADE(dbsv, SVt_PVIV);
-	SvIOK_on(dbsv);
+	(void)SvUPGRADE(dbsv, SVt_PVIV);
+	(void)SvIOK_on(dbsv);
 	SAVEIV(SvIVX(dbsv));
 	SvIVX(dbsv) = PTR2IV(cv);	/* Do it the quickest way  */
     }
@@ -2639,6 +2692,7 @@ try_autoload:
 	    cx->blk_sub.savearray = GvAV(PL_defgv);
 	    GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
 #endif /* USE_THREADS */
+	    cx->blk_sub.oldcurpad = PL_curpad;
 	    cx->blk_sub.argarray = av;
 	    ++MARK;
 
@@ -2795,7 +2849,6 @@ PP(pp_method_named)
 STATIC SV *
 S_method_common(pTHX_ SV* meth, U32* hashp)
 {
-    djSP;
     SV* sv;
     SV* ob;
     GV* gv;
@@ -2864,6 +2917,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	char* leaf = name;
 	char* sep = Nullch;
 	char* p;
+	GV* gv;
 
 	for (p = name; *p; p++) {
 	    if (*p == '\'')
@@ -2879,9 +2933,18 @@ S_method_common(pTHX_ SV* meth, U32* hashp)
 	    packname = name;
 	    packlen = sep - name;
 	}
-	Perl_croak(aTHX_
-		   "Can't locate object method \"%s\" via package \"%s\"",
-		   leaf, packname);
+	gv = gv_fetchpv(packname, 0, SVt_PVHV);
+	if (gv && isGV(gv)) {
+	    Perl_croak(aTHX_
+		       "Can't locate object method \"%s\" via package \"%s\"",
+		       leaf, packname);
+	}
+	else {
+	    Perl_croak(aTHX_
+		       "Can't locate object method \"%s\" via package \"%s\""
+		       " (perhaps you forgot to load \"%s\"?)",
+		       leaf, packname, packname);
+	}
     }
     return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
 }