Make the large file tests more robust/talkative as suggested by

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

diff --git a/pp_hot.c b/pp_hot.c
index 6a5b96f..c7555c4 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1179,11 +1179,12 @@ PP(pp_match)
        TARG = DEFSV;
        EXTEND(SP,1);
     }
+    PL_reg_sv = TARG;
     PUTBACK;                           /* EVAL blocks need stack_sp. */
     s = SvPV(TARG, len);
     strend = s + len;
     if (!s)
-       DIE(aTHX_ "panic: do_match");
+       DIE(aTHX_ "panic: pp_match");
     rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
                 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
     TAINT_NOT;
@@ -1268,27 +1269,25 @@ play_it_again:
        RX_MATCH_TAINTED_on(rx);
     TAINT_IF(RX_MATCH_TAINTED(rx));
     if (gimme == G_ARRAY) {
-       I32 iters, i, len;
+       I32 nparens, i, len;
 
-       iters = rx->nparens;
-       if (global && !iters)
+       nparens = rx->nparens;
+       if (global && !nparens)
            i = 1;
        else
            i = 0;
        SPAGAIN;                        /* EVAL blocks could move the stack. */
-       EXTEND(SP, iters + i);
-       EXTEND_MORTAL(iters + i);
-       for (i = !i; i <= iters; i++) {
+       EXTEND(SP, nparens + i);
+       EXTEND_MORTAL(nparens + i);
+       for (i = !i; i <= nparens; i++) {
            PUSHs(sv_newmortal());
            /*SUPPRESS 560*/
            if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
                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) {
+               if (DO_UTF8(TARG))
                    SvUTF8_on(*SP);
-                   sv_utf8_downgrade(*SP, TRUE);
-               }
            }
        }
        if (global) {
@@ -1298,7 +1297,7 @@ play_it_again:
            r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
            goto play_it_again;
        }
-       else if (!iters)
+       else if (!nparens)
            XPUSHs(&PL_sv_yes);
        LEAVE_SCOPE(oldsave);
        RETURN;
@@ -1822,6 +1821,8 @@ PP(pp_subst)
     STRLEN len;
     int force_on_match = 0;
     I32 oldsave = PL_savestack_ix;
+    bool do_utf8;
+    STRLEN slen;
 
     /* known replacement string? */
     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
@@ -1831,6 +1832,8 @@ PP(pp_subst)
        TARG = DEFSV;
        EXTEND(SP,1);
     }
+    PL_reg_sv = TARG;
+    do_utf8 = DO_UTF8(PL_reg_sv);
     if (SvFAKE(TARG) && SvREADONLY(TARG))
        sv_force_normal(TARG);
     if (SvREADONLY(TARG)
@@ -1847,15 +1850,16 @@ PP(pp_subst)
     if (PL_tainted)
        rxtainted |= 2;
     TAINT_NOT;
-
+    
   force_it:
     if (!pm || !s)
-       DIE(aTHX_ "panic: do_subst");
+       DIE(aTHX_ "panic: pp_subst");
 
     strend = s + len;
-    maxiters = 2*(strend - s) + 10;    /* We can match twice at each
-                                          position, once with zero-length,
-                                          second time with non-zero. */
+    slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : len;
+    maxiters = 2 * slen + 10;  /* We can match twice at each
+                                  position, once with zero-length,
+                                  second time with non-zero. */
 
     if (!rx->prelen && PL_curpm) {
        pm = PL_curpm;
@@ -2004,6 +2008,8 @@ PP(pp_subst)
        rxtainted |= RX_MATCH_TAINTED(rx);
        dstr = NEWSV(25, len);
        sv_setpvn(dstr, m, s-m);
+       if (DO_UTF8(TARG))
+           SvUTF8_on(dstr);
        PL_curpm = pm;
        if (!c) {
            register PERL_CONTEXT *cx;
@@ -2030,7 +2036,8 @@ PP(pp_subst)
                sv_catpvn(dstr, c, clen);
            if (once)
                break;
-       } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m, TARG, NULL, r_flags));
+       } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
+                            TARG, NULL, r_flags));
        sv_catpvn(dstr, s, strend - s);
 
        (void)SvOOK_off(TARG);
@@ -2812,12 +2819,15 @@ PP(pp_aelem)
 {
     djSP;
     SV** svp;
-    IV elem = POPi;
+    SV* elemsv = POPs;
+    IV elem = SvIV(elemsv);
     AV* av = (AV*)POPs;
     U32 lval = PL_op->op_flags & OPf_MOD;
     U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
     SV *sv;
 
+    if (SvROK(elemsv) && ckWARN(WARN_MISC))
+       Perl_warner(aTHX_ WARN_MISC, "Use of reference \"%s\" as array index", SvPV_nolen(elemsv));
     if (elem > 0)
        elem -= PL_curcop->cop_arybase;
     if (SvTYPE(av) != SVt_PVAV)