X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=6730f29f0c2e084d0f437bdc91cbd4be48f13c96;hb=302d38aa06a9db991c3d8d4d4150b2d3e93e193b;hp=1d3e365aa99a4016d1c0418f4cd526257bd49e9a;hpb=d815558d76680455c3455ca148e9c280db95eb71;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp.c b/pp.c
index 1d3e365..6730f29 100644
--- a/pp.c
+++ b/pp.c
@@ -448,10 +448,12 @@ PP(pp_prototype)
 		    else if (n && str[0] == ';' && seen_question)
 			goto set;	/* XXXX system, exec */
 		    if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
-			&& (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+			&& (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
+			/* But globs are already references (kinda) */
+			&& (oa & (OA_OPTIONAL - 1)) != OA_FILEREF
+		    ) {
 			str[n++] = '\\';
 		    }
-		    /* What to do with R ((un)tie, tied, (sys)read, recv)? */
 		    str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
 		    oa = oa >> 4;
 		}
@@ -1232,6 +1234,16 @@ PP(pp_repeat)
 	    (void)SvPOK_only_UTF8(TARG);
 	else
 	    (void)SvPOK_only(TARG);
+
+	if (PL_op->op_private & OPpREPEAT_DOLIST) {
+	    /* The parser saw this as a list repeat, and there
+	       are probably several items on the stack. But we're
+	       in scalar context, and there's no pp_list to save us
+	       now. So drop the rest of the items -- robin@kitsite.com
+	     */
+	    dMARK;
+	    SP = MARK;
+	}
 	PUSHTARG;
     }
     RETURN;
@@ -1704,6 +1716,12 @@ PP(pp_ge)
 PP(pp_ne)
 {
     dSP; tryAMAGICbinSET(ne,0);
+#ifndef NV_PRESERVES_UV
+    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+	SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
+	RETURN;
+    }
+#endif
 #ifdef PERL_PRESERVE_IVUV
     SvIV_please(TOPs);
     if (SvIOK(TOPs)) {
@@ -1774,6 +1792,12 @@ PP(pp_ne)
 PP(pp_ncmp)
 {
     dSP; dTARGET; tryAMAGICbin(ncmp,0);
+#ifndef NV_PRESERVES_UV
+    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+	SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
+	RETURN;
+    }
+#endif
 #ifdef PERL_PRESERVE_IVUV
     /* Fortunately it seems NaN isn't IOK */
     SvIV_please(TOPs);
@@ -1954,6 +1978,12 @@ PP(pp_sne)
 PP(pp_scmp)
 {
     dSP; dTARGET;  tryAMAGICbin(scmp,0);
+#ifndef NV_PRESERVES_UV
+    if (SvROK(TOPs) && SvROK(TOPm1s)) {
+	SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
+	RETURN;
+    }
+#endif
     {
       dPOPTOPssrl;
       int cmp = ((PL_op->op_private & OPpLOCALE)
@@ -2639,11 +2669,11 @@ PP(pp_hex)
     dSP; dTARGET;
     char *tmps;
     STRLEN argtype;
-    STRLEN n_a;
+    STRLEN len;
 
-    tmps = POPpx;
+    tmps = (SvPVx(POPs, len));
     argtype = 1;		/* allow underscores */
-    XPUSHn(scan_hex(tmps, 99, &argtype));
+    XPUSHn(scan_hex(tmps, len, &argtype));
     RETURN;
 }
 
@@ -2653,20 +2683,20 @@ PP(pp_oct)
     NV value;
     STRLEN argtype;
     char *tmps;
-    STRLEN n_a;
+    STRLEN len;
 
-    tmps = POPpx;
-    while (*tmps && isSPACE(*tmps))
-	tmps++;
+    tmps = (SvPVx(POPs, len));
+    while (*tmps && len && isSPACE(*tmps))
+       tmps++, len--;
     if (*tmps == '0')
-	tmps++;
+       tmps++, len--;
     argtype = 1;		/* allow underscores */
     if (*tmps == 'x')
-	value = scan_hex(++tmps, 99, &argtype);
+       value = scan_hex(++tmps, --len, &argtype);
     else if (*tmps == 'b')
-	value = scan_bin(++tmps, 99, &argtype);
+       value = scan_bin(++tmps, --len, &argtype);
     else
-	value = scan_oct(tmps, 99, &argtype);
+       value = scan_oct(tmps, len, &argtype);
     XPUSHn(value);
     RETURN;
 }
@@ -2691,39 +2721,51 @@ PP(pp_substr)
     SV *sv;
     I32 len;
     STRLEN curlen;
-    STRLEN utfcurlen;
+    STRLEN utf8_curlen;
     I32 pos;
     I32 rem;
     I32 fail;
     I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
     char *tmps;
     I32 arybase = PL_curcop->cop_arybase;
+    SV *repl_sv = NULL;
     char *repl = 0;
     STRLEN repl_len;
     int num_args = PL_op->op_private & 7;
+    bool repl_need_utf8_upgrade = FALSE;
+    bool repl_is_utf8 = FALSE;
 
     SvTAINTED_off(TARG);			/* decontaminate */
     SvUTF8_off(TARG);				/* decontaminate */
     if (num_args > 2) {
 	if (num_args > 3) {
-	    sv = POPs;
-	    repl = SvPV(sv, repl_len);
+	    repl_sv = POPs;
+	    repl = SvPV(repl_sv, repl_len);
+	    repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
 	}
 	len = POPi;
     }
     pos = POPi;
     sv = POPs;
     PUTBACK;
+    if (repl_sv) {
+	if (repl_is_utf8) {
+	    if (!DO_UTF8(sv))
+		sv_utf8_upgrade(sv);
+	}
+	else if (DO_UTF8(sv))
+	    repl_need_utf8_upgrade = TRUE;
+    }
     tmps = SvPV(sv, curlen);
     if (DO_UTF8(sv)) {
-        utfcurlen = sv_len_utf8(sv);
-	if (utfcurlen == curlen)
-	    utfcurlen = 0;
+        utf8_curlen = sv_len_utf8(sv);
+	if (utf8_curlen == curlen)
+	    utf8_curlen = 0;
 	else
-	    curlen = utfcurlen;
+	    curlen = utf8_curlen;
     }
     else
-	utfcurlen = 0;
+	utf8_curlen = 0;
 
     if (pos >= arybase) {
 	pos -= arybase;
@@ -2768,14 +2810,27 @@ PP(pp_substr)
     else {
 	I32 upos = pos;
 	I32 urem = rem;
-	if (utfcurlen)
+	if (utf8_curlen)
 	    sv_pos_u2b(sv, &pos, &rem);
 	tmps += pos;
 	sv_setpvn(TARG, tmps, rem);
-	if (utfcurlen)
+	if (utf8_curlen)
 	    SvUTF8_on(TARG);
-	if (repl)
+	if (repl) {
+	    SV* repl_sv_copy = NULL;
+
+	    if (repl_need_utf8_upgrade) {
+		repl_sv_copy = newSVsv(repl_sv);
+		sv_utf8_upgrade(repl_sv_copy);
+		repl = SvPV(repl_sv_copy, repl_len);
+		repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
+	    }
 	    sv_insert(sv, pos, rem, repl, repl_len);
+	    if (repl_is_utf8)
+		SvUTF8_on(sv);
+	    if (repl_sv_copy)
+		SvREFCNT_dec(repl_sv_copy);
+	}
 	else if (lvalue) {		/* it's an lvalue! */
 	    if (!SvGMAGICAL(sv)) {
 		if (SvROK(sv)) {
@@ -3962,7 +4017,7 @@ PP(pp_reverse)
 		U8* s = (U8*)SvPVX(TARG);
 		U8* send = (U8*)(s + len);
 		while (s < send) {
-		    if (UTF8_IS_ASCII(*s)) {
+		    if (UTF8_IS_INVARIANT(*s)) {
 			s++;
 			continue;
 		    }
@@ -4789,7 +4844,8 @@ PP(pp_unpack)
 		
 		while ((len > 0) && (s < strend)) {
 		    auv = (auv << 7) | (*s & 0x7f);
-		    if (UTF8_IS_ASCII(*s++)) {
+		    /* UTF8_IS_XXXXX not right here - using constant 0x80 */
+		    if ((U8)(*s++) < 0x80) {
 			bytes = 0;
 			sv = NEWSV(40, 0);
 			sv_setuv(sv, auv);