This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add OS-specific core modules in Module::CoreList for 5.8.[78] and 5.9.[23]
[perl5.git] / regexec.c
index 3eee31e..3731b60 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -197,17 +197,16 @@ S_regcppush(pTHX_ I32 parenfloor)
 /* These are needed since we do not localize EVAL nodes: */
 #define REGCP_SET(cp)                                           \
     DEBUG_STATE_r(                                              \
-        if (cp != PL_savestack_ix)                             \
             PerlIO_printf(Perl_debug_log,                      \
-                            "  Setting an EVAL scope, savestack=%"IVdf"\n",    \
+               "  Setting an EVAL scope, savestack=%"IVdf"\n", \
                (IV)PL_savestack_ix));                          \
     cp = PL_savestack_ix
 
 #define REGCP_UNWIND(cp)                                        \
-    DEBUG_EXECUTE_r(                                            \
+    DEBUG_STATE_r(                                              \
         if (cp != PL_savestack_ix)                             \
-                               PerlIO_printf(Perl_debug_log,           \
-                               "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
+           PerlIO_printf(Perl_debug_log,                       \
+               "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
                (IV)(cp), (IV)PL_savestack_ix));                \
     regcpblow(cp)
 
@@ -1412,7 +1411,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                                 PerlIO_printf( Perl_debug_log,
                                     "%sState: %4"UVxf", Base: 0x%-4"UVxf" uvc=%"UVxf" word=%"UVxf"\n",
                                     failed ? "Fail transition to " : "",
-                                    state, base, uvc, word)
+                                    (UV)state, (UV)base, (UV)uvc, (UV)word)
                             );
                             if ( base ) {
                                 U32 tmp;
@@ -1461,7 +1460,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
                         PerlIO_printf( Perl_debug_log,
                             "%sState: %4"UVxf", Base: 0x%-4"UVxf" uvc=%"UVxf"\n",
                             "All done: ",
-                            state, base, uvc)
+                            (UV)state, (UV)base, (UV)uvc)
                     );
                     if (leftmost) {
                         s = (char*)leftmost;
@@ -1791,7 +1790,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                    s,strend-s,60);
                PerlIO_printf(Perl_debug_log,
                    "Matching stclass %.*s against %s (%d chars)\n",
-                   SvCUR(prop), SvPVX_const(prop),
+                   (int)SvCUR(prop), SvPVX_const(prop),
                     quoted, (int)(strend - s));
            }
        });
@@ -2384,12 +2383,14 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
 
     /* these variables are NOT saved during a recusive RFEGMATCH: */
     register I32 nextchr;   /* is always set to UCHARAT(locinput) */
-    bool result;           /* return value of S_regmatch */
+    bool result = 0;       /* return value of S_regmatch */
     int depth = 0;         /* depth of recursion */
     regmatch_state *yes_state = NULL; /* state to pop to on success of
                                                            subpattern */
     U32 state_num;
     
+    I32 parenfloor = 0;
+
 #ifdef DEBUGGING
     GET_RE_DEBUG_FLAGS_DECL;
     PL_regindent++;
@@ -3407,8 +3408,8 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
 
        case CURLYX: {
                /* No need to save/restore up to this paren */
-               I32 parenfloor = scan->flags;
-
+               parenfloor = scan->flags;
+               
                /* Dave says:
                   
                   CURLYX and WHILEM are always paired: they're the moral
@@ -3941,11 +3942,19 @@ S_regmatch(pTHX_ const regmatch_info *reginfo, regnode *prog)
 
                             to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
                             to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
-
+#ifdef EBCDIC
+                            ST.c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXLEN, 0,
+                                                   ckWARN(WARN_UTF8) ?
+                                                    0 : UTF8_ALLOW_ANY);
+                            ST.c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXLEN, 0,
+                                                    ckWARN(WARN_UTF8) ?
+                                                    0 : UTF8_ALLOW_ANY);
+#else
                             ST.c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
-                                                uniflags);
+                                                   uniflags);
                             ST.c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
-                                                uniflags);
+                                                   uniflags);
+#endif
                        }
                        else {
                            ST.c2 = ST.c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
@@ -4340,8 +4349,8 @@ yes_final:
            st = SLAB_LAST(PL_regmatch_slab);
        }
        depth -= (st - yes_state);
-       DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATES (%d..%d)\n",
-           depth+1, depth+(st - yes_state)));
+       DEBUG_STATE_r(PerlIO_printf(Perl_debug_log, "POP STATES (%"UVuf"..%"UVuf")\n",
+           (UV)(depth+1), (UV)(depth+(st - yes_state))));
        st = yes_state;
        yes_state = st->u.yes.prev_yes_state;
        PL_regmatch_state = st;