integrate Pod-Perldoc-3.07. This replaces the original inline perldoc
[p5sagit/p5-mst-13.2.git] / regexec.c
index de3caaf..f69c360 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -431,7 +431,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
              );
     });
 
-    if (prog->minlen > CHR_DIST((U8*)strend, (U8*)strpos)) {
+    /* CHR_DIST() would be more correct here but it makes things slow. */
+    if (prog->minlen > strend - strpos) {
        DEBUG_r(PerlIO_printf(Perl_debug_log,
                              "String too short... [re_intuit_start]\n"));
        goto fail;
@@ -594,7 +595,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
                t = s - prog->check_offset_max;
                if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
-                   && (!(prog->reganch & ROPT_UTF8)
+                   && (!do_utf8
                        || ((t = reghopmaybe3_c(s, -(prog->check_offset_max), strpos))
                            && t > strpos)))
                    /* EMPTY */;
@@ -714,7 +715,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
     t = s - prog->check_offset_max;
     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
-        && (!(prog->reganch & ROPT_UTF8)
+        && (!do_utf8
            || ((t = reghopmaybe3_c(s, -prog->check_offset_max, strpos))
                 && t > strpos))) {
        /* Fixed substring is found far enough so that the match
@@ -2790,13 +2791,13 @@ S_regmatch(pTHX_ regnode *prog)
            dSP;
            OP_4tree *oop = PL_op;
            COP *ocurcop = PL_curcop;
-           SV **ocurpad = PL_curpad;
+           PAD *old_comppad;
            SV *ret;
        
            n = ARG(scan);
            PL_op = (OP_4tree*)PL_regdata->data[n];
            DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
-           PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
+           PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
            PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
 
            {
@@ -2804,7 +2805,7 @@ S_regmatch(pTHX_ regnode *prog)
                CALLRUNOPS(aTHX);                       /* Scalar context. */
                SPAGAIN;
                if (SP == before)
-                   ret = Nullsv;   /* protect against empty (?{}) blocks. */
+                   ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
                else {
                    ret = POPs;
                    PUTBACK;
@@ -2812,7 +2813,7 @@ S_regmatch(pTHX_ regnode *prog)
            }
 
            PL_op = oop;
-           PL_curpad = ocurpad;
+           PAD_RESTORE_LOCAL(old_comppad);
            PL_curcop = ocurcop;
            if (logical) {
                if (logical == 2) {     /* Postponed subexpression. */
@@ -2820,6 +2821,7 @@ S_regmatch(pTHX_ regnode *prog)
                    MAGIC *mg = Null(MAGIC*);
                    re_cc_state state;
                    CHECKPOINT cp, lastcp;
+                    int toggleutf;
 
                    if(SvROK(ret) || SvRMAGICAL(ret)) {
                        SV *sv = SvROK(ret) ? SvRV(ret) : ret;
@@ -2840,6 +2842,7 @@ S_regmatch(pTHX_ regnode *prog)
                        I32 onpar = PL_regnpar;
 
                        Zero(&pm, 1, PMOP);
+                        if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
                        re = CALLREGCOMP(aTHX_ t, t + len, &pm);
                        if (!(SvFLAGS(ret)
                              & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
@@ -2872,6 +2875,9 @@ S_regmatch(pTHX_ regnode *prog)
                    *PL_reglastcloseparen = 0;
                    PL_reg_call_cc = &state;
                    PL_reginput = locinput;
+                   toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
+                               ((re->reganch & ROPT_UTF8) != 0);
+                   if (toggleutf) PL_reg_flags ^= RF_utf8;
 
                    /* XXXX This is too dramatic a measure... */
                    PL_reg_maxiter = 0;
@@ -2886,6 +2892,7 @@ S_regmatch(pTHX_ regnode *prog)
                        PL_regcc = state.cc;
                        PL_reg_re = state.re;
                        cache_re(PL_reg_re);
+                       if (toggleutf) PL_reg_flags ^= RF_utf8;
 
                        /* XXXX This is too dramatic a measure... */
                        PL_reg_maxiter = 0;
@@ -2902,6 +2909,7 @@ S_regmatch(pTHX_ regnode *prog)
                    PL_regcc = state.cc;
                    PL_reg_re = state.re;
                    cache_re(PL_reg_re);
+                   if (toggleutf) PL_reg_flags ^= RF_utf8;
 
                    /* XXXX This is too dramatic a measure... */
                    PL_reg_maxiter = 0;
@@ -3070,10 +3078,10 @@ S_regmatch(pTHX_ regnode *prog)
 
                DEBUG_r(
                    PerlIO_printf(Perl_debug_log,
-                                 "%*s  %ld out of %ld..%ld  cc=%lx\n",
+                                 "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
                                  REPORT_CODE_OFF+PL_regindent*2, "",
                                  (long)n, (long)cc->min,
-                                 (long)cc->max, (long)cc)
+                                 (long)cc->max, PTR2UV(cc))
                    );
 
                /* If degenerate scan matches "", assume scan done. */
@@ -3681,14 +3689,14 @@ S_regmatch(pTHX_ regnode *prog)
                        /* If it could work, try it. */
                        if (c == (UV)c1 || c == (UV)c2)
                        {
-                           TRYPAREN(paren, n, PL_reginput);
+                           TRYPAREN(paren, ln, PL_reginput);
                            REGCP_UNWIND(lastcp);
                        }
                    }
                    /* If it could work, try it. */
                    else if (c1 == -1000)
                    {
-                       TRYPAREN(paren, n, PL_reginput);
+                       TRYPAREN(paren, ln, PL_reginput);
                        REGCP_UNWIND(lastcp);
                    }
                    /* Couldn't or didn't -- move forward. */
@@ -3989,7 +3997,9 @@ S_regrepeat(pTHX_ regnode *p, I32 max)
     register bool do_utf8 = PL_reg_match_utf8;
 
     scan = PL_reginput;
-    if (max != REG_INFTY && max < loceol - scan)
+    if (max == REG_INFTY)
+       max = I32_MAX;
+    else if (max < loceol - scan)
       loceol = scan + max;
     switch (OP(p)) {
     case REG_ANY:
@@ -4283,15 +4293,16 @@ Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** listsvp, SV
        if (PL_regdata->what[n] == 's') {
            SV *rv = (SV*)PL_regdata->data[n];
            AV *av = (AV*)SvRV((SV*)rv);
+           SV **ary = AvARRAY(av);
            SV **a, **b;
        
            /* See the end of regcomp.c:S_reglass() for
             * documentation of these array elements. */
 
-           si  = *av_fetch(av, 0, FALSE);
-           a   =  av_fetch(av, 1, FALSE);
-           b   =  av_fetch(av, 2, FALSE);
-       
+           si = *ary;
+           a  = SvTYPE(ary[1]) == SVt_RV   ? &ary[1] : 0;
+           b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
+
            if (a)
                sw = *a;
            else if (si && doinit) {
@@ -4326,12 +4337,13 @@ S_reginclass(pTHX_ register regnode *n, register U8* p, STRLEN* lenp, register b
 {
     char flags = ANYOF_FLAGS(n);
     bool match = FALSE;
-    UV c;
+    UV c = *p;
     STRLEN len = 0;
     STRLEN plen;
 
-    c = do_utf8 ? utf8n_to_uvchr(p, UTF8_MAXLEN, &len,
-                                ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY) : *p;
+    if (do_utf8 && !UTF8_IS_INVARIANT(c))
+        c = utf8n_to_uvchr(p, UTF8_MAXLEN, &len,
+                           ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
 
     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
     if (do_utf8 || (flags & ANYOF_UNICODE)) {
@@ -4526,7 +4538,7 @@ S_to_utf8_substr(pTHX_ register regexp *prog)
     SV* sv;
     if (prog->float_substr && !prog->float_utf8) {
        prog->float_utf8 = sv = NEWSV(117, 0);
-       SvSetMagicSV(sv, prog->float_substr);
+       SvSetSV(sv, prog->float_substr);
        sv_utf8_upgrade(sv);
        if (SvTAIL(prog->float_substr))
            SvTAIL_on(sv);
@@ -4535,7 +4547,7 @@ S_to_utf8_substr(pTHX_ register regexp *prog)
     }
     if (prog->anchored_substr && !prog->anchored_utf8) {
        prog->anchored_utf8 = sv = NEWSV(118, 0);
-       SvSetMagicSV(sv, prog->anchored_substr);
+       SvSetSV(sv, prog->anchored_substr);
        sv_utf8_upgrade(sv);
        if (SvTAIL(prog->anchored_substr))
            SvTAIL_on(sv);
@@ -4550,7 +4562,7 @@ S_to_byte_substr(pTHX_ register regexp *prog)
     SV* sv;
     if (prog->float_utf8 && !prog->float_substr) {
        prog->float_substr = sv = NEWSV(117, 0);
-       SvSetMagicSV(sv, prog->float_utf8);
+       SvSetSV(sv, prog->float_utf8);
        if (sv_utf8_downgrade(sv, TRUE)) {
            if (SvTAIL(prog->float_utf8))
                SvTAIL_on(sv);
@@ -4563,7 +4575,7 @@ S_to_byte_substr(pTHX_ register regexp *prog)
     }
     if (prog->anchored_utf8 && !prog->anchored_substr) {
        prog->anchored_substr = sv = NEWSV(118, 0);
-       SvSetMagicSV(sv, prog->anchored_utf8);
+       SvSetSV(sv, prog->anchored_utf8);
        if (sv_utf8_downgrade(sv, TRUE)) {
            if (SvTAIL(prog->anchored_utf8))
                SvTAIL_on(sv);