Re: [perl #37731] junk and uninit'ed values in tied scalars

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

diff --git a/regcomp.c b/regcomp.c
index 0842448..c26677a 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -512,7 +512,7 @@ S_cl_is_anything(const struct regnode_charclass_class *cl)
            return 1;
     if (!(cl->flags & ANYOF_UNICODE_ALL))
        return 0;
-    if (!ANYOF_BITMAP_TESTALLSET(cl))
+    if (!ANYOF_BITMAP_TESTALLSET((const void*)cl))
        return 0;
     return 1;
 }
@@ -867,7 +867,7 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie,U32 depth)
         if ( tmp ) {
             PerlIO_printf( Perl_debug_log, "%*s", 
                 colwidth,
-                pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
+                pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
                            PL_colors[0], PL_colors[1],
                            (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
                            PERL_PV_ESCAPE_FIRSTCHAR 
@@ -960,7 +960,7 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, U32 next_alloc
            if ( tmp ) {
                 PerlIO_printf( Perl_debug_log, "%*s:%3X=%4"UVXf" | ",
                     colwidth,
-                    pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
+                    pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
                            PL_colors[0], PL_colors[1],
                            (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
                            PERL_PV_ESCAPE_FIRSTCHAR 
@@ -1002,7 +1002,7 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, U32 next_allo
         if ( tmp ) {
             PerlIO_printf( Perl_debug_log, "%*s", 
                 colwidth,
-                pv_pretty(sv, (U8*)SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
+                pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, 
                            PL_colors[0], PL_colors[1],
                            (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) |
                            PERL_PV_ESCAPE_FIRSTCHAR 
@@ -2005,14 +2005,23 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags
          char * const s0 = STRING(scan), *s, *t;
          char * const s1 = s0 + STR_LEN(scan) - 1;
          char * const s2 = s1 - 4;
+#ifdef EBCDIC /* RD tunifold greek 0390 and 03B0 */
+        const char t0[] = "\xaf\x49\xaf\x42";
+#else
          const char t0[] = "\xcc\x88\xcc\x81";
+#endif
          const char * const t1 = t0 + 3;
     
          for (s = s0 + 2;
               s < s2 && (t = ninstr(s, s1, t0, t1));
               s = t + 4) {
+#ifdef EBCDIC
+             if (((U8)t[-1] == 0x68 && (U8)t[-2] == 0xB4) ||
+                 ((U8)t[-1] == 0x46 && (U8)t[-2] == 0xB5))
+#else
               if (((U8)t[-1] == 0xB9 && (U8)t[-2] == 0xCE) ||
                   ((U8)t[-1] == 0x85 && (U8)t[-2] == 0xCF))
+#endif
                    *min -= 4;
          }
     }
@@ -2493,7 +2502,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap,
        }
 #ifdef TRIE_STUDY_OPT  
        else if (OP(scan) == TRIE) {
-           reg_trie_data *trie=RExC_rx->data->data[ ARG(scan) ];
+           reg_trie_data *trie = (reg_trie_data*)RExC_rx->data->data[ ARG(scan) ];
            min += trie->minlen;
            delta += (trie->maxlen - trie->minlen);
            flags &= ~SCF_DO_STCLASS; /* xxx */
@@ -4288,6 +4297,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
     I32 min;
     I32 max = REG_INFTY;
     char *parse_start;
+    const char *maxpos = NULL;
     GET_RE_DEBUG_FLAGS_DECL;
     DEBUG_PARSE("piec");
 
@@ -4301,7 +4311,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
     op = *RExC_parse;
 
     if (op == '{' && regcurly(RExC_parse)) {
-       const char *maxpos = NULL;
+       maxpos = NULL;
         parse_start = RExC_parse; /* MJD */
        next = RExC_parse + 1;
        while (isDIGIT(*next) || *next == ',') {
@@ -5881,11 +5891,27 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, U32 depth)
                         STRLEN foldlen;
                         const UV f = to_uni_fold(natvalue, foldbuf, &foldlen);
 
+#ifdef EBCDIC /* RD t/uni/fold ff and 6b */
+                        if (RExC_precomp[0] == ':' &&
+                            RExC_precomp[1] == '[' &&
+                            (f == 0xDF || f == 0x92)) {
+                            f = NATIVE_TO_UNI(f);
+                        }
+#endif
                         /* If folding and foldable and a single
                          * character, insert also the folded version
                          * to the charclass. */
                         if (f != value) {
+#ifdef EBCDIC /* RD tunifold ligatures s,t fb05, fb06 */
+                            if ((RExC_precomp[0] == ':' &&
+                                 RExC_precomp[1] == '[' &&
+                                 (f == 0xA2 &&
+                                  (value == 0xFB05 || value == 0xFB06))) ?
+                                foldlen == ((STRLEN)UNISKIP(f) - 1) :
+                                foldlen == (STRLEN)UNISKIP(f) )
+#else
                              if (foldlen == (STRLEN)UNISKIP(f))
+#endif
                                  Perl_sv_catpvf(aTHX_ listsv,
                                                 "%04"UVxf"\n", f);
                              else {
@@ -6386,9 +6412,10 @@ Perl_regdump(pTHX_ const regexp *r)
     }
     if (r->check_substr || r->check_utf8)
        PerlIO_printf(Perl_debug_log,
-                     r->check_substr == r->float_substr
-                     && r->check_utf8 == r->float_utf8
-                     ? "(checking floating" : "(checking anchored");
+                     (const char *)
+                     (r->check_substr == r->float_substr
+                      && r->check_utf8 == r->float_utf8
+                      ? "(checking floating" : "(checking anchored"));
     if (r->reganch & ROPT_NOSCAN)
        PerlIO_printf(Perl_debug_log, " noscan");
     if (r->reganch & ROPT_CHECK_ALL)
@@ -6454,7 +6481,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
         * we have no flag "this EXACTish node was UTF-8" 
         * --jhi */
        const char * const s = 
-           pv_pretty(dsv, (U8*)STRING(o), STR_LEN(o), 60, 
+           pv_pretty(dsv, STRING(o), STR_LEN(o), 60, 
                PL_colors[0], PL_colors[1],
                PERL_PV_ESCAPE_UNI_DETECT |
                PERL_PV_PRETTY_ELIPSES    |
@@ -7029,7 +7056,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
                if (elem_ptr) 
                    PerlIO_printf(Perl_debug_log, "%*s%s\n",
                       (int)(2*(l+4)), "",
-                       pv_pretty(sv, (U8*)SvPV_nolen_const(*elem_ptr), SvCUR(*elem_ptr), 60, 
+                       pv_pretty(sv, SvPV_nolen_const(*elem_ptr), SvCUR(*elem_ptr), 60, 
                            PL_colors[0], PL_colors[1],
                            (SvUTF8(*elem_ptr) ? PERL_PV_ESCAPE_UNI : 0) |
                            PERL_PV_PRETTY_ELIPSES    |