This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
add test for [perl #34682] leaving eval via last in inner runops
[perl5.git] / regcomp.c
diff --git a/regcomp.c b/regcomp.c
index 713669c..bc324ed 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -206,8 +206,8 @@ typedef struct scan_data_t {
  * Forward declarations for pregcomp()'s friends.
  */
 
-static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-                                     0, 0, 0, 0, 0, 0};
+static const scan_data_t zero_scan_data =
+  { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
 
 #define SF_BEFORE_EOL          (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
 #define SF_BEFORE_SEOL         0x1
@@ -779,7 +779,7 @@ and would end up looking like:
            tmp = newSVpv( "", 0 );                                        \
            pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX );         \
        } else {                                                           \
-           tmp = Perl_newSVpvf_nocontext( "%c", uvc );                    \
+           tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc );               \
        }                                                                  \
        av_push( trie->revcharmap, tmp );                                  \
     })
@@ -834,6 +834,7 @@ and would end up looking like:
 STATIC I32
 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags)
 {
+    dVAR;
     /* first pass, loop through and scan words */
     reg_trie_data *trie;
     regnode *cur;
@@ -901,7 +902,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
         const U8 *e  = uc + STR_LEN( noper );
         STRLEN foldlen = 0;
         U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
-        const U8 *scan;
+        const U8 *scan = (U8*)NULL;
 
         for ( ; uc < e ; uc += len ) {
             trie->charcount++;
@@ -921,7 +922,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                 svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 1 );
 
                 if ( !svpp )
-                    Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%X", uvc );
+                    Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
 
                 if ( !SvTRUE( *svpp ) ) {
                     sv_setiv( *svpp, ++trie->uniquecharcount );
@@ -1032,7 +1033,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                     state = newstate;
 
             } else {
-                Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %d", uvc );
+                Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
             }
             /* charid is now 0 if we dont know the char read, or nonzero if we do */
         }
@@ -1070,20 +1071,20 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
 
             for( state=1 ; state < next_alloc ; state ++ ) {
 
-                PerlIO_printf( Perl_debug_log, "\n %04X :", state  );
+                PerlIO_printf( Perl_debug_log, "\n %04"UVXf" :", (UV)state  );
                 if ( ! trie->states[ state ].wordnum ) {
                     PerlIO_printf( Perl_debug_log, "%5s| ","");
                 } else {
-                    PerlIO_printf( Perl_debug_log, "W%04X| ",
+                    PerlIO_printf( Perl_debug_log, "W%04x| ",
                         trie->states[ state ].wordnum
                     );
                 }
                 for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
                     SV **tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
-                    PerlIO_printf( Perl_debug_log, "%s:%3X=%04X | ",
+                    PerlIO_printf( Perl_debug_log, "%s:%3X=%04"UVXf" | ",
                         SvPV_nolen( *tmp ),
                         TRIE_LIST_ITEM(state,charid).forid,
-                        TRIE_LIST_ITEM(state,charid).newstate
+                        (UV)TRIE_LIST_ITEM(state,charid).newstate
                     );
                 }
 
@@ -1244,7 +1245,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                     }
                     state = trie->trans[ state + charid ].next;
                 } else {
-                    Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %d", uvc );
+                    Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
                 }
                 /* charid is now 0 if we dont know the char read, or nonzero if we do */
             }
@@ -1293,16 +1294,16 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
 
             for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
 
-                PerlIO_printf( Perl_debug_log, "%04X : ", TRIE_NODENUM( state ) );
+                PerlIO_printf( Perl_debug_log, "%04"UVXf" : ", (UV)TRIE_NODENUM( state ) );
 
                 for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
-                    PerlIO_printf( Perl_debug_log, "%04X ",
-                        SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
+                    PerlIO_printf( Perl_debug_log, "%04"UVXf" ",
+                        (UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
                 }
                 if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
-                    PerlIO_printf( Perl_debug_log, " (%04X)\n", trie->trans[ state ].check );
+                    PerlIO_printf( Perl_debug_log, " (%04"UVXf")\n", (UV)trie->trans[ state ].check );
                 } else {
-                    PerlIO_printf( Perl_debug_log, " (%04X) W%04X\n", trie->trans[ state ].check,
+                    PerlIO_printf( Perl_debug_log, " (%04"UVXf") W%04X\n", (UV)trie->trans[ state ].check,
                     trie->states[ TRIE_NODENUM( state ) ].wordnum );
                 }
             }
@@ -1411,8 +1412,9 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
         trie->lasttrans = pos + 1;
         Renew( trie->states, laststate + 1, reg_trie_state);
         DEBUG_TRIE_COMPILE_MORE_r(
-                PerlIO_printf( Perl_debug_log, " Alloc: %d Orig: %d elements, Final:%d. Savings of %%%5.2f\n",
-                    ( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ), next_alloc, pos,
+                PerlIO_printf( Perl_debug_log,
+                   " Alloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
+                    ( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ), (IV)next_alloc, (IV)pos,
                     ( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
             );
 
@@ -1445,7 +1447,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
         for( state = 1 ; state < trie->laststate ; state++ ) {
             U32 base = trie->states[ state ].trans.base;
 
-            PerlIO_printf( Perl_debug_log, "#%04X ", state);
+            PerlIO_printf( Perl_debug_log, "#%04"UVXf" ", (UV)state);
 
             if ( trie->states[ state ].wordnum ) {
                 PerlIO_printf( Perl_debug_log, " W%04X", trie->states[ state ].wordnum );
@@ -1453,7 +1455,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                 PerlIO_printf( Perl_debug_log, "%6s", "" );
             }
 
-            PerlIO_printf( Perl_debug_log, " @%04X ", base );
+            PerlIO_printf( Perl_debug_log, " @%04"UVXf" ", (UV)base );
 
             if ( base ) {
                 U32 ofs = 0;
@@ -1463,21 +1465,21 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                          && trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
                         ofs++;
 
-                PerlIO_printf( Perl_debug_log, "+%02X[ ", ofs);
+                PerlIO_printf( Perl_debug_log, "+%02"UVXf"[ ", (UV)ofs);
 
                 for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
                     if ( ( base + ofs >= trie->uniquecharcount ) &&
                          ( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
                          trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
                     {
-                       PerlIO_printf( Perl_debug_log, "%04X ",
-                        trie->trans[ base + ofs - trie->uniquecharcount ].next );
+                       PerlIO_printf( Perl_debug_log, "%04"UVXf" ",
+                        (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
                     } else {
                         PerlIO_printf( Perl_debug_log, "%4s ","   0" );
                     }
                 }
 
-                PerlIO_printf( Perl_debug_log, "]", ofs);
+                PerlIO_printf( Perl_debug_log, "]");
 
             }
             PerlIO_printf( Perl_debug_log, "\n" );
@@ -1573,7 +1575,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
        DEBUG_OPTIMISE_r({
          SV *mysv=sv_newmortal();
          regprop( mysv, scan);
-         PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08X)\n",depth*2,"",SvPV_nolen(mysv),scan);
+         PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n",
+           (int)depth*2, "", SvPV_nolen(mysv), PTR2UV(scan));
        });
 
        if (PL_regkind[(U8)OP(scan)] == EXACT) {
@@ -1653,7 +1656,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                 char *s1 = s0 + STR_LEN(scan) - 1, *s2 = s1 - 4;
                  const char *t0 = "\xcc\x88\xcc\x81";
                  const char *t1 = t0 + 3;
-                
+
                 for (s = s0 + 2;
                      s < s2 && (t = ninstr(s, s1, t0, t1));
                      s = t + 4) {
@@ -1867,7 +1870,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                         DEBUG_OPTIMISE_r({
                             regprop( mysv, tail );
                             PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n",
-                                depth * 2 + 2, "", "Tail node is:", SvPV_nolen( mysv ),
+                                (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen( mysv ),
                                 (RExC_seen_evals) ? "[EVAL]" : ""
                             );
                         });
@@ -1904,7 +1907,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                             DEBUG_OPTIMISE_r({
                                 regprop( mysv, cur);
                                 PerlIO_printf( Perl_debug_log, "%*s%s",
-                                   depth * 2 + 2,"  ", SvPV_nolen( mysv ) );
+                                   (int)depth * 2 + 2,"  ", SvPV_nolen( mysv ) );
 
                                 regprop( mysv, noper);
                                 PerlIO_printf( Perl_debug_log, " -> %s",
@@ -1931,7 +1934,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                                         if (!last ) {
                                             regprop( mysv, first);
                                             PerlIO_printf( Perl_debug_log, "%*s%s",
-                                              depth * 2 + 2, "F:", SvPV_nolen( mysv ) );
+                                              (int)depth * 2 + 2, "F:", SvPV_nolen( mysv ) );
                                             regprop( mysv, NEXTOPER(first) );
                                             PerlIO_printf( Perl_debug_log, " -> %s\n",
                                               SvPV_nolen( mysv ) );
@@ -1941,7 +1944,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                                     DEBUG_OPTIMISE_r({
                                         regprop( mysv, cur);
                                         PerlIO_printf( Perl_debug_log, "%*s%s",
-                                          depth * 2 + 2, "N:", SvPV_nolen( mysv ) );
+                                          (int)depth * 2 + 2, "N:", SvPV_nolen( mysv ) );
                                         regprop( mysv, noper );
                                         PerlIO_printf( Perl_debug_log, " -> %s\n",
                                           SvPV_nolen( mysv ) );
@@ -1951,7 +1954,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                                 if ( last ) {
                                     DEBUG_OPTIMISE_r(
                                         PerlIO_printf( Perl_debug_log, "%*s%s\n",
-                                            depth * 2 + 2, "E:", "**END**" );
+                                            (int)depth * 2 + 2, "E:", "**END**" );
                                     );
                                     make_trie( pRExC_state, startbranch, first, cur, tail, optype );
                                 }
@@ -1972,14 +1975,14 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                         DEBUG_OPTIMISE_r({
                             regprop( mysv, cur);
                             PerlIO_printf( Perl_debug_log,
-                              "%*s%s\t(0x%p,0x%p,0x%p)\n", depth * 2 + 2,
+                              "%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2,
                               "  ", SvPV_nolen( mysv ), first, last, cur);
 
                         });
                         if ( last ) {
                             DEBUG_OPTIMISE_r(
                                 PerlIO_printf( Perl_debug_log, "%*s%s\n",
-                                    depth * 2 + 2, "E:", "==END==" );
+                                    (int)depth * 2 + 2, "E:", "==END==" );
                             );
                             make_trie( pRExC_state, startbranch, first, scan, tail, optype );
                         }
@@ -2384,7 +2387,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
                                SvGROW(last_str, (mincount * l) + 1);
                                repeatcpy(SvPVX(last_str) + l,
                                          SvPVX(last_str), l, mincount - 1);
-                               SvCUR(last_str) *= mincount;
+                               SvCUR_set(last_str, SvCUR(last_str) * mincount);
                                /* Add additional parts. */
                                SvCUR_set(data->last_found,
                                          SvCUR(data->last_found) - l);
@@ -2791,11 +2794,11 @@ Perl_reginitcolors(pTHX)
                PL_colors[i] = ++s;
            }
            else
-               PL_colors[i] = s = "";
+               PL_colors[i] = s = (char *)"";
        }
     } else {
        while (i < 6)
-           PL_colors[i++] = "";
+           PL_colors[i++] = (char *)"";
     }
     PL_colorset = 1;
 }
@@ -2906,11 +2909,11 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
 
     Newz(1304, r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
     if (r->offsets) {
-      r->offsets[0] = RExC_size; 
+       r->offsets[0] = RExC_size;
     }
     DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
-                          "%s %"UVuf" bytes for offset annotations.\n", 
-                          r->offsets ? "Got" : "Couldn't get", 
+                          "%s %"UVuf" bytes for offset annotations.\n",
+                          r->offsets ? "Got" : "Couldn't get",
                           (UV)((2*RExC_size+1) * sizeof(U32))));
 
     RExC_rx = r;
@@ -3225,6 +3228,7 @@ STATIC regnode *
 S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
     /* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
 {
+    dVAR;
     register regnode *ret;             /* Will be the head of the group. */
     register regnode *br;
     register regnode *lastbr;
@@ -3389,7 +3393,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
                    while (isDIGIT(*RExC_parse))
                        RExC_parse++;
                     ret = reganode(pRExC_state, GROUPP, parno);
-                    
+
                    if ((c = *nextchar(pRExC_state)) != ')')
                        vFAIL("Switch condition not recognized");
                  insert_if:
@@ -3511,7 +3515,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
     parse_start = RExC_parse;   /* MJD */
     br = regbranch(pRExC_state, &flags, 1);
     /*     branch_len = (paren != 0); */
-    
+
     if (br == NULL)
        return(NULL);
     if (*RExC_parse == '|') {
@@ -3546,7 +3550,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
            RExC_extralen += 2;         /* Account for LONGJMP. */
        nextchar(pRExC_state);
        br = regbranch(pRExC_state, &flags, 0);
-        
+
        if (br == NULL)
            return(NULL);
        regtail(pRExC_state, lastbr, br);               /* BRANCH -> BRANCH. */
@@ -3773,9 +3777,9 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
                reginsert(pRExC_state, CURLYX,ret);
                                 /* MJD hk */
                 Set_Node_Offset(ret, parse_start+1);
-                Set_Node_Length(ret, 
+                Set_Node_Length(ret,
                                 op == '{' ? (RExC_parse - parse_start) : 1);
-                
+
                if (!SIZE_ONLY && RExC_extralen)
                    NEXT_OFF(ret) = 3;  /* Go over NOTHING to LONGJMP. */
                regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
@@ -4130,9 +4134,9 @@ tryagain:
                                   (U8)(FOLD ? (LOC ? REFFL : REFF) : REF),
                                   num);
                    *flagp |= HASWIDTH;
-                    
+
                     /* override incorrect value set in reganode MJD */
-                    Set_Node_Offset(ret, parse_start+1); 
+                    Set_Node_Offset(ret, parse_start+1);
                     Set_Node_Cur_Length(ret); /* MJD */
                    RExC_parse--;
                    nextchar(pRExC_state);
@@ -5715,12 +5719,12 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l)
             const I32 arry_len = av_len(trie->words)+1;
            I32 word_idx;
            PerlIO_printf(Perl_debug_log,
-                      "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%d%s]\n",
+                      "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%"IVdf"%s]\n",
                       (int)(2*(l+3)), "",
                       trie->wordcount,
                       trie->charcount,
                       trie->uniquecharcount,
-                      trie->laststate-1,
+                      (IV)trie->laststate-1,
                       node->flags ? " EVAL mode" : "");
 
            for (word_idx=0; word_idx < arry_len; word_idx++) {
@@ -5869,16 +5873,15 @@ Perl_regdump(pTHX_ regexp *r)
        PerlIO_printf(Perl_debug_log, "with eval ");
     PerlIO_printf(Perl_debug_log, "\n");
     if (r->offsets) {
-      U32 i;
-      const U32 len = r->offsets[0];
+        U32 i;
+        const U32 len = r->offsets[0];
         GET_RE_DEBUG_FLAGS_DECL;
         DEBUG_OFFSETS_r({
-      PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
-      for (i = 1; i <= len; i++)
-        PerlIO_printf(Perl_debug_log, "%"UVuf"[%"UVuf"] ", 
-                      (UV)r->offsets[i*2-1], 
-                      (UV)r->offsets[i*2]);
-      PerlIO_printf(Perl_debug_log, "\n");
+           PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
+           for (i = 1; i <= len; i++)
+               PerlIO_printf(Perl_debug_log, "%"UVuf"[%"UVuf"] ", 
+                   (UV)r->offsets[i*2-1], (UV)r->offsets[i*2]);
+           PerlIO_printf(Perl_debug_log, "\n");
         });
     }
 #endif /* DEBUGGING */
@@ -6122,6 +6125,7 @@ Perl_re_intuit_string(pTHX_ regexp *prog)
 void
 Perl_pregfree(pTHX_ struct regexp *r)
 {
+    dVAR;
 #ifdef DEBUGGING
     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
     SV *re_debug_flags=get_sv(RE_DEBUG_FLAGS,0);
@@ -6267,7 +6271,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...)
     STRLEN l2 = strlen(pat2);
     char buf[512];
     SV *msv;
-    char *message;
+    const char *message;
 
     if (l1 > 510)
        l1 = 510;
Unnamed repository; edit this file 'description' to name the repository.