X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=6809b3176edbdfc43bb6535d1dbe68727ab2443b;hb=b2a156bd8e464af88881c77344280160fd844dcf;hp=65e1d506492b79cba329ca3c2d47fec85b4f7185;hpb=73ee8be2712c500c98e5976864ba96726bf311e2;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 65e1d50..6809b31 100644
--- a/pp.c
+++ b/pp.c
@@ -61,7 +61,8 @@ PP(pp_padav)
     dVAR; dSP; dTARGET;
     I32 gimme;
     if (PL_op->op_private & OPpLVAL_INTRO)
-	SAVECLEARSV(PAD_SVl(PL_op->op_targ));
+	if (!(PL_op->op_private & OPpPAD_STATE))
+	    SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     EXTEND(SP, 1);
     if (PL_op->op_flags & OPf_REF) {
 	PUSHs(TARG);
@@ -104,7 +105,8 @@ PP(pp_padhv)
 
     XPUSHs(TARG);
     if (PL_op->op_private & OPpLVAL_INTRO)
-	SAVECLEARSV(PAD_SVl(PL_op->op_targ));
+	if (!(PL_op->op_private & OPpPAD_STATE))
+	    SAVECLEARSV(PAD_SVl(PL_op->op_targ));
     if (PL_op->op_flags & OPf_REF)
 	RETURN;
     else if (LVRET) {
@@ -237,6 +239,7 @@ PP(pp_rv2sv)
 	case SVt_PVFM:
 	case SVt_PVIO:
 	    DIE(aTHX_ "Not a SCALAR reference");
+	default: NOOP;
 	}
     }
     else {
@@ -346,7 +349,7 @@ PP(pp_rv2cv)
 {
     dVAR; dSP;
     GV *gv;
-    HV *stash;
+    HV *stash_unused;
     const I32 flags = (PL_op->op_flags & OPf_SPECIAL)
 	? 0
 	: ((PL_op->op_private & (OPpLVAL_INTRO|OPpMAY_RETURN_CONSTANT)) == OPpMAY_RETURN_CONSTANT)
@@ -355,7 +358,7 @@ PP(pp_rv2cv)
     /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
     /* (But not in defined().) */
 
-    CV *cv = sv_2cv(TOPs, &stash, &gv, flags);
+    CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags);
     if (cv) {
 	if (CvCLONE(cv))
 	    cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
@@ -386,7 +389,7 @@ PP(pp_prototype)
     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
 	const char * const s = SvPVX_const(TOPs);
 	if (strnEQ(s, "CORE::", 6)) {
-	    const int code = keyword(s + 6, SvCUR(TOPs) - 6);
+	    const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
 	    if (code < 0) {	/* Overridable. */
 #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
 		int i = 0, n = 0, seen_question = 0;
@@ -394,7 +397,7 @@ PP(pp_prototype)
 		char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
 
 		if (code == -KEY_chop || code == -KEY_chomp
-			|| code == -KEY_exec || code == -KEY_system)
+			|| code == -KEY_exec || code == -KEY_system || code == -KEY_err)
 		    goto set;
 		while (i < MAXO) {	/* The slow way. */
 		    if (strEQ(s + 6, PL_op_name[i])
@@ -641,7 +644,7 @@ PP(pp_study)
     }
     s = (unsigned char*)(SvPV(sv, len));
     pos = len;
-    if (pos <= 0 || !SvPOK(sv)) {
+    if (pos <= 0 || !SvPOK(sv) || SvUTF8(sv)) {
 	/* No point in studying a zero length string, and not safe to study
 	   anything that doesn't appear to be a simple scalar (and hence might
 	   change between now and when the regexp engine runs without our set
@@ -3124,8 +3127,6 @@ PP(pp_substr)
 		sv_upgrade(TARG, SVt_PVLV);
 		sv_magic(TARG, NULL, PERL_MAGIC_substr, NULL, 0);
 	    }
-	    else
-		SvOK_off(TARG);
 
 	    LvTYPE(TARG) = 'x';
 	    if (LvTARG(TARG) != sv) {
@@ -3207,7 +3208,7 @@ PP(pp_index)
 	if (little_utf8 && !PL_encoding) {
 	    /* Well, maybe instead we might be able to downgrade the small
 	       string?  */
-	    char * const pv = (char*)bytes_from_utf8(little_p, &llen,
+	    char * const pv = (char*)bytes_from_utf8((U8 *)little_p, &llen,
 						     &little_utf8);
 	    if (little_utf8) {
 		/* If the large string is ISO-8859-1, and it's not possible to
@@ -3251,7 +3252,7 @@ PP(pp_index)
 	    SvUTF8_on(big);
 	big_p = SvPVX(big);
     }
-    if (SvGAMAGIC(little) || index && !SvOK(little)) {
+    if (SvGAMAGIC(little) || (is_index && !SvOK(little))) {
 	/* index && SvOK() is a hack. fbm_instr() calls SvPV_const, which will
 	   warn on undef, and we've already triggered a warning with the
 	   SvPV_const some lines above. We can't remove that, as we need to
@@ -3309,13 +3310,13 @@ PP(pp_sprintf)
 PP(pp_ord)
 {
     dVAR; dSP; dTARGET;
+
     SV *argsv = POPs;
     STRLEN len;
     const U8 *s = (U8*)SvPV_const(argsv, len);
-    SV *tmpsv;
 
     if (PL_encoding && SvPOK(argsv) && !DO_UTF8(argsv)) {
-        tmpsv = sv_2mortal(newSVsv(argsv));
+        SV * const tmpsv = sv_2mortal(newSVsv(argsv));
         s = (U8*)sv_recode_to_utf8(tmpsv, PL_encoding);
         argsv = tmpsv;
     }
@@ -3365,20 +3366,21 @@ PP(pp_chr)
     *tmps++ = (char)value;
     *tmps = '\0';
     (void)SvPOK_only(TARG);
+
     if (PL_encoding && !IN_BYTES) {
         sv_recode_to_utf8(TARG, PL_encoding);
 	tmps = SvPVX(TARG);
 	if (SvCUR(TARG) == 0 || !is_utf8_string((U8*)tmps, SvCUR(TARG)) ||
-	    memEQ(tmps, "\xef\xbf\xbd\0", 4)) {
-	    SvGROW(TARG, 3);
+	    UNICODE_IS_REPLACEMENT(utf8_to_uvchr((U8*)tmps, NULL))) {
+	    SvGROW(TARG, 2);
 	    tmps = SvPVX(TARG);
-	    SvCUR_set(TARG, 2);
-	    *tmps++ = (U8)UTF8_EIGHT_BIT_HI(value);
-	    *tmps++ = (U8)UTF8_EIGHT_BIT_LO(value);
+	    SvCUR_set(TARG, 1);
+	    *tmps++ = (char)value;
 	    *tmps = '\0';
-	    SvUTF8_on(TARG);
+	    SvUTF8_off(TARG);
 	}
     }
+
     XPUSHs(TARG);
     RETURN;
 }
@@ -3453,7 +3455,7 @@ PP(pp_ucfirst)
     if (SvOK(source)) {
 	s = (const U8*)SvPV_nomg_const(source, slen);
     } else {
-	s = "";
+	s = (const U8*)"";
 	slen = 0;
     }
 
@@ -3466,7 +3468,7 @@ PP(pp_ucfirst)
 	    toLOWER_utf8(s, tmpbuf, &tculen);
 	}
 	/* If the two differ, we definately cannot do inplace.  */
-	inplace = ulen == tculen;
+	inplace = (ulen == tculen);
 	need = slen + 1 - ulen + tculen;
     } else {
 	doing_utf8 = FALSE;
@@ -3484,7 +3486,7 @@ PP(pp_ucfirst)
 	dest = TARG;
 
 	SvUPGRADE(dest, SVt_PV);
-	d = SvGROW(dest, need);
+	d = (U8*)SvGROW(dest, need);
 	(void)SvPOK_only(dest);
 
 	SETs(dest);
@@ -3577,13 +3579,13 @@ PP(pp_uc)
 	if (SvOK(source)) {
 	    s = (const U8*)SvPV_nomg_const(source, len);
 	} else {
-	    s = "";
+	    s = (const U8*)"";
 	    len = 0;
 	}
 	min = len + 1;
 
 	SvUPGRADE(dest, SVt_PV);
-	d = SvGROW(dest, min);
+	d = (U8*)SvGROW(dest, min);
 	(void)SvPOK_only(dest);
 
 	SETs(dest);
@@ -3677,13 +3679,13 @@ PP(pp_lc)
 	if (SvOK(source)) {
 	    s = (const U8*)SvPV_nomg_const(source, len);
 	} else {
-	    s = "";
+	    s = (const U8*)"";
 	    len = 0;
 	}
 	min = len + 1;
 
 	SvUPGRADE(dest, SVt_PV);
-	d = SvGROW(dest, min);
+	d = (U8*)SvGROW(dest, min);
 	(void)SvPOK_only(dest);
 
 	SETs(dest);
@@ -4033,7 +4035,7 @@ PP(pp_hslice)
 			STRLEN keylen;
 			const char * const key = SvPV_const(keysv, keylen);
 			SAVEDELETE(hv, savepvn(key,keylen),
-				   SvUTF8(keysv) ? -keylen : keylen);
+				   SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
 		    }
 		}
             }
@@ -4072,7 +4074,7 @@ PP(pp_lslice)
     SV ** const firstlelem = PL_stack_base + POPMARK + 1;
     register SV ** const firstrelem = lastlelem + 1;
     const I32 arybase = CopARYBASE_get(PL_curcop);
-    I32 is_something_there = PL_op->op_flags & OPf_MOD;
+    I32 is_something_there = FALSE;
 
     register const I32 max = lastrelem - lastlelem;
     register SV **lelem;
@@ -4121,16 +4123,17 @@ PP(pp_anonlist)
 {
     dVAR; dSP; dMARK; dORIGMARK;
     const I32 items = SP - MARK;
-    SV * const av = sv_2mortal((SV*)av_make(items, MARK+1));
+    SV * const av = (SV *) av_make(items, MARK+1);
     SP = ORIGMARK;		/* av_make() might realloc stack_sp */
-    XPUSHs(av);
+    XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
+		      ? newRV_noinc(av) : av));
     RETURN;
 }
 
 PP(pp_anonhash)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    HV* const hv = (HV*)sv_2mortal((SV*)newHV());
+    HV* const hv = newHV();
 
     while (MARK < SP) {
 	SV * const key = *++MARK;
@@ -4142,7 +4145,8 @@ PP(pp_anonhash)
 	(void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
-    XPUSHs((SV*)hv);
+    XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
+		      ? newRV_noinc((SV*) hv) : (SV*)hv));
     RETURN;
 }
 
@@ -4354,7 +4358,7 @@ PP(pp_splice)
 PP(pp_push)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
-    register AV *ary = (AV*)*++MARK;
+    register AV * const ary = (AV*)*++MARK;
     const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
 
     if (mg) {