[perl #45513] Test failures on amd64-freebsd 6.2
[p5sagit/p5-mst-13.2.git] / regcomp.c
index 4e146b7..dd48f3c 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -1405,7 +1405,20 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs
                     /* store the codepoint in the bitmap, and if its ascii
                        also store its folded equivelent. */
                     TRIE_BITMAP_SET(trie,uvc);
-                    if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
+
+                   /* store the folded codepoint */
+                   if ( folder ) TRIE_BITMAP_SET(trie,folder[ uvc ]);
+
+                   if ( !UTF ) {
+                       /* store first byte of utf8 representation of
+                          codepoints in the 127 < uvc < 256 range */
+                       if (127 < uvc && uvc < 192) {
+                           TRIE_BITMAP_SET(trie,194);
+                       } else if (191 < uvc ) {
+                           TRIE_BITMAP_SET(trie,195);
+                       /* && uvc < 256 -- we know uvc is < 256 already */
+                       }
+                   }
                     set_bit = 0; /* We've done our bit :-) */
                 }
             } else {
@@ -3297,7 +3310,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp,
                                        SvUTF8(sv) && SvMAGICAL(sv) ?
                                        mg_find(sv, PERL_MAGIC_utf8) : NULL;
                                    if (mg && mg->mg_len >= 0)
-                                       mg->mg_len += CHR_SVLEN(last_str);
+                                       mg->mg_len += CHR_SVLEN(last_str) - l;
                                }
                                data->last_end += l * (mincount - 1);
                            }
@@ -4243,21 +4256,21 @@ redo_first_pass:
     r->prelen = plen;
     r->extflags = pm_flags;
     {
-        bool has_k     = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
+        bool has_p     = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY);
        bool has_minus = ((r->extflags & RXf_PMf_STD_PMMOD) != RXf_PMf_STD_PMMOD);
        bool has_runon = ((RExC_seen & REG_SEEN_RUN_ON_COMMENT)==REG_SEEN_RUN_ON_COMMENT);
        U16 reganch = (U16)((r->extflags & RXf_PMf_STD_PMMOD) >> 12);
        const char *fptr = STD_PAT_MODS;        /*"msix"*/
        char *p;
-        r->wraplen = r->prelen + has_minus + has_k + has_runon
+        r->wraplen = r->prelen + has_minus + has_p + has_runon
             + (sizeof(STD_PAT_MODS) - 1)
             + (sizeof("(?:)") - 1);
 
         Newx(r->wrapped, r->wraplen + 1, char );
         p = r->wrapped;
         *p++='('; *p++='?';
-        if (has_k)
-            *p++ = KEEPCOPY_PAT_MOD; /*'k'*/
+        if (has_p)
+            *p++ = KEEPCOPY_PAT_MOD; /*'p'*/
         {
             char *r = p + (sizeof(STD_PAT_MODS) - 1) + has_minus - 1;
             char *colon = r + 1;
@@ -4362,7 +4375,7 @@ reStudy:
 #endif    
 
     /* Dig out information for optimizations. */
-    r->extflags = pm_flags; /* Again? */
+    r->extflags = RExC_flags; /* was pm_op */
     /*dmq: removed as part of de-PMOP: pm->op_pmflags = RExC_flags; */
  
     if (UTF)
@@ -4751,11 +4764,34 @@ reStudy:
         r->paren_names = (HV*)SvREFCNT_inc(RExC_paren_names);
     else
         r->paren_names = NULL;
-    if (r->prelen == 3 && strnEQ("\\s+", r->precomp, 3)) /* precomp = "\\s+)" */
-       r->extflags |= RXf_WHITE;
+
+#ifdef STUPID_PATTERN_CHECKS            
+    if (r->prelen == 0)
+        r->extflags |= RXf_NULL;
+    if (r->extflags & RXf_SPLIT && r->prelen == 1 && r->precomp[0] == ' ')
+        /* XXX: this should happen BEFORE we compile */
+        r->extflags |= (RXf_SKIPWHITE|RXf_WHITE); 
+    else if (r->prelen == 3 && memEQ("\\s+", r->precomp, 3))
+        r->extflags |= RXf_WHITE;
     else if (r->prelen == 1 && r->precomp[0] == '^')
         r->extflags |= RXf_START_ONLY;
-
+#else
+    if (r->extflags & RXf_SPLIT && r->prelen == 1 && r->precomp[0] == ' ')
+            /* XXX: this should happen BEFORE we compile */
+            r->extflags |= (RXf_SKIPWHITE|RXf_WHITE); 
+    else {
+        regnode *first = ri->program + 1;
+        U8 fop = OP(first);
+        U8 nop = OP(NEXTOPER(first));
+        
+        if (PL_regkind[fop] == NOTHING && nop == END)
+            r->extflags |= RXf_NULL;
+        else if (PL_regkind[fop] == BOL && nop == END)
+            r->extflags |= RXf_START_ONLY;
+        else if (fop == PLUS && nop ==SPACE && OP(regnext(first))==END)
+            r->extflags |= RXf_WHITE;    
+    }
+#endif
 #ifdef DEBUGGING
     if (RExC_paren_names) {
         ri->name_list_idx = add_data( pRExC_state, 1, "p" );
@@ -4803,18 +4839,18 @@ Perl_reg_named_buff(pTHX_ REGEXP * const rx, SV * const key, SV * const value,
 {
     PERL_UNUSED_ARG(value);
 
-    if (flags & RXf_HASH_FETCH) {
+    if (flags & RXapif_FETCH) {
         return reg_named_buff_fetch(rx, key, flags);
-    } else if (flags & (RXf_HASH_STORE | RXf_HASH_DELETE | RXf_HASH_CLEAR)) {
+    } else if (flags & (RXapif_STORE | RXapif_DELETE | RXapif_CLEAR)) {
         Perl_croak(aTHX_ PL_no_modify);
         return NULL;
-    } else if (flags & RXf_HASH_EXISTS) {
+    } else if (flags & RXapif_EXISTS) {
         return reg_named_buff_exists(rx, key, flags)
             ? &PL_sv_yes
             : &PL_sv_no;
-    } else if (flags & RXf_HASH_REGNAMES) {
+    } else if (flags & RXapif_REGNAMES) {
         return reg_named_buff_all(rx, flags);
-    } else if (flags & (RXf_HASH_SCALAR | RXf_HASH_REGNAMES_COUNT)) {
+    } else if (flags & (RXapif_SCALAR | RXapif_REGNAMES_COUNT)) {
         return reg_named_buff_scalar(rx, flags);
     } else {
         Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff", (int)flags);
@@ -4828,9 +4864,9 @@ Perl_reg_named_buff_iter(pTHX_ REGEXP * const rx, const SV * const lastkey,
 {
     PERL_UNUSED_ARG(lastkey);
 
-    if (flags & RXf_HASH_FIRSTKEY)
+    if (flags & RXapif_FIRSTKEY)
         return reg_named_buff_firstkey(rx, flags);
-    else if (flags & RXf_HASH_NEXTKEY)
+    else if (flags & RXapif_NEXTKEY)
         return reg_named_buff_nextkey(rx, flags);
     else {
         Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_iter", (int)flags);
@@ -4843,7 +4879,7 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const rx, SV * const namesv, const U32
 {
     AV *retarray = NULL;
     SV *ret;
-    if (flags & RXf_HASH_ALL)
+    if (flags & RXapif_ALL)
         retarray=newAV();
 
     if (rx && rx->paren_names) {
@@ -4881,7 +4917,7 @@ Perl_reg_named_buff_exists(pTHX_ REGEXP * const rx, SV * const key,
                            const U32 flags)
 {
     if (rx && rx->paren_names) {
-        if (flags & RXf_HASH_ALL) {
+        if (flags & RXapif_ALL) {
             return hv_exists_ent(rx->paren_names, key, 0);
         } else {
            SV *sv = CALLREG_NAMED_BUFF_FETCH(rx, key, flags);
@@ -4902,7 +4938,7 @@ Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const rx, const U32 flags)
 {
     (void)hv_iterinit(rx->paren_names);
 
-    return CALLREG_NAMED_BUFF_NEXTKEY(rx, NULL, flags & ~RXf_HASH_FIRSTKEY);
+    return CALLREG_NAMED_BUFF_NEXTKEY(rx, NULL, flags & ~RXapif_FIRSTKEY);
 }
 
 SV*
@@ -4925,7 +4961,7 @@ Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const rx, const U32 flags)
                     break;
                 }
             }
-            if (parno || flags & RXf_HASH_ALL) {
+            if (parno || flags & RXapif_ALL) {
                 STRLEN len;
                 char *pv = HePV(temphe, len);
                 return newSVpvn(pv,len);
@@ -4943,10 +4979,10 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const rx, const U32 flags)
     I32 length;
 
     if (rx && rx->paren_names) {
-        if (flags & (RXf_HASH_ALL | RXf_HASH_REGNAMES_COUNT)) {
+        if (flags & (RXapif_ALL | RXapif_REGNAMES_COUNT)) {
             return newSViv(HvTOTALKEYS(rx->paren_names));
-        } else if (flags & RXf_HASH_ONE) {
-            ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXf_HASH_REGNAMES));
+        } else if (flags & RXapif_ONE) {
+            ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
             av = (AV*)SvRV(ret);
             length = av_len(av);
             return newSViv(length + 1);
@@ -4981,7 +5017,7 @@ Perl_reg_named_buff_all(pTHX_ REGEXP * const rx, const U32 flags)
                     break;
                 }
             }
-            if (parno || flags & RXf_HASH_ALL) {
+            if (parno || flags & RXapif_ALL) {
                 STRLEN len;
                 char *pv = HePV(temphe, len);
                 av_push(av, newSVpvn(pv,len));
@@ -5004,13 +5040,13 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const rx, const I32 paren, SV * cons
         return;
     } 
     else               
-    if (paren == RXf_PREMATCH && rx->offs[0].start != -1) {
+    if (paren == RX_BUFF_IDX_PREMATCH && rx->offs[0].start != -1) {
         /* $` */
        i = rx->offs[0].start;
        s = rx->subbeg;
     }
     else 
-    if (paren == RXf_POSTMATCH && rx->offs[0].end != -1) {
+    if (paren == RX_BUFF_IDX_POSTMATCH && rx->offs[0].end != -1) {
         /* $' */
        s = rx->subbeg + rx->offs[0].end;
        i = rx->sublen - rx->offs[0].end;
@@ -5089,7 +5125,7 @@ Perl_reg_numbered_buff_length(pTHX_ REGEXP * const rx, const SV * const sv,
     /* Some of this code was originally in C<Perl_magic_len> in F<mg.c> */
        switch (paren) {
       /* $` / ${^PREMATCH} */
-      case RXf_PREMATCH:
+      case RX_BUFF_IDX_PREMATCH:
         if (rx->offs[0].start != -1) {
                        i = rx->offs[0].start;
                        if (i > 0) {
@@ -5100,7 +5136,7 @@ Perl_reg_numbered_buff_length(pTHX_ REGEXP * const rx, const SV * const sv,
            }
         return 0;
       /* $' / ${^POSTMATCH} */
-      case RXf_POSTMATCH:
+      case RX_BUFF_IDX_POSTMATCH:
            if (rx->offs[0].end != -1) {
                        i = rx->sublen - rx->offs[0].end;
                        if (i > 0) {
@@ -5272,7 +5308,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
     register regnode *ender = NULL;
     register I32 parno = 0;
     I32 flags;
-    const I32 oregflags = RExC_flags;
+    U32 oregflags = RExC_flags;
     bool have_branch = 0;
     bool is_open = 0;
     I32 freeze_paren = 0;
@@ -5871,8 +5907,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                       and must be globally applied -- japhy */
                     switch (*RExC_parse) {
                    CASE_STD_PMMOD_FLAGS_PARSE_SET(flagsp);
-                    case 'o':
-                    case 'g':
+                    case ONCE_PAT_MOD: /* 'o' */
+                    case GLOBAL_PAT_MOD: /* 'g' */
                        if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
                            const I32 wflagbit = *RExC_parse == 'o' ? WASTED_O : WASTED_G;
                            if (! (wastedflags & wflagbit) ) {
@@ -5889,7 +5925,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                        }
                        break;
                        
-                   case 'c':
+                   case CONTINUE_PAT_MOD: /* 'c' */
                        if (SIZE_ONLY && ckWARN(WARN_REGEXP)) {
                            if (! (wastedflags & WASTED_C) ) {
                                wastedflags |= WASTED_GC;
@@ -5902,10 +5938,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                            }
                        }
                        break;
-                   case 'k':
+                   case KEEPCOPY_PAT_MOD: /* 'p' */
                         if (flagsp == &negflags) {
                             if (SIZE_ONLY && ckWARN(WARN_REGEXP))
-                                vWARN(RExC_parse + 1,"Useless use of (?-k)");
+                                vWARN(RExC_parse + 1,"Useless use of (?-p)");
                         } else {
                             *flagsp |= RXf_PMf_KEEPCOPY;
                         }
@@ -5925,6 +5961,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                     case ')':
                         RExC_flags |= posflags;
                         RExC_flags &= ~negflags;
+                        if (paren != ':') {
+                            oregflags |= posflags;
+                            oregflags &= ~negflags;
+                        }
                         nextchar(pRExC_state);
                        if (paren != ':') {
                            *flagp = TRYAGAIN;
@@ -6804,6 +6844,7 @@ tryagain:
     case 0xCE:
         if (!LOC && FOLD) {
             U32 len,cp;
+           len=0; /* silence a spurious compiler warning */
             if ((cp = what_len_TRICKYFOLD_safe(RExC_parse,RExC_end,UTF,len))) {
                 *flagp |= HASWIDTH; /* could be SIMPLE too, but needs a handler in regexec.regrepeat */
                 RExC_parse+=len-1; /* we get one from nextchar() as well. :-( */
@@ -7029,6 +7070,8 @@ tryagain:
                        goto parse_named_seq;
                }   }
                num = atoi(RExC_parse);
+               if (isg && num == 0)
+                   vFAIL("Reference to invalid group 0");
                 if (isrel) {
                     num = RExC_npar - num;
                     if (num < 1)
@@ -8012,12 +8055,16 @@ parseit:
                {
                    if (isLOWER(prevvalue)) {
                        for (i = prevvalue; i <= ceilvalue; i++)
-                           if (isLOWER(i))
+                           if (isLOWER(i) && !ANYOF_BITMAP_TEST(ret,i)) {
+                               stored++;
                                ANYOF_BITMAP_SET(ret, i);
+                           }
                    } else {
                        for (i = prevvalue; i <= ceilvalue; i++)
-                           if (isUPPER(i))
+                           if (isUPPER(i) && !ANYOF_BITMAP_TEST(ret,i)) {
+                               stored++;
                                ANYOF_BITMAP_SET(ret, i);
+                           }
                    }
                }
                else
@@ -8614,6 +8661,27 @@ S_regcurly(register const char *s)
 /*
  - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
  */
+#ifdef DEBUGGING
+void 
+S_regdump_extflags(pTHX_ const char *lead, const U32 flags) {
+    int bit;
+    int set=0;
+    for (bit=0; bit<32; bit++) {
+        if (flags & (1<<bit)) {
+            if (!set++ && lead) 
+                PerlIO_printf(Perl_debug_log, "%s",lead);
+            PerlIO_printf(Perl_debug_log, "%s ",PL_reg_extflags_name[bit]);
+        }              
+    }     
+    if (lead)  {
+        if (set) 
+            PerlIO_printf(Perl_debug_log, "\n");
+        else 
+            PerlIO_printf(Perl_debug_log, "%s[none-set]\n",lead);
+    }            
+}   
+#endif
+
 void
 Perl_regdump(pTHX_ const regexp *r)
 {
@@ -8622,6 +8690,7 @@ Perl_regdump(pTHX_ const regexp *r)
     SV * const sv = sv_newmortal();
     SV *dsv= sv_newmortal();
     RXi_GET_DECL(r,ri);
+    GET_RE_DEBUG_FLAGS_DECL;
 
     (void)dumpuntil(r, ri->program, ri->program + 1, NULL, NULL, sv, 0, 0);
 
@@ -8695,6 +8764,7 @@ Perl_regdump(pTHX_ const regexp *r)
     if (r->extflags & RXf_EVAL_SEEN)
        PerlIO_printf(Perl_debug_log, "with eval ");
     PerlIO_printf(Perl_debug_log, "\n");
+    DEBUG_FLAGS_r(regdump_extflags("r->extflags: ",r->extflags));            
 #else
     PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(r);
@@ -8734,7 +8804,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
            pv_pretty(dsv, STRING(o), STR_LEN(o), 60, 
                PL_colors[0], PL_colors[1],
                PERL_PV_ESCAPE_UNI_DETECT |
-               PERL_PV_PRETTY_ELIPSES    |
+               PERL_PV_PRETTY_ELLIPSES   |
                PERL_PV_PRETTY_LTGT    
             ); 
        Perl_sv_catpvf(aTHX_ sv, " %s", s );
@@ -8826,7 +8896,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o)
     } else if (k == LOGICAL)
        Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags);     /* 2: embedded, otherwise 1 */
     else if (k == FOLDCHAR)
-       Perl_sv_catpvf(aTHX_ sv, "[0x%"UVXf"]",ARG(o) );        
+       Perl_sv_catpvf(aTHX_ sv, "[0x%"UVXf"]", PTR2UV(ARG(o)) );
     else if (k == ANYOF) {
        int i, rangestart = -1;
        const U8 flags = ANYOF_FLAGS(o);
@@ -9702,7 +9772,7 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node,
                     elem_ptr ? 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    |
+                           PERL_PV_PRETTY_ELLIPSES    |
                            PERL_PV_PRETTY_LTGT
                             )
                             : "???"