allow fields in re_tests to include \x{nnn} etc

[p5sagit/p5-mst-13.2.git] / pp.c

diff --git a/pp.c b/pp.c
index a04e0d4..6809b31 100644 (file)
--- 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
@@ -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 = (U8*)"";
+       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;
@@ -3577,7 +3579,7 @@ PP(pp_uc)
        if (SvOK(source)) {
            s = (const U8*)SvPV_nomg_const(source, len);
        } else {
-           s = (U8*)"";
+           s = (const U8*)"";
            len = 0;
        }
        min = len + 1;
@@ -3677,7 +3679,7 @@ PP(pp_lc)
        if (SvOK(source)) {
            s = (const U8*)SvPV_nomg_const(source, len);
        } else {
-           s = (U8*)"";
+           s = (const U8*)"";
            len = 0;
        }
        min = len + 1;
@@ -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) {