X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/62f099ef204889a21560e343bf620c0f18ca5249..3732a8898cd6b079a77349702595031baf8d1009:/regcomp.c diff --git a/regcomp.c b/regcomp.c index a0794b8..a6090ed 100644 --- a/regcomp.c +++ b/regcomp.c @@ -91,12 +91,6 @@ extern const struct regexp_engine my_reg_engine; #include "inline_invlist.c" #include "unicode_constants.h" -#ifdef HAS_ISBLANK -# define hasISBLANK 1 -#else -# define hasISBLANK 0 -#endif - #define HAS_NONLATIN1_FOLD_CLOSURE(i) _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i) #define IS_NON_FINAL_FOLD(c) _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) #define IS_IN_SOME_FOLD_L1(c) _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) @@ -263,6 +257,11 @@ typedef struct RExC_state_t { if (! UTF) JMPENV_JUMP(UTF8_LONGJMP); \ } STMT_END +/* This converts the named class defined in regcomp.h to its equivalent class + * number defined in handy.h. */ +#define namedclass_to_classnum(class) ((int) ((class) / 2)) +#define classnum_to_namedclass(classnum) ((classnum) * 2) + /* About scan_data_t. During optimisation we recurse through the regexp program performing @@ -449,7 +448,7 @@ static const scan_data_t zero_scan_data = IV len = RExC_end - RExC_precomp; \ \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \ + SAVEFREESV(RExC_rx_sv); \ if (len > RegexLengthToShowInErrorMessages) { \ /* chop 10 shorter than the max, to ensure meaning of "..." */ \ len = RegexLengthToShowInErrorMessages - 10; \ @@ -480,7 +479,7 @@ static const scan_data_t zero_scan_data = */ #define vFAIL(m) STMT_START { \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \ + SAVEFREESV(RExC_rx_sv); \ Simple_vFAIL(m); \ } STMT_END @@ -498,7 +497,7 @@ static const scan_data_t zero_scan_data = */ #define vFAIL2(m,a1) STMT_START { \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \ + SAVEFREESV(RExC_rx_sv); \ Simple_vFAIL2(m, a1); \ } STMT_END @@ -517,7 +516,7 @@ static const scan_data_t zero_scan_data = */ #define vFAIL3(m,a1,a2) STMT_START { \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \ + SAVEFREESV(RExC_rx_sv); \ Simple_vFAIL3(m, a1, a2); \ } STMT_END @@ -695,8 +694,6 @@ DEBUG_OPTIMISE_MORE_r(if(data){ \ PerlIO_printf(Perl_debug_log,"\n"); \ }); -static void clear_re(pTHX_ void *r); - /* Mark that we cannot extend a found fixed substring at this point. Update the longest found anchored substring and the longest found floating substrings if needed. */ @@ -752,6 +749,17 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, I32 *min DEBUG_STUDYDATA("commit: ",data,0); } +/* These macros set, clear and test whether the synthetic start class ('ssc', + * given by the parameter) matches an empty string (EOS). This uses the + * 'next_off' field in the node, to save a bit in the flags field. The ssc + * stands alone, so there is never a next_off, so this field is otherwise + * unused. The EOS information is used only for compilation, but theoretically + * it could be passed on to the execution code. This could be used to store + * more than one bit of information, but only this one is currently used. */ +#define SET_SSC_EOS(node) STMT_START { (node)->next_off = TRUE; } STMT_END +#define CLEAR_SSC_EOS(node) STMT_START { (node)->next_off = FALSE; } STMT_END +#define TEST_SSC_EOS(node) cBOOL((node)->next_off) + /* Can match anything (initialization) */ STATIC void S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl) @@ -759,8 +767,8 @@ S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *c PERL_ARGS_ASSERT_CL_ANYTHING; ANYOF_BITMAP_SETALL(cl); - cl->flags = ANYOF_CLASS|ANYOF_EOS|ANYOF_UNICODE_ALL - |ANYOF_NON_UTF8_LATIN1_ALL; + cl->flags = ANYOF_UNICODE_ALL; + SET_SSC_EOS(cl); /* If any portion of the regex is to operate under locale rules, * initialization includes it. The reason this isn't done for all regexes @@ -771,7 +779,7 @@ S_cl_anything(const RExC_state_t *pRExC_state, struct regnode_charclass_class *c * necessary. */ if (RExC_contains_locale) { ANYOF_CLASS_SETALL(cl); /* /l uses class */ - cl->flags |= ANYOF_LOCALE|ANYOF_LOC_FOLD; + cl->flags |= ANYOF_LOCALE|ANYOF_CLASS|ANYOF_LOC_FOLD; } else { ANYOF_CLASS_ZERO(cl); /* Only /l uses class now */ @@ -786,7 +794,7 @@ S_cl_is_anything(const struct regnode_charclass_class *cl) PERL_ARGS_ASSERT_CL_IS_ANYTHING; - for (value = 0; value <= ANYOF_MAX; value += 2) + for (value = 0; value < ANYOF_MAX; value += 2) if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1)) return 1; if (!(cl->flags & ANYOF_UNICODE_ALL)) @@ -820,7 +828,7 @@ S_cl_and(struct regnode_charclass_class *cl, { PERL_ARGS_ASSERT_CL_AND; - assert(and_with->type == ANYOF); + assert(PL_regkind[and_with->type] == ANYOF); /* I (khw) am not sure all these restrictions are necessary XXX */ if (!(ANYOF_CLASS_TEST_ANY_SET(and_with)) @@ -994,11 +1002,7 @@ S_cl_or(const RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, con /* OR char bitmap and class bitmap separately */ for (i = 0; i < ANYOF_BITMAP_SIZE; i++) cl->bitmap[i] |= or_with->bitmap[i]; - if (ANYOF_CLASS_TEST_ANY_SET(or_with)) { - for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++) - cl->classflags[i] |= or_with->classflags[i]; - cl->flags |= ANYOF_CLASS; - } + ANYOF_CLASS_OR(or_with, cl); } else { /* XXXX: logic is complicated, leave it along for a moment. */ cl_anything(pRExC_state, cl); @@ -1548,7 +1552,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs #endif switch (flags) { - case EXACT: break; + case EXACT: break; case EXACTFA: case EXACTFU_SS: case EXACTFU_TRICKYFOLD: @@ -2449,7 +2453,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs RExC_rxi->data->data[ data_slot + TRIE_WORDS_OFFSET ] = (void*)trie_words; RExC_rxi->data->data[ data_slot + 3 ] = (void*)revcharmap; #else - SvREFCNT_dec(revcharmap); + SvREFCNT_dec_NN(revcharmap); #endif return trie->jump ? MADE_JUMP_TRIE @@ -2730,6 +2734,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, UV *min_subtract, b /* XXX I (khw) kind of doubt that this works on platforms where * U8_MAX is above 255 because of lots of other assumptions */ + /* Don't join if the sum can't fit into a single node */ if (oldl + STR_LEN(n) > U8_MAX) break; @@ -2956,34 +2961,6 @@ typedef struct scan_frame { #define SCAN_COMMIT(s, data, m) scan_commit(s, data, m, is_inf) -#define CASE_SYNST_FNC(nAmE) \ -case nAmE: \ - if (flags & SCF_DO_STCLASS_AND) { \ - for (value = 0; value < 256; value++) \ - if (!is_ ## nAmE ## _cp(value)) \ - ANYOF_BITMAP_CLEAR(data->start_class, value); \ - } \ - else { \ - for (value = 0; value < 256; value++) \ - if (is_ ## nAmE ## _cp(value)) \ - ANYOF_BITMAP_SET(data->start_class, value); \ - } \ - break; \ -case N ## nAmE: \ - if (flags & SCF_DO_STCLASS_AND) { \ - for (value = 0; value < 256; value++) \ - if (is_ ## nAmE ## _cp(value)) \ - ANYOF_BITMAP_CLEAR(data->start_class, value); \ - } \ - else { \ - for (value = 0; value < 256; value++) \ - if (!is_ ## nAmE ## _cp(value)) \ - ANYOF_BITMAP_SET(data->start_class, value); \ - } \ - break - - - STATIC I32 S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *minlenp, I32 *deltap, @@ -3175,7 +3152,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, StructCopy(&accum, data->start_class, struct regnode_charclass_class); flags |= SCF_DO_STCLASS_OR; - data->start_class->flags |= ANYOF_EOS; + SET_SSC_EOS(data->start_class); } } @@ -3583,7 +3560,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, * utf8 string, so accept a possible false positive for * latin1-range folds */ if (uc >= 0x100 || - (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) + (!(data->start_class->flags & ANYOF_LOCALE) && !ANYOF_BITMAP_TEST(data->start_class, uc) && (!(data->start_class->flags & ANYOF_LOC_FOLD) || !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc]))) @@ -3611,7 +3588,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } } } - data->start_class->flags &= ~ANYOF_EOS; + CLEAR_SSC_EOS(data->start_class); if (uc < 0x100) data->start_class->flags &= ~ANYOF_UNICODE_ALL; } @@ -3621,7 +3598,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, ANYOF_BITMAP_SET(data->start_class, uc); else data->start_class->flags |= ANYOF_UNICODE_ALL; - data->start_class->flags &= ~ANYOF_EOS; + CLEAR_SSC_EOS(data->start_class); cl_and(data->start_class, and_withp); } flags &= ~SCF_DO_STCLASS; @@ -3660,7 +3637,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, /* Check whether it is compatible with what we know already! */ int compat = 1; if (uc >= 0x100 || - (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) + (!(data->start_class->flags & ANYOF_LOCALE) && !ANYOF_BITMAP_TEST(data->start_class, uc) && !ANYOF_BITMAP_TEST(data->start_class, PL_fold_latin1[uc]))) { @@ -3670,7 +3647,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, ANYOF_BITMAP_ZERO(data->start_class); if (compat) { ANYOF_BITMAP_SET(data->start_class, uc); - data->start_class->flags &= ~ANYOF_EOS; + CLEAR_SSC_EOS(data->start_class); if (OP(scan) == EXACTFL) { /* XXX This set is probably no longer necessary, and * probably wrong as LOCALE now is on in the initial @@ -3737,7 +3714,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } } } - data->start_class->flags &= ~ANYOF_EOS; + CLEAR_SSC_EOS(data->start_class); } cl_and(data->start_class, and_withp); } @@ -3854,7 +3831,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, StructCopy(&this_class, data->start_class, struct regnode_charclass_class); flags |= SCF_DO_STCLASS_OR; - data->start_class->flags |= ANYOF_EOS; + SET_SSC_EOS(data->start_class); } } else { /* Non-zero len */ if (flags & SCF_DO_STCLASS_OR) { @@ -3873,8 +3850,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) && maxcount <= REG_INFTY/3) /* Complement check for big count */ { + /* Fatal warnings may leak the regexp without this: */ + SAVEFREESV(RExC_rx_sv); ckWARNreg(RExC_parse, "Quantifier unexpected on zero-length expression"); + (void)ReREFCNT_inc(RExC_rx_sv); } min += minnext * mincount; @@ -4117,7 +4097,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, else if (OP(scan) == LNBREAK) { if (flags & SCF_DO_STCLASS) { int value = 0; - data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */ + CLEAR_SSC_EOS(data->start_class); /* No match on empty */ if (flags & SCF_DO_STCLASS_AND) { for (value = 0; value < 256; value++) if (!is_VERTWS_cp(value)) @@ -4150,15 +4130,20 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } min++; if (flags & SCF_DO_STCLASS) { - data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */ + int loop_max = 256; + CLEAR_SSC_EOS(data->start_class); /* No match on empty */ /* Some of the logic below assumes that switching locale on will only add false positives. */ switch (PL_regkind[OP(scan)]) { + U8 classnum; + case SANY: default: - do_default: - /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */ +#ifdef DEBUGGING + Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); +#endif + do_default: if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ cl_anything(pRExC_state, data->start_class); break; @@ -4167,7 +4152,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, goto do_default; if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */ value = (ANYOF_BITMAP_TEST(data->start_class,'\n') - || ANYOF_CLASS_TEST_ANY_SET(data->start_class)); + || ANYOF_CLASS_TEST_ANY_SET(data->start_class)); cl_anything(pRExC_state, data->start_class); } if (flags & SCF_DO_STCLASS_AND || !value) @@ -4181,200 +4166,77 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, cl_or(pRExC_state, data->start_class, (struct regnode_charclass_class*)scan); break; - case ALNUM: + case POSIXA: + loop_max = 128; + /* FALL THROUGH */ + case POSIXL: + case POSIXD: + case POSIXU: + classnum = FLAGS(scan); if (flags & SCF_DO_STCLASS_AND) { if (!(data->start_class->flags & ANYOF_LOCALE)) { - ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NWORDCHAR); - if (OP(scan) == ALNUMU) { - for (value = 0; value < 256; value++) { - if (!isWORDCHAR_L1(value)) { - ANYOF_BITMAP_CLEAR(data->start_class, value); - } - } - } else { - for (value = 0; value < 256; value++) { - if (!isALNUM(value)) { - ANYOF_BITMAP_CLEAR(data->start_class, value); - } + ANYOF_CLASS_CLEAR(data->start_class, classnum_to_namedclass(classnum) + 1); + for (value = 0; value < loop_max; value++) { + if (! _generic_isCC(UNI_TO_NATIVE(value), classnum)) { + ANYOF_BITMAP_CLEAR(data->start_class, UNI_TO_NATIVE(value)); } } } } else { - if (data->start_class->flags & ANYOF_LOCALE) - ANYOF_CLASS_SET(data->start_class,ANYOF_WORDCHAR); + if (data->start_class->flags & ANYOF_LOCALE) { + ANYOF_CLASS_SET(data->start_class, classnum_to_namedclass(classnum)); + } + else { /* Even if under locale, set the bits for non-locale * in case it isn't a true locale-node. This will * create false positives if it truly is locale */ - if (OP(scan) == ALNUMU) { - for (value = 0; value < 256; value++) { - if (isWORDCHAR_L1(value)) { - ANYOF_BITMAP_SET(data->start_class, value); - } - } - } else { - for (value = 0; value < 256; value++) { - if (isALNUM(value)) { - ANYOF_BITMAP_SET(data->start_class, value); - } + for (value = 0; value < loop_max; value++) { + if (_generic_isCC(UNI_TO_NATIVE(value), classnum)) { + ANYOF_BITMAP_SET(data->start_class, UNI_TO_NATIVE(value)); } } + } } break; - case NALNUM: + case NPOSIXA: + loop_max = 128; + /* FALL THROUGH */ + case NPOSIXL: + case NPOSIXU: + case NPOSIXD: + classnum = FLAGS(scan); if (flags & SCF_DO_STCLASS_AND) { if (!(data->start_class->flags & ANYOF_LOCALE)) { - ANYOF_CLASS_CLEAR(data->start_class,ANYOF_WORDCHAR); - if (OP(scan) == NALNUMU) { - for (value = 0; value < 256; value++) { - if (isWORDCHAR_L1(value)) { - ANYOF_BITMAP_CLEAR(data->start_class, value); - } + ANYOF_CLASS_CLEAR(data->start_class, classnum_to_namedclass(classnum)); + for (value = 0; value < loop_max; value++) { + if (_generic_isCC(UNI_TO_NATIVE(value), classnum)) { + ANYOF_BITMAP_CLEAR(data->start_class, UNI_TO_NATIVE(value)); } - } else { - for (value = 0; value < 256; value++) { - if (isALNUM(value)) { - ANYOF_BITMAP_CLEAR(data->start_class, value); - } - } - } + } } } else { - if (data->start_class->flags & ANYOF_LOCALE) - ANYOF_CLASS_SET(data->start_class,ANYOF_NWORDCHAR); + if (data->start_class->flags & ANYOF_LOCALE) { + ANYOF_CLASS_SET(data->start_class, classnum_to_namedclass(classnum) + 1); + } + else { /* Even if under locale, set the bits for non-locale in * case it isn't a true locale-node. This will create * false positives if it truly is locale */ - if (OP(scan) == NALNUMU) { - for (value = 0; value < 256; value++) { - if (! isWORDCHAR_L1(value)) { - ANYOF_BITMAP_SET(data->start_class, value); - } - } - } else { - for (value = 0; value < 256; value++) { - if (! isALNUM(value)) { - ANYOF_BITMAP_SET(data->start_class, value); - } - } - } - } - break; - case SPACE: - if (flags & SCF_DO_STCLASS_AND) { - if (!(data->start_class->flags & ANYOF_LOCALE)) { - ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE); - if (OP(scan) == SPACEU) { - for (value = 0; value < 256; value++) { - if (!isSPACE_L1(value)) { - ANYOF_BITMAP_CLEAR(data->start_class, value); - } - } - } else { - for (value = 0; value < 256; value++) { - if (!isSPACE(value)) { - ANYOF_BITMAP_CLEAR(data->start_class, value); - } - } + for (value = 0; value < loop_max; value++) { + if (! _generic_isCC(UNI_TO_NATIVE(value), classnum)) { + ANYOF_BITMAP_SET(data->start_class, UNI_TO_NATIVE(value)); } - } - } - else { - if (data->start_class->flags & ANYOF_LOCALE) { - ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE); } - if (OP(scan) == SPACEU) { - for (value = 0; value < 256; value++) { - if (isSPACE_L1(value)) { - ANYOF_BITMAP_SET(data->start_class, value); - } - } - } else { - for (value = 0; value < 256; value++) { - if (isSPACE(value)) { - ANYOF_BITMAP_SET(data->start_class, value); - } - } - } - } - break; - case NSPACE: - if (flags & SCF_DO_STCLASS_AND) { - if (!(data->start_class->flags & ANYOF_LOCALE)) { - ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE); - if (OP(scan) == NSPACEU) { - for (value = 0; value < 256; value++) { - if (isSPACE_L1(value)) { - ANYOF_BITMAP_CLEAR(data->start_class, value); - } - } - } else { - for (value = 0; value < 256; value++) { - if (isSPACE(value)) { - ANYOF_BITMAP_CLEAR(data->start_class, value); - } - } - } - } - } - else { - if (data->start_class->flags & ANYOF_LOCALE) - ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE); - if (OP(scan) == NSPACEU) { - for (value = 0; value < 256; value++) { - if (!isSPACE_L1(value)) { - ANYOF_BITMAP_SET(data->start_class, value); - } - } + if (PL_regkind[OP(scan)] == NPOSIXD) { + data->start_class->flags |= ANYOF_NON_UTF8_LATIN1_ALL; } - else { - for (value = 0; value < 256; value++) { - if (!isSPACE(value)) { - ANYOF_BITMAP_SET(data->start_class, value); - } - } } } break; - case DIGIT: - if (flags & SCF_DO_STCLASS_AND) { - if (!(data->start_class->flags & ANYOF_LOCALE)) { - ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT); - for (value = 0; value < 256; value++) - if (!isDIGIT(value)) - ANYOF_BITMAP_CLEAR(data->start_class, value); - } - } - else { - if (data->start_class->flags & ANYOF_LOCALE) - ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT); - for (value = 0; value < 256; value++) - if (isDIGIT(value)) - ANYOF_BITMAP_SET(data->start_class, value); - } - break; - case NDIGIT: - if (flags & SCF_DO_STCLASS_AND) { - if (!(data->start_class->flags & ANYOF_LOCALE)) - ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT); - for (value = 0; value < 256; value++) - if (isDIGIT(value)) - ANYOF_BITMAP_CLEAR(data->start_class, value); - } - else { - if (data->start_class->flags & ANYOF_LOCALE) - ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT); - for (value = 0; value < 256; value++) - if (!isDIGIT(value)) - ANYOF_BITMAP_SET(data->start_class, value); - } - break; - CASE_SYNST_FNC(VERTWS); - CASE_SYNST_FNC(HORIZWS); - } if (flags & SCF_DO_STCLASS_OR) cl_and(data->start_class, and_withp); @@ -4477,11 +4339,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, cl_init(pRExC_state, data->start_class); } else { /* AND before and after: combine and continue */ - const int was = (data->start_class->flags & ANYOF_EOS); + const int was = TEST_SSC_EOS(data->start_class); cl_and(data->start_class, &intrnl); if (was) - data->start_class->flags |= ANYOF_EOS; + SET_SSC_EOS(data->start_class); } } } @@ -4549,11 +4411,11 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, *minnextp += min; if (f & SCF_DO_STCLASS_AND) { - const int was = (data->start_class->flags & ANYOF_EOS); + const int was = TEST_SSC_EOS(data.start_class); cl_and(data->start_class, &intrnl); if (was) - data->start_class->flags |= ANYOF_EOS; + SET_SSC_EOS(data->start_class); } if (data) { if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR)) @@ -4565,7 +4427,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, if (RExC_rx->minlen<*minnextp) RExC_rx->minlen=*minnextp; SCAN_COMMIT(pRExC_state, &data_fake, minnextp); - SvREFCNT_dec(data_fake.last_found); + SvREFCNT_dec_NN(data_fake.last_found); if ( data_fake.minlen_fixed != minlenp ) { @@ -4756,7 +4618,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, StructCopy(&accum, data->start_class, struct regnode_charclass_class); flags |= SCF_DO_STCLASS_OR; - data->start_class->flags |= ANYOF_EOS; + SET_SSC_EOS(data->start_class); } } scan= tail; @@ -4872,13 +4734,18 @@ Perl_reginitcolors(pTHX) #ifdef TRIE_STUDY_OPT -#define CHECK_RESTUDY_GOTO \ +#define CHECK_RESTUDY_GOTO_butfirst(dOsomething) \ + STMT_START { \ if ( \ (data.flags & SCF_TRIE_RESTUDY) \ && ! restudied++ \ - ) goto reStudy + ) { \ + dOsomething; \ + goto reStudy; \ + } \ + } STMT_END #else -#define CHECK_RESTUDY_GOTO +#define CHECK_RESTUDY_GOTO_butfirst #endif /* @@ -5005,7 +4872,7 @@ S_has_runtime_code(pTHX_ RExC_state_t * const pRExC_state, OP *expr, * * becomes * - * qr'a\\bc def\'ghi\\\\jkl(?{"this is runtime"})mno' + * qr'a\\bc_______________________def\'ghi\\\\jkl(?{"this is runtime"})mno' * * After eval_sv()-ing that, grab any new code blocks from the returned qr * and merge them with any code blocks of the original regexp. @@ -5058,7 +4925,7 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, /* blank out literal code block */ assert(pat[s] == '('); while (s <= pRExC_state->code_blocks[n].end) { - *p++ = ' '; + *p++ = '_'; s++; } s--; @@ -5091,12 +4958,19 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, * handling */ PL_reg_state.re_reparsing = TRUE; eval_sv(sv, G_SCALAR); - SvREFCNT_dec(sv); + SvREFCNT_dec_NN(sv); SPAGAIN; qr_ref = POPs; PUTBACK; - if (SvTRUE(ERRSV)) - Perl_croak(aTHX_ "%s", SvPVx_nolen_const(ERRSV)); + { + SV * const errsv = ERRSV; + if (SvTRUE_NN(errsv)) + { + Safefree(pRExC_state->code_blocks); + /* use croak_sv ? */ + Perl_croak_nocontext("%s", SvPV_nolen_const(errsv)); + } + } assert(SvROK(qr_ref)); qr = SvRV(qr_ref); assert(SvTYPE(qr) == SVt_REGEXP && RX_ENGINE((REGEXP*)qr)->op_comp); @@ -5123,13 +4997,16 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, /* merge the main (r1) and run-time (r2) code blocks into one */ { - RXi_GET_DECL(((struct regexp*)SvANY(qr)), r2); + RXi_GET_DECL(ReANY((REGEXP *)qr), r2); struct reg_code_block *new_block, *dst; RExC_state_t * const r1 = pRExC_state; /* convenient alias */ int i1 = 0, i2 = 0; if (!r2->num_code_blocks) /* we guessed wrong */ + { + SvREFCNT_dec_NN(qr); return 1; + } Newx(new_block, r1->num_code_blocks + r2->num_code_blocks, @@ -5176,7 +5053,7 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, r1->code_blocks = new_block; } - SvREFCNT_dec(qr); + SvREFCNT_dec_NN(qr); return 1; } @@ -5286,6 +5163,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, I32 minlen = 0; U32 rx_flags; SV * VOL pat; + SV * VOL code_blocksv = NULL; /* these are all flags - maybe they should be turned * into a single int with different bit masks */ @@ -5320,50 +5198,56 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, PL_ASCII = _new_invlist_C_array(ASCII_invlist); PL_Latin1 = _new_invlist_C_array(Latin1_invlist); - PL_L1PosixAlnum = _new_invlist_C_array(L1PosixAlnum_invlist); - PL_PosixAlnum = _new_invlist_C_array(PosixAlnum_invlist); + PL_L1Posix_ptrs[_CC_ALPHANUMERIC] + = _new_invlist_C_array(L1PosixAlnum_invlist); + PL_Posix_ptrs[_CC_ALPHANUMERIC] + = _new_invlist_C_array(PosixAlnum_invlist); - PL_L1PosixAlpha = _new_invlist_C_array(L1PosixAlpha_invlist); - PL_PosixAlpha = _new_invlist_C_array(PosixAlpha_invlist); + PL_L1Posix_ptrs[_CC_ALPHA] + = _new_invlist_C_array(L1PosixAlpha_invlist); + PL_Posix_ptrs[_CC_ALPHA] = _new_invlist_C_array(PosixAlpha_invlist); - PL_PosixBlank = _new_invlist_C_array(PosixBlank_invlist); - PL_XPosixBlank = _new_invlist_C_array(XPosixBlank_invlist); + PL_Posix_ptrs[_CC_BLANK] = _new_invlist_C_array(PosixBlank_invlist); + PL_XPosix_ptrs[_CC_BLANK] = _new_invlist_C_array(XPosixBlank_invlist); - PL_L1Cased = _new_invlist_C_array(L1Cased_invlist); + /* Cased is the same as Alpha in the ASCII range */ + PL_L1Posix_ptrs[_CC_CASED] = _new_invlist_C_array(L1Cased_invlist); + PL_Posix_ptrs[_CC_CASED] = _new_invlist_C_array(PosixAlpha_invlist); - PL_PosixCntrl = _new_invlist_C_array(PosixCntrl_invlist); - PL_XPosixCntrl = _new_invlist_C_array(XPosixCntrl_invlist); + PL_Posix_ptrs[_CC_CNTRL] = _new_invlist_C_array(PosixCntrl_invlist); + PL_XPosix_ptrs[_CC_CNTRL] = _new_invlist_C_array(XPosixCntrl_invlist); - PL_PosixDigit = _new_invlist_C_array(PosixDigit_invlist); + PL_Posix_ptrs[_CC_DIGIT] = _new_invlist_C_array(PosixDigit_invlist); + PL_L1Posix_ptrs[_CC_DIGIT] = _new_invlist_C_array(PosixDigit_invlist); - PL_L1PosixGraph = _new_invlist_C_array(L1PosixGraph_invlist); - PL_PosixGraph = _new_invlist_C_array(PosixGraph_invlist); + PL_L1Posix_ptrs[_CC_GRAPH] = _new_invlist_C_array(L1PosixGraph_invlist); + PL_Posix_ptrs[_CC_GRAPH] = _new_invlist_C_array(PosixGraph_invlist); - PL_L1PosixLower = _new_invlist_C_array(L1PosixLower_invlist); - PL_PosixLower = _new_invlist_C_array(PosixLower_invlist); + PL_L1Posix_ptrs[_CC_LOWER] = _new_invlist_C_array(L1PosixLower_invlist); + PL_Posix_ptrs[_CC_LOWER] = _new_invlist_C_array(PosixLower_invlist); - PL_L1PosixPrint = _new_invlist_C_array(L1PosixPrint_invlist); - PL_PosixPrint = _new_invlist_C_array(PosixPrint_invlist); + PL_L1Posix_ptrs[_CC_PRINT] = _new_invlist_C_array(L1PosixPrint_invlist); + PL_Posix_ptrs[_CC_PRINT] = _new_invlist_C_array(PosixPrint_invlist); - PL_L1PosixPunct = _new_invlist_C_array(L1PosixPunct_invlist); - PL_PosixPunct = _new_invlist_C_array(PosixPunct_invlist); + PL_L1Posix_ptrs[_CC_PUNCT] = _new_invlist_C_array(L1PosixPunct_invlist); + PL_Posix_ptrs[_CC_PUNCT] = _new_invlist_C_array(PosixPunct_invlist); - PL_PerlSpace = _new_invlist_C_array(PerlSpace_invlist); - PL_XPerlSpace = _new_invlist_C_array(XPerlSpace_invlist); + PL_Posix_ptrs[_CC_SPACE] = _new_invlist_C_array(PerlSpace_invlist); + PL_XPosix_ptrs[_CC_SPACE] = _new_invlist_C_array(XPerlSpace_invlist); + PL_Posix_ptrs[_CC_PSXSPC] = _new_invlist_C_array(PosixSpace_invlist); + PL_XPosix_ptrs[_CC_PSXSPC] = _new_invlist_C_array(XPosixSpace_invlist); - PL_PosixSpace = _new_invlist_C_array(PosixSpace_invlist); - PL_XPosixSpace = _new_invlist_C_array(XPosixSpace_invlist); + PL_L1Posix_ptrs[_CC_UPPER] = _new_invlist_C_array(L1PosixUpper_invlist); + PL_Posix_ptrs[_CC_UPPER] = _new_invlist_C_array(PosixUpper_invlist); - PL_L1PosixUpper = _new_invlist_C_array(L1PosixUpper_invlist); - PL_PosixUpper = _new_invlist_C_array(PosixUpper_invlist); + PL_XPosix_ptrs[_CC_VERTSPACE] = _new_invlist_C_array(VertSpace_invlist); - PL_VertSpace = _new_invlist_C_array(VertSpace_invlist); + PL_Posix_ptrs[_CC_WORDCHAR] = _new_invlist_C_array(PosixWord_invlist); + PL_L1Posix_ptrs[_CC_WORDCHAR] + = _new_invlist_C_array(L1PosixWord_invlist); - PL_PosixWord = _new_invlist_C_array(PosixWord_invlist); - PL_L1PosixWord = _new_invlist_C_array(L1PosixWord_invlist); - - PL_PosixXDigit = _new_invlist_C_array(PosixXDigit_invlist); - PL_XPosixXDigit = _new_invlist_C_array(XPosixXDigit_invlist); + PL_Posix_ptrs[_CC_XDIGIT] = _new_invlist_C_array(PosixXDigit_invlist); + PL_XPosix_ptrs[_CC_XDIGIT] = _new_invlist_C_array(XPosixXDigit_invlist); PL_HasMultiCharFold = _new_invlist_C_array(_Perl_Multi_Char_Folds_invlist); } @@ -5426,7 +5310,9 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, if (pRExC_state->num_code_blocks) { o = cLISTOPx(expr)->op_first; - assert(o->op_type == OP_PUSHMARK); + assert( o->op_type == OP_PUSHMARK + || (o->op_type == OP_NULL && o->op_targ == OP_PUSHMARK) + || o->op_type == OP_PADRANGE); o = o->op_sibling; } @@ -5450,6 +5336,17 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, SV *sv, *msv = *svp; SV *rx; bool code = 0; + /* we make the assumption here that each op in the list of + * op_siblings maps to one SV pushed onto the stack, + * except for code blocks, with have both an OP_NULL and + * and OP_CONST. + * This allows us to match up the list of SVs against the + * list of OPs to find the next code block. + * + * Note that PUSHMARK PADSV PADSV .. + * is optimised to + * PADRANGE NULL NULL .. + * so the alignment still works. */ if (o) { if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) { assert(n < pRExC_state->num_code_blocks); @@ -5500,7 +5397,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, && RX_ENGINE((REGEXP*)rx)->op_comp) { - RXi_GET_DECL(((struct regexp*)SvANY(rx)), ri); + RXi_GET_DECL(ReANY((REGEXP *)rx), ri); if (ri->num_code_blocks) { int i; /* the presence of an embedded qr// with code means @@ -5515,7 +5412,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, for (i=0; i < ri->num_code_blocks; i++) { struct reg_code_block *src, *dst; STRLEN offset = orig_patlen - + ((struct regexp *)SvANY(rx))->pre_prefix; + + ReANY((REGEXP *)rx)->pre_prefix; assert(n < pRExC_state->num_code_blocks); src = &ri->code_blocks[i]; dst = &pRExC_state->code_blocks[n]; @@ -5755,7 +5652,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_pm_flags = pm_flags; if (runtime_code) { - if (PL_tainting && PL_tainted) + if (TAINTING_get && TAINT_get) Perl_croak(aTHX_ "Eval-group in insecure regular expression"); if (!S_compile_runtime_code(aTHX_ pRExC_state, exp, plen)) { @@ -5805,11 +5702,23 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_lastnum=0; RExC_lastparse=NULL; ); + /* reg may croak on us, not giving us a chance to free + pRExC_state->code_blocks. We cannot SAVEFREEPV it now, as we may + need it to survive as long as the regexp (qr/(?{})/). + We must check that code_blocksv is not already set, because we may + have longjmped back. */ + if (pRExC_state->code_blocks && !code_blocksv) { + code_blocksv = newSV_type(SVt_PV); + SAVEFREESV(code_blocksv); + SvPV_set(code_blocksv, (char *)pRExC_state->code_blocks); + SvLEN_set(code_blocksv, 1); /*sufficient to make sv_clear free it*/ + } if (reg(pRExC_state, 0, &flags,1) == NULL) { RExC_precomp = NULL; - Safefree(pRExC_state->code_blocks); return(NULL); } + if (code_blocksv) + SvLEN_set(code_blocksv,0); /* no you can't have it, sv_clear */ /* Here, finished first pass. Get rid of any added setjmp */ if (used_setjump) { @@ -5845,7 +5754,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, of zeroing when in debug mode, thus anything assigned has to happen after that */ rx = (REGEXP*) newSV_type(SVt_REGEXP); - r = (struct regexp*)SvANY(rx); + r = ReANY(rx); Newxc(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode), char, regexp_internal); if ( r == NULL || ri == NULL ) @@ -5867,7 +5776,13 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, ri->num_code_blocks = pRExC_state->num_code_blocks; } else + { + int n; + for (n = 0; n < pRExC_state->num_code_blocks; n++) + if (pRExC_state->code_blocks[n].src_regex) + SAVEFREESV(pRExC_state->code_blocks[n].src_regex); SAVEFREEPV(pRExC_state->code_blocks); + } { bool has_p = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY); @@ -5898,8 +5813,8 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, + (sizeof(STD_PAT_MODS) - 1) + (sizeof("(?:)") - 1); - p = sv_grow(MUTABLE_SV(rx), wraplen + 1); /* +1 for the ending NUL */ - SvPOK_on(rx); + Newx(p, wraplen + 1, char); /* +1 for the ending NUL */ + r->xpv_len_u.xpvlenu_pv = p; if (RExC_utf8) SvFLAGS(rx) |= SVf_UTF8; *p++='('; *p++='?'; @@ -5934,7 +5849,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, *p++ = '\n'; *p++ = ')'; *p = 0; - SvCUR_set(rx, p - SvPVX_const(rx)); + SvCUR_set(rx, p - RX_WRAPPED(rx)); } r->intflags = 0; @@ -6002,11 +5917,6 @@ reStudy: RExC_seen |= REG_TOP_LEVEL_BRANCHES; else RExC_seen &= ~REG_TOP_LEVEL_BRANCHES; - if (data.last_found) { - SvREFCNT_dec(data.longest_fixed); - SvREFCNT_dec(data.longest_float); - SvREFCNT_dec(data.last_found); - } StructCopy(&zero_scan_data, &data, scan_data_t); } #else @@ -6172,6 +6082,10 @@ reStudy: data.longest_float = newSVpvs(""); data.last_found = newSVpvs(""); data.longest = &(data.longest_fixed); + ENTER_with_name("study_chunk"); + SAVEFREESV(data.longest_fixed); + SAVEFREESV(data.longest_float); + SAVEFREESV(data.last_found); first = scan; if (!ri->regstclass) { cl_init(pRExC_state, &ch_class); @@ -6186,7 +6100,7 @@ reStudy: SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag,0); - CHECK_RESTUDY_GOTO; + CHECK_RESTUDY_GOTO_butfirst(LEAVE_with_name("study_chunk")); if ( RExC_npar == 1 && data.longest == &(data.longest_fixed) @@ -6196,7 +6110,6 @@ reStudy: && (!(RExC_seen & REG_SEEN_GPOS) || (r->extflags & RXf_ANCH_GPOS))) r->extflags |= RXf_CHECK_ALL; scan_commit(pRExC_state, &data,&minlen,0); - SvREFCNT_dec(data.last_found); longest_float_length = CHR_SVLEN(data.longest_float); @@ -6219,10 +6132,10 @@ reStudy: r->float_max_offset = data.offset_float_max; if (data.offset_float_max < I32_MAX) /* Don't offset infinity */ r->float_max_offset -= data.lookbehind_float; + SvREFCNT_inc_simple_void_NN(data.longest_float); } else { r->float_substr = r->float_utf8 = NULL; - SvREFCNT_dec(data.longest_float); longest_float_length = 0; } @@ -6241,12 +6154,13 @@ reStudy: data.flags & SF_FIX_BEFORE_MEOL)) { r->anchored_offset = data.offset_fixed - data.lookbehind_fixed; + SvREFCNT_inc_simple_void_NN(data.longest_fixed); } else { r->anchored_substr = r->anchored_utf8 = NULL; - SvREFCNT_dec(data.longest_fixed); longest_fixed_length = 0; } + LEAVE_with_name("study_chunk"); if (ri->regstclass && (OP(ri->regstclass) == REG_ANY || OP(ri->regstclass) == SANY)) @@ -6254,11 +6168,11 @@ reStudy: if ((!(r->anchored_substr || r->anchored_utf8) || r->anchored_offset) && stclass_flag - && !(data.start_class->flags & ANYOF_EOS) + && ! TEST_SSC_EOS(data.start_class) && !cl_is_anything(data.start_class)) { const U32 n = add_data(pRExC_state, 1, "f"); - data.start_class->flags |= ANYOF_IS_SYNTHETIC; + OP(data.start_class) = ANYOF_SYNTHETIC; Newx(RExC_rxi->data->data[n], 1, struct regnode_charclass_class); @@ -6321,16 +6235,16 @@ reStudy: minlen = study_chunk(pRExC_state, &scan, &minlen, &fake, scan + RExC_size, &data, -1, NULL, NULL, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS,0); - CHECK_RESTUDY_GOTO; + CHECK_RESTUDY_GOTO_butfirst(NOOP); r->check_substr = r->check_utf8 = r->anchored_substr = r->anchored_utf8 = r->float_substr = r->float_utf8 = NULL; - if (!(data.start_class->flags & ANYOF_EOS) + if (! TEST_SSC_EOS(data.start_class) && !cl_is_anything(data.start_class)) { const U32 n = add_data(pRExC_state, 1, "f"); - data.start_class->flags |= ANYOF_IS_SYNTHETIC; + OP(data.start_class) = ANYOF_SYNTHETIC; Newx(RExC_rxi->data->data[n], 1, struct regnode_charclass_class); @@ -6395,7 +6309,7 @@ reStudy: r->extflags |= RXf_NULL; else if (PL_regkind[fop] == BOL && OP(NEXTOPER(first)) == END) r->extflags |= RXf_START_ONLY; - else if (fop == PLUS && OP(NEXTOPER(first)) == SPACE + else if (fop == PLUS && PL_regkind[OP(NEXTOPER(first))] == POSIXD && FLAGS(NEXTOPER(first)) == _CC_SPACE && OP(regnext(first)) == END) r->extflags |= RXf_WHITE; } @@ -6450,7 +6364,7 @@ Perl_reg_named_buff(pTHX_ REGEXP * const rx, SV * const key, SV * const value, if (flags & RXapif_FETCH) { return reg_named_buff_fetch(rx, key, flags); } else if (flags & (RXapif_STORE | RXapif_DELETE | RXapif_CLEAR)) { - Perl_croak_no_modify(aTHX); + Perl_croak_no_modify(); return NULL; } else if (flags & RXapif_EXISTS) { return reg_named_buff_exists(rx, key, flags) @@ -6489,7 +6403,7 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv, { AV *retarray = NULL; SV *ret; - struct regexp *const rx = (struct regexp *)SvANY(r); + struct regexp *const rx = ReANY(r); PERL_ARGS_ASSERT_REG_NAMED_BUFF_FETCH; @@ -6529,7 +6443,7 @@ bool Perl_reg_named_buff_exists(pTHX_ REGEXP * const r, SV * const key, const U32 flags) { - struct regexp *const rx = (struct regexp *)SvANY(r); + struct regexp *const rx = ReANY(r); PERL_ARGS_ASSERT_REG_NAMED_BUFF_EXISTS; @@ -6539,7 +6453,7 @@ Perl_reg_named_buff_exists(pTHX_ REGEXP * const r, SV * const key, } else { SV *sv = CALLREG_NAMED_BUFF_FETCH(r, key, flags); if (sv) { - SvREFCNT_dec(sv); + SvREFCNT_dec_NN(sv); return TRUE; } else { return FALSE; @@ -6553,7 +6467,7 @@ Perl_reg_named_buff_exists(pTHX_ REGEXP * const r, SV * const key, SV* Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const r, const U32 flags) { - struct regexp *const rx = (struct regexp *)SvANY(r); + struct regexp *const rx = ReANY(r); PERL_ARGS_ASSERT_REG_NAMED_BUFF_FIRSTKEY; @@ -6569,7 +6483,7 @@ Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const r, const U32 flags) SV* Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const r, const U32 flags) { - struct regexp *const rx = (struct regexp *)SvANY(r); + struct regexp *const rx = ReANY(r); GET_RE_DEBUG_FLAGS_DECL; PERL_ARGS_ASSERT_REG_NAMED_BUFF_NEXTKEY; @@ -6605,7 +6519,7 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags) SV *ret; AV *av; I32 length; - struct regexp *const rx = (struct regexp *)SvANY(r); + struct regexp *const rx = ReANY(r); PERL_ARGS_ASSERT_REG_NAMED_BUFF_SCALAR; @@ -6616,7 +6530,7 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags) ret = CALLREG_NAMED_BUFF_ALL(r, (flags | RXapif_REGNAMES)); av = MUTABLE_AV(SvRV(ret)); length = av_len(av); - SvREFCNT_dec(ret); + SvREFCNT_dec_NN(ret); return newSViv(length + 1); } else { Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar", (int)flags); @@ -6629,7 +6543,7 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags) SV* Perl_reg_named_buff_all(pTHX_ REGEXP * const r, const U32 flags) { - struct regexp *const rx = (struct regexp *)SvANY(r); + struct regexp *const rx = ReANY(r); AV *av = newAV(); PERL_ARGS_ASSERT_REG_NAMED_BUFF_ALL; @@ -6665,7 +6579,7 @@ void Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, SV * const sv) { - struct regexp *const rx = (struct regexp *)SvANY(r); + struct regexp *const rx = ReANY(r); char *s = NULL; I32 i = 0; I32 s1, t1; @@ -6718,10 +6632,14 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, assert(s >= rx->subbeg); assert(rx->sublen >= (s - rx->subbeg) + i ); if (i >= 0) { - const int oldtainted = PL_tainted; +#if NO_TAINT_SUPPORT + sv_setpvn(sv, s, i); +#else + const int oldtainted = TAINT_get; TAINT_NOT; sv_setpvn(sv, s, i); - PL_tainted = oldtainted; + TAINT_set(oldtainted); +#endif if ( (rx->extflags & RXf_CANY_SEEN) ? (RXp_MATCH_UTF8(rx) && (!i || is_utf8_string((U8*)s, i))) @@ -6731,12 +6649,12 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, } else SvUTF8_off(sv); - if (PL_tainting) { + if (TAINTING_get) { if (RXp_MATCH_TAINTED(rx)) { if (SvTYPE(sv) >= SVt_PVMG) { MAGIC* const mg = SvMAGIC(sv); MAGIC* mgt; - PL_tainted = 1; + TAINT; SvMAGIC_set(sv, mg->mg_moremagic); SvTAINT(sv); if ((mgt = SvMAGIC(sv))) { @@ -6744,7 +6662,7 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, SvMAGIC_set(sv, mg); } } else { - PL_tainted = 1; + TAINT; SvTAINT(sv); } } else @@ -6768,14 +6686,14 @@ Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren, PERL_UNUSED_ARG(value); if (!PL_localizing) - Perl_croak_no_modify(aTHX); + Perl_croak_no_modify(); } I32 Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv, const I32 paren) { - struct regexp *const rx = (struct regexp *)SvANY(r); + struct regexp *const rx = ReANY(r); I32 i; I32 s1, t1; @@ -6881,11 +6799,11 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) if (UTF) do { RExC_parse += UTF8SKIP(RExC_parse); - } while (isALNUM_utf8((U8*)RExC_parse)); + } while (isWORDCHAR_utf8((U8*)RExC_parse)); else do { RExC_parse++; - } while (isALNUM(*RExC_parse)); + } while (isWORDCHAR(*RExC_parse)); } else { RExC_parse++; /* so the <- from the vFAIL is after the offending character */ vFAIL("Group name must start with a non-digit word character"); @@ -7006,7 +6924,6 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) * should eventually be made public */ /* The header definitions are in F */ - #define TO_INTERNAL_SIZE(x) ((x + HEADER_LENGTH) * sizeof(UV)) #define FROM_INTERNAL_SIZE(x) ((x / sizeof(UV)) - HEADER_LENGTH) @@ -7125,7 +7042,9 @@ S_invlist_max(pTHX_ SV* const invlist) PERL_ARGS_ASSERT_INVLIST_MAX; - return FROM_INTERNAL_SIZE(SvLEN(invlist)); + return SvLEN(invlist) == 0 /* This happens under _new_invlist_C_array */ + ? _invlist_len(invlist) + : FROM_INTERNAL_SIZE(SvLEN(invlist)); } PERL_STATIC_INLINE UV* @@ -7198,6 +7117,13 @@ S__new_invlist_C_array(pTHX_ UV* list) Perl_croak(aTHX_ "panic: Incorrect version for previously generated inversion list"); } + /* Initialize the iteration pointer. + * XXX This could be done at compile time in charclass_invlists.h, but I + * (khw) am not confident that the suffixes for specifying the C constant + * UV_MAX are portable, e.g. 'ull' on a 32 bit machine that is configured + * to use 64 bits; might need a Configure probe */ + invlist_iterfinish(invlist); + return invlist; } @@ -7326,9 +7252,7 @@ Perl__invlist_search(pTHX_ SV* const invlist, const UV cp) return -1; } - /* If the code point is before the first element, return failure. (We - * can't combine this with the test above, because we can't get the array - * unless we know the list is non-empty) */ + /* (We can't get the array unless we know the list is non-empty) */ array = invlist_array(invlist); mid = invlist_previous_index(invlist); @@ -7341,8 +7265,8 @@ Perl__invlist_search(pTHX_ SV* const invlist, const UV cp) * And benchmarks show that caching gives better results. We also test * here if the code point is within the bounds of the list. These tests * replace others that would have had to be made anyway to make sure that - * the array bounds were not exceeded, and give us extra information at the - * same time */ + * the array bounds were not exceeded, and these give us extra information + * at the same time */ if (cp >= array[mid]) { if (cp >= array[highest_element]) { return highest_element; @@ -7539,7 +7463,7 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, bool co if (a == NULL || ((len_a = _invlist_len(a)) == 0)) { if (*output == a) { if (a != NULL) { - SvREFCNT_dec(a); + SvREFCNT_dec_NN(a); } } if (*output != b) { @@ -7552,14 +7476,14 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, bool co } else if ((len_b = _invlist_len(b)) == 0) { if (*output == b) { - SvREFCNT_dec(b); + SvREFCNT_dec_NN(b); } /* The complement of an empty list is a list that has everything in it, * so the union with includes everything too */ if (complement_b) { if (a == *output) { - SvREFCNT_dec(a); + SvREFCNT_dec_NN(a); } *output = _new_invlist(1); _append_range_to_invlist(*output, 0, UV_MAX); @@ -7715,7 +7639,8 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, bool co /* We may be removing a reference to one of the inputs */ if (a == *output || b == *output) { - SvREFCNT_dec(*output); + assert(! invlist_is_iterating(*output)); + SvREFCNT_dec_NN(*output); } /* If we've changed b, restore it */ @@ -7783,7 +7708,7 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, *i = invlist_clone(a); if (*i == b) { - SvREFCNT_dec(b); + SvREFCNT_dec_NN(b); } } /* else *i is already 'a' */ @@ -7793,10 +7718,10 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, /* Here, 'a' or 'b' is empty and not using the complement of 'b'. The * intersection must be empty */ if (*i == a) { - SvREFCNT_dec(a); + SvREFCNT_dec_NN(a); } else if (*i == b) { - SvREFCNT_dec(b); + SvREFCNT_dec_NN(b); } *i = _new_invlist(0); return; @@ -7936,7 +7861,8 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, /* We may be removing a reference to one of the inputs */ if (a == *i || b == *i) { - SvREFCNT_dec(*i); + assert(! invlist_is_iterating(*i)); + SvREFCNT_dec_NN(*i); } /* If we've changed b, restore it */ @@ -7985,7 +7911,7 @@ Perl__add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end) _invlist_union(invlist, range_invlist, &invlist); /* The temporary can be freed */ - SvREFCNT_dec(range_invlist); + SvREFCNT_dec_NN(range_invlist); return invlist; } @@ -8009,6 +7935,8 @@ Perl__invlist_invert(pTHX_ SV* const invlist) PERL_ARGS_ASSERT__INVLIST_INVERT; + assert(! invlist_is_iterating(invlist)); + /* The inverse of matching nothing is matching everything */ if (*len_pos == 0) { _append_range_to_invlist(invlist, 0, UV_MAX); @@ -8114,6 +8042,22 @@ S_invlist_iterinit(pTHX_ SV* invlist) /* Initialize iterator for invlist */ *get_invlist_iter_addr(invlist) = 0; } +PERL_STATIC_INLINE void +S_invlist_iterfinish(pTHX_ SV* invlist) +{ + /* Terminate iterator for invlist. This is to catch development errors. + * Any iteration that is interrupted before completed should call this + * function. Functions that add code points anywhere else but to the end + * of an inversion list assert that they are not in the middle of an + * iteration. If they were, the addition would make the iteration + * problematical: if the iteration hadn't reached the place where things + * were being added, it would be ok */ + + PERL_ARGS_ASSERT_INVLIST_ITERFINISH; + + *get_invlist_iter_addr(invlist) = UV_MAX; +} + STATIC bool S_invlist_iternext(pTHX_ SV* invlist, UV* start, UV* end) { @@ -8131,7 +8075,7 @@ S_invlist_iternext(pTHX_ SV* invlist, UV* start, UV* end) PERL_ARGS_ASSERT_INVLIST_ITERNEXT; if (*pos >= len) { - *pos = UV_MAX; /* Force iternit() to be required next time */ + *pos = UV_MAX; /* Force iterinit() to be required next time */ return FALSE; } @@ -8149,6 +8093,14 @@ S_invlist_iternext(pTHX_ SV* invlist, UV* start, UV* end) return TRUE; } +PERL_STATIC_INLINE bool +S_invlist_is_iterating(pTHX_ SV* const invlist) +{ + PERL_ARGS_ASSERT_INVLIST_IS_ITERATING; + + return *(get_invlist_iter_addr(invlist)) < UV_MAX; +} + PERL_STATIC_INLINE UV S_invlist_highest(pTHX_ SV* const invlist) { @@ -8192,6 +8144,8 @@ Perl__invlist_contents(pTHX_ SV* const invlist) PERL_ARGS_ASSERT__INVLIST_CONTENTS; + assert(! invlist_is_iterating(invlist)); + invlist_iterinit(invlist); while (invlist_iternext(invlist, &start, &end)) { if (end == UV_MAX) { @@ -8210,25 +8164,36 @@ Perl__invlist_contents(pTHX_ SV* const invlist) } #endif -#if 0 +#ifdef PERL_ARGS_ASSERT__INVLIST_DUMP void -S_invlist_dump(pTHX_ SV* const invlist, const char * const header) +Perl__invlist_dump(pTHX_ SV* const invlist, const char * const header) { /* Dumps out the ranges in an inversion list. The string 'header' * if present is output on a line before the first range */ UV start, end; + PERL_ARGS_ASSERT__INVLIST_DUMP; + if (header && strlen(header)) { PerlIO_printf(Perl_debug_log, "%s\n", header); } + if (invlist_is_iterating(invlist)) { + PerlIO_printf(Perl_debug_log, "Can't dump because is in middle of iterating\n"); + return; + } + invlist_iterinit(invlist); while (invlist_iternext(invlist, &start, &end)) { if (end == UV_MAX) { PerlIO_printf(Perl_debug_log, "0x%04"UVXf" .. INFINITY\n", start); } + else if (end != start) { + PerlIO_printf(Perl_debug_log, "0x%04"UVXf" .. 0x%04"UVXf"\n", + start, end); + } else { - PerlIO_printf(Perl_debug_log, "0x%04"UVXf" .. 0x%04"UVXf"\n", start, end); + PerlIO_printf(Perl_debug_log, "0x%04"UVXf"\n", start); } } } @@ -8313,6 +8278,7 @@ S__invlistEQ(pTHX_ SV* const a, SV* const b, bool complement_b) #undef INVLIST_ZERO_OFFSET #undef INVLIST_ITER_OFFSET #undef INVLIST_VERSION_ID +#undef INVLIST_PREVIOUS_INDEX_OFFSET /* End of inversion list object */ @@ -8605,7 +8571,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) #ifdef DEBUGGING /* Yes this does cause a memory leak in debugging Perls */ if (!av_store(RExC_paren_name_list, RExC_npar, SvREFCNT_inc(svname))) - SvREFCNT_dec(svname); + SvREFCNT_dec_NN(svname); #endif /*sv_dump(sv_dat);*/ @@ -9498,6 +9464,16 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) ret = reg_node(pRExC_state, OPFAIL); return ret; } + else if (max == 0) { /* replace {0} with a nothing node */ + if (SIZE_ONLY) { + RExC_size = PREVOPER(RExC_size) - regarglen[(U8)NOTHING]; + } + else { + RExC_emit = orig_emit; + } + ret = reg_node(pRExC_state, NOTHING); + return ret; + } do_curly: if ((flags&SIMPLE)) { @@ -9596,10 +9572,12 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } nest_check: if (!SIZE_ONLY && !(flags&(HASWIDTH|POSTPONED)) && max > REG_INFTY/3) { + SAVEFREESV(RExC_rx_sv); /* in case of fatal warnings */ ckWARN3reg(RExC_parse, "%.*s matches null string many times", (int)(RExC_parse >= origparse ? RExC_parse - origparse : 0), origparse); + (void)ReREFCNT_inc(RExC_rx_sv); } if (RExC_parse < RExC_end && *RExC_parse == '?') { @@ -10063,10 +10041,14 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) I32 flags; char *parse_start = RExC_parse; U8 op; + int invert = 0; + GET_RE_DEBUG_FLAGS_DECL; - DEBUG_PARSE("atom"); + *flagp = WORST; /* Tentatively. */ + DEBUG_PARSE("atom"); + PERL_ARGS_ASSERT_REGATOM; tryagain: @@ -10161,6 +10143,7 @@ tryagain: literal text handling code. */ switch ((U8)*++RExC_parse) { + U8 arg; /* Special Escapes */ case 'A': RExC_seen_zerolen++; @@ -10201,22 +10184,14 @@ tryagain: ret = reg_node(pRExC_state, CLUMP); *flagp |= HASWIDTH; goto finish_meta_pat; - case 'w': - op = ALNUM + get_regex_charset(RExC_flags); - if (op > ALNUMA) { /* /aa is same as /a */ - op = ALNUMA; - } - ret = reg_node(pRExC_state, op); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; + case 'W': - op = NALNUM + get_regex_charset(RExC_flags); - if (op > NALNUMA) { /* /aa is same as /a */ - op = NALNUMA; - } - ret = reg_node(pRExC_state, op); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; + invert = 1; + /* FALLTHROUGH */ + case 'w': + arg = ANYOF_WORDCHAR; + goto join_posix; + case 'b': RExC_seen_zerolen++; RExC_seen |= REG_SEEN_LOOKBEHIND; @@ -10239,60 +10214,62 @@ tryagain: FLAGS(ret) = get_regex_charset(RExC_flags); *flagp |= SIMPLE; goto finish_meta_pat; - case 's': - op = SPACE + get_regex_charset(RExC_flags); - if (op > SPACEA) { /* /aa is same as /a */ - op = SPACEA; - } - ret = reg_node(pRExC_state, op); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; - case 'S': - op = NSPACE + get_regex_charset(RExC_flags); - if (op > NSPACEA) { /* /aa is same as /a */ - op = NSPACEA; - } - ret = reg_node(pRExC_state, op); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; + case 'D': - op = NDIGIT; - goto join_D_and_d; + invert = 1; + /* FALLTHROUGH */ case 'd': - op = DIGIT; - join_D_and_d: - { - U8 offset = get_regex_charset(RExC_flags); - if (offset == REGEX_UNICODE_CHARSET) { - offset = REGEX_DEPENDS_CHARSET; - } - else if (offset == REGEX_ASCII_MORE_RESTRICTED_CHARSET) { - offset = REGEX_ASCII_RESTRICTED_CHARSET; - } - op += offset; - } - ret = reg_node(pRExC_state, op); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; + arg = ANYOF_DIGIT; + goto join_posix; + case 'R': ret = reg_node(pRExC_state, LNBREAK); *flagp |= HASWIDTH|SIMPLE; goto finish_meta_pat; - case 'h': - ret = reg_node(pRExC_state, HORIZWS); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; + case 'H': - ret = reg_node(pRExC_state, NHORIZWS); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; - case 'v': - ret = reg_node(pRExC_state, VERTWS); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; + invert = 1; + /* FALLTHROUGH */ + case 'h': + arg = ANYOF_BLANK; + op = POSIXU; + goto join_posix_op_known; + case 'V': - ret = reg_node(pRExC_state, NVERTWS); + invert = 1; + /* FALLTHROUGH */ + case 'v': + arg = ANYOF_VERTWS; + op = POSIXU; + goto join_posix_op_known; + + case 'S': + invert = 1; + /* FALLTHROUGH */ + case 's': + arg = ANYOF_SPACE; + + join_posix: + + op = POSIXD + get_regex_charset(RExC_flags); + if (op > POSIXA) { /* /aa is same as /a */ + op = POSIXA; + } + + join_posix_op_known: + + if (invert) { + op += NPOSIXD - POSIXD; + } + + ret = reg_node(pRExC_state, op); + if (! SIZE_ONLY) { + FLAGS(ret) = namedclass_to_classnum(arg); + } + *flagp |= HASWIDTH|SIMPLE; + /* FALL THROUGH */ + finish_meta_pat: nextchar(pRExC_state); Set_Node_Length(ret, 2); /* MJD */ @@ -10734,7 +10711,7 @@ tryagain: FAIL("Trailing \\"); /* FALL THROUGH */ default: - if (!SIZE_ONLY&& isALNUMC(*p)) { + if (!SIZE_ONLY&& isALPHANUMERIC(*p)) { ckWARN2reg(p + 1, "Unrecognized escape \\%.1s passed through", p); } goto normal_default; @@ -10837,7 +10814,7 @@ tryagain: &PL_sv_undef, 1, 0); PL_utf8_foldable = _get_swash_invlist(swash); - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); } if (_invlist_contains_cp(PL_utf8_foldable, ender)) @@ -11120,8 +11097,8 @@ S_regwhite( RExC_state_t *pRExC_state, char *p ) #define POSIXCC_NOTYET(c) ((c) == '=' || (c) == '.') #define POSIXCC(c) (POSIXCC_DONE(c) || POSIXCC_NOTYET(c)) -STATIC I32 -S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) +PERL_STATIC_INLINE I32 +S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value, SV *free_me) { dVAR; I32 namedclass = OOB_NAMEDCLASS; @@ -11189,13 +11166,13 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) break; case 'm': if (memEQ(posixcc, "alnu", 4)) /* alnum */ - namedclass = ANYOF_ALNUMC; + namedclass = ANYOF_ALPHANUMERIC; break; case 'r': if (memEQ(posixcc, "lowe", 4)) /* lower */ - namedclass = ANYOF_LOWER; + namedclass = (FOLD) ? ANYOF_CASED : ANYOF_LOWER; else if (memEQ(posixcc, "uppe", 4)) /* upper */ - namedclass = ANYOF_UPPER; + namedclass = (FOLD) ? ANYOF_CASED : ANYOF_UPPER; break; case 't': if (memEQ(posixcc, "digi", 4)) /* digit */ @@ -11231,7 +11208,8 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) the class closes */ while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse) != ']') RExC_parse++; - Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c); + SvREFCNT_dec(free_me); + vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c); } } else { /* Maternal grandfather: @@ -11244,178 +11222,12 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value) return namedclass; } -STATIC void -S_checkposixcc(pTHX_ RExC_state_t *pRExC_state) -{ - dVAR; - - PERL_ARGS_ASSERT_CHECKPOSIXCC; - - if (POSIXCC(UCHARAT(RExC_parse))) { - const char *s = RExC_parse; - const char c = *s++; - - while (isALNUM(*s)) - s++; - if (*s && c == *s && s[1] == ']') { - ckWARN3reg(s+2, - "POSIX syntax [%c %c] belongs inside character classes", - c, c); - - /* [[=foo=]] and [[.foo.]] are still future. */ - if (POSIXCC_NOTYET(c)) { - /* adjust RExC_parse so the error shows after - the class closes */ - while (UCHARAT(RExC_parse) && UCHARAT(RExC_parse++) != ']') - NOOP; - Simple_vFAIL3("POSIX syntax [%c %c] is reserved for future extensions", c, c); - } - } - } -} - -/* Generate the code to add a full posix character to the bracketed - * character class given by . ( is needed only under locale rules) - * destlist is the inversion list for non-locale rules that this class is - * to be added to - * sourcelist is the ASCII-range inversion list to add under /a rules - * Xsourcelist is the full Unicode range list to use otherwise. */ -#define DO_POSIX(node, class, destlist, sourcelist, Xsourcelist) \ - if (LOC) { \ - SV* scratch_list = NULL; \ - \ - /* Set this class in the node for runtime matching */ \ - ANYOF_CLASS_SET(node, class); \ - \ - /* For above Latin1 code points, we use the full Unicode range */ \ - _invlist_intersection(PL_AboveLatin1, \ - Xsourcelist, \ - &scratch_list); \ - /* And set the output to it, adding instead if there already is an \ - * output. Checking if is NULL first saves an extra \ - * clone. Its reference count will be decremented at the next \ - * union, etc, or if this is the only instance, at the end of the \ - * routine */ \ - if (! destlist) { \ - destlist = scratch_list; \ - } \ - else { \ - _invlist_union(destlist, scratch_list, &destlist); \ - SvREFCNT_dec(scratch_list); \ - } \ - } \ - else { \ - /* For non-locale, just add it to any existing list */ \ - _invlist_union(destlist, \ - (AT_LEAST_ASCII_RESTRICTED) \ - ? sourcelist \ - : Xsourcelist, \ - &destlist); \ - } - -/* Like DO_POSIX, but matches the complement of and . - */ -#define DO_N_POSIX(node, class, destlist, sourcelist, Xsourcelist) \ - if (LOC) { \ - SV* scratch_list = NULL; \ - ANYOF_CLASS_SET(node, class); \ - _invlist_subtract(PL_AboveLatin1, Xsourcelist, &scratch_list); \ - if (! destlist) { \ - destlist = scratch_list; \ - } \ - else { \ - _invlist_union(destlist, scratch_list, &destlist); \ - SvREFCNT_dec(scratch_list); \ - } \ - } \ - else { \ - _invlist_union_complement_2nd(destlist, \ - (AT_LEAST_ASCII_RESTRICTED) \ - ? sourcelist \ - : Xsourcelist, \ - &destlist); \ - /* Under /d, everything in the upper half of the Latin1 range \ - * matches this complement */ \ - if (DEPENDS_SEMANTICS) { \ - ANYOF_FLAGS(node) |= ANYOF_NON_UTF8_LATIN1_ALL; \ - } \ - } - -/* Generate the code to add a posix character to the bracketed - * character class given by . ( is needed only under locale rules) - * destlist is the inversion list for non-locale rules that this class is - * to be added to - * sourcelist is the ASCII-range inversion list to add under /a rules - * l1_sourcelist is the Latin1 range list to use otherwise. - * Xpropertyname is the name to add to of the property to - * specify the code points above Latin1 that will have to be - * determined at run-time - * run_time_list is a SV* that contains text names of properties that are to - * be computed at run time. This concatenates - * to it, appropriately - * This is essentially DO_POSIX, but we know only the Latin1 values at compile - * time */ -#define DO_POSIX_LATIN1_ONLY_KNOWN(node, class, destlist, sourcelist, \ - l1_sourcelist, Xpropertyname, run_time_list) \ - /* First, resolve whether to use the ASCII-only list or the L1 \ - * list */ \ - DO_POSIX_LATIN1_ONLY_KNOWN_L1_RESOLVED(node, class, destlist, \ - ((AT_LEAST_ASCII_RESTRICTED) ? sourcelist : l1_sourcelist),\ - Xpropertyname, run_time_list) - -#define DO_POSIX_LATIN1_ONLY_KNOWN_L1_RESOLVED(node, class, destlist, sourcelist, \ - Xpropertyname, run_time_list) \ - /* If not /a matching, there are going to be code points we will have \ - * to defer to runtime to look-up */ \ - if (! AT_LEAST_ASCII_RESTRICTED) { \ - Perl_sv_catpvf(aTHX_ run_time_list, "+utf8::%s\n", Xpropertyname); \ - } \ - if (LOC) { \ - ANYOF_CLASS_SET(node, class); \ - } \ - else { \ - _invlist_union(destlist, sourcelist, &destlist); \ - } - -/* Like DO_POSIX_LATIN1_ONLY_KNOWN, but for the complement. A combination of - * this and DO_N_POSIX. Sets only if it can; unchanged - * otherwise */ -#define DO_N_POSIX_LATIN1_ONLY_KNOWN(node, class, destlist, sourcelist, \ - l1_sourcelist, Xpropertyname, run_time_list, matches_above_unicode) \ - if (AT_LEAST_ASCII_RESTRICTED) { \ - _invlist_union_complement_2nd(destlist, sourcelist, &destlist); \ - } \ - else { \ - Perl_sv_catpvf(aTHX_ run_time_list, "!utf8::%s\n", Xpropertyname); \ - matches_above_unicode = TRUE; \ - if (LOC) { \ - ANYOF_CLASS_SET(node, namedclass); \ - } \ - else { \ - SV* scratch_list = NULL; \ - _invlist_subtract(PL_Latin1, l1_sourcelist, &scratch_list); \ - if (! destlist) { \ - destlist = scratch_list; \ - } \ - else { \ - _invlist_union(destlist, scratch_list, &destlist); \ - SvREFCNT_dec(scratch_list); \ - } \ - if (DEPENDS_SEMANTICS) { \ - ANYOF_FLAGS(node) |= ANYOF_NON_UTF8_LATIN1_ALL; \ - } \ - } \ - } /* The names of properties whose definitions are not known at compile time are * stored in this SV, after a constant heading. So if the length has been * changed since initialization, then there is a run-time definition. */ #define HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION (SvCUR(listsv) != initial_listsv_len) -/* This converts the named class defined in regcomp.h to its equivalent class - * number defined in handy.h. */ -#define namedclass_to_classnum(class) ((class) / 2) - STATIC regnode * S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) { @@ -11431,7 +11243,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * reg() gets called (recursively) on the rewritten version, and this * function will return what it constructs. (Actually the s * aren't physically removed from the [abcdefghi], it's just that they are - * ignored in the recursion by means of a a flag: + * ignored in the recursion by means of a flag: * .) * * ANYOF nodes contain a bit map for the first 256 characters, with the @@ -11536,7 +11348,22 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0; if (!SIZE_ONLY && POSIXCC(nextvalue)) - checkposixcc(pRExC_state); + { + const char *s = RExC_parse; + const char c = *s++; + + while (isWORDCHAR(*s)) + s++; + if (*s && c == *s && s[1] == ']') { + SAVEFREESV(RExC_rx_sv); + SAVEFREESV(listsv); + ckWARN3reg(s+2, + "POSIX syntax [%c %c] belongs inside character classes", + c, c); + (void)ReREFCNT_inc(RExC_rx_sv); + SvREFCNT_inc_simple_void_NN(listsv); + } + } /* allow 1st char to be ] (allowing it to be - is dealt with later) */ if (UCHARAT(RExC_parse) == ']') @@ -11566,7 +11393,7 @@ parseit: nextvalue = RExC_parse < RExC_end ? UCHARAT(RExC_parse) : 0; if (value == '[' && POSIXCC(nextvalue)) - namedclass = regpposixcc(pRExC_state, value); + namedclass = regpposixcc(pRExC_state, value, listsv); else if (value == '\\') { if (UTF) { value = utf8n_to_uvchr((U8*)RExC_parse, @@ -11640,7 +11467,11 @@ parseit: if (UCHARAT(RExC_parse) == '^') { RExC_parse++; n--; - value = value == 'p' ? 'P' : 'p'; /* toggle */ + /* toggle. (The rhs xor gets the single bit that + * differs between P and p; the other xor inverts just + * that bit) */ + value ^= 'P' ^ 'p'; + while (isSPACE(UCHARAT(RExC_parse))) { RExC_parse++; n--; @@ -11663,7 +11494,7 @@ parseit: /* Look up the property name, and get its swash and * inversion list, if the property is found */ if (swash) { - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); } swash = _core_swash_init("utf8", name, &PL_sv_undef, 1, /* binary */ @@ -11673,7 +11504,7 @@ parseit: ); if (! swash || ! (invlist = _get_swash_invlist(swash))) { if (swash) { - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); swash = NULL; } @@ -11712,7 +11543,7 @@ parseit: /* The swash can't be used as-is, because we've * inverted things; delay removing it to here after * have copied its invlist above */ - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); swash = NULL; } else { @@ -11722,7 +11553,7 @@ parseit: Safefree(name); } RExC_parse = e + 1; - namedclass = ANYOF_MAX; /* no official name, but it's named */ + namedclass = ANYOF_UNIPROP; /* no official name, but it's named */ /* \p means they want Unicode semantics */ RExC_uni_semantics = 1; @@ -11796,10 +11627,14 @@ parseit: } default: /* Allow \_ to not give an error */ - if (!SIZE_ONLY && isALNUM(value) && value != '_') { + if (!SIZE_ONLY && isWORDCHAR(value) && value != '_') { + SAVEFREESV(RExC_rx_sv); + SAVEFREESV(listsv); ckWARN2reg(RExC_parse, "Unrecognized escape \\%c in character class passed through", (int)value); + (void)ReREFCNT_inc(RExC_rx_sv); + SvREFCNT_inc_simple_void_NN(listsv); } break; } @@ -11844,9 +11679,13 @@ parseit: const int w = RExC_parse >= rangebegin ? RExC_parse - rangebegin : 0; + SAVEFREESV(RExC_rx_sv); /* in case of fatal warnings */ + SAVEFREESV(listsv); ckWARN4reg(RExC_parse, "False [] range \"%*.*s\"", w, w, rangebegin); + (void)ReREFCNT_inc(RExC_rx_sv); + SvREFCNT_inc_simple_void_NN(listsv); cp_list = add_cp_to_invlist(cp_list, '-'); cp_list = add_cp_to_invlist(cp_list, prevvalue); } @@ -11856,278 +11695,252 @@ parseit: } if (! SIZE_ONLY) { - switch ((I32)namedclass) { + U8 classnum = namedclass_to_classnum(namedclass); + if (namedclass >= ANYOF_MAX) { /* If a special class */ + if (namedclass != ANYOF_UNIPROP) { /* UNIPROP = \p and \P */ + + /* Here, should be \h, \H, \v, or \V. Neither /d nor + * /l make a difference in what these match. There + * would be problems if these characters had folds + * other than themselves, as cp_list is subject to + * folding. */ + if (classnum != _CC_VERTSPACE) { + assert( namedclass == ANYOF_HORIZWS + || namedclass == ANYOF_NHORIZWS); + + /* It turns out that \h is just a synonym for + * XPosixBlank */ + classnum = _CC_BLANK; + } - case ANYOF_ALNUMC: /* C's alnum, in contrast to \w */ - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixAlnum, PL_L1PosixAlnum, "XPosixAlnum", listsv); - break; - case ANYOF_NALNUMC: - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixAlnum, PL_L1PosixAlnum, "XPosixAlnum", listsv, - runtime_posix_matches_above_Unicode); - break; - case ANYOF_ALPHA: - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixAlpha, PL_L1PosixAlpha, "XPosixAlpha", listsv); - break; - case ANYOF_NALPHA: - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixAlpha, PL_L1PosixAlpha, "XPosixAlpha", listsv, - runtime_posix_matches_above_Unicode); - break; - case ANYOF_ASCII: + _invlist_union_maybe_complement_2nd( + cp_list, + PL_XPosix_ptrs[classnum], + namedclass % 2, /* Complement if odd + (NHORIZWS, NVERTWS) */ + &cp_list); + } + } + else if (classnum == _CC_ASCII) { #ifdef HAS_ISASCII - if (LOC) { - ANYOF_CLASS_SET(ret, namedclass); - } + if (LOC) { + ANYOF_CLASS_SET(ret, namedclass); + } else #endif /* Not isascii(); just use the hard-coded definition for it */ - _invlist_union(posixes, PL_ASCII, &posixes); - break; - case ANYOF_NASCII: -#ifdef HAS_ISASCII - if (LOC) { - ANYOF_CLASS_SET(ret, namedclass); - } - else { -#endif - _invlist_union_complement_2nd(posixes, - PL_ASCII, &posixes); - if (DEPENDS_SEMANTICS) { - ANYOF_FLAGS(ret) |= ANYOF_NON_UTF8_LATIN1_ALL; + _invlist_union_maybe_complement_2nd( + posixes, + PL_ASCII, + namedclass % 2, /* Complement if odd (NASCII) */ + &posixes); + } + else { /* Garden variety class */ + + /* The ascii range inversion list */ + SV* ascii_source = PL_Posix_ptrs[classnum]; + + /* The full Latin1 range inversion list */ + SV* l1_source = PL_L1Posix_ptrs[classnum]; + + /* This code is structured into two major clauses. The + * first is for classes whose complete definitions may not + * already be known. It not, the Latin1 definition + * (guaranteed to already known) is used plus code is + * generated to load the rest at run-time (only if needed). + * If the complete definition is known, it drops down to + * the second clause, where the complete definition is + * known */ + + if (classnum < _FIRST_NON_SWASH_CC) { + + /* Here, the class has a swash, which may or not + * already be loaded */ + + /* The name of the property to use to match the full + * eXtended Unicode range swash for this character + * class */ + const char *Xname = swash_property_names[classnum]; + + if ( ! PL_utf8_swash_ptrs[classnum]) { + if (namedclass % 2 == 0) { /* A non-complemented + class */ + /* If not /a matching, there are code points we + * don't know at compile time. Arrange for the + * unknown matches to be loaded at run-time, if + * needed */ + if (! AT_LEAST_ASCII_RESTRICTED) { + Perl_sv_catpvf(aTHX_ listsv, "+utf8::%s\n", + Xname); + } + if (LOC) { /* Under locale, set run-time + lookup */ + ANYOF_CLASS_SET(ret, namedclass); + } + else { + /* Add the current class's code points to + * the running total */ + _invlist_union(posixes, + (AT_LEAST_ASCII_RESTRICTED) + ? ascii_source + : l1_source, + &posixes); + } + } + else { /* A complemented class */ + if (AT_LEAST_ASCII_RESTRICTED) { + /* Under /a should match everything above + * ASCII, plus the complement of the set's + * ASCII matches */ + _invlist_union_complement_2nd(posixes, + ascii_source, + &posixes); + } + else { + /* Arrange for the unknown matches to be + * loaded at run-time, if needed */ + Perl_sv_catpvf(aTHX_ listsv, "!utf8::%s\n", + Xname); + runtime_posix_matches_above_Unicode = TRUE; + if (LOC) { + ANYOF_CLASS_SET(ret, namedclass); + } + else { + + /* We want to match everything in + * Latin1, except those things that + * l1_source matches */ + SV* scratch_list = NULL; + _invlist_subtract(PL_Latin1, l1_source, + &scratch_list); + + /* Add the list from this class to the + * running total */ + if (! posixes) { + posixes = scratch_list; + } + else { + _invlist_union(posixes, + scratch_list, + &posixes); + SvREFCNT_dec_NN(scratch_list); + } + if (DEPENDS_SEMANTICS) { + ANYOF_FLAGS(ret) + |= ANYOF_NON_UTF8_LATIN1_ALL; + } + } + } + } + goto namedclass_done; + } + + /* Here, there is a swash loaded for the class. If no + * inversion list for it yet, get it */ + if (! PL_XPosix_ptrs[classnum]) { + PL_XPosix_ptrs[classnum] + = _swash_to_invlist(PL_utf8_swash_ptrs[classnum]); } -#ifdef HAS_ISASCII - } -#endif - break; - case ANYOF_BLANK: - if (hasISBLANK || ! LOC) { - DO_POSIX(ret, namedclass, posixes, - PL_PosixBlank, PL_XPosixBlank); } - else { /* There is no isblank() and we are in locale: We - use the ASCII range and the above-Latin1 range - code points */ - SV* scratch_list = NULL; - - /* Include all above-Latin1 blanks */ - _invlist_intersection(PL_AboveLatin1, - PL_XPosixBlank, - &scratch_list); - /* Add it to the running total of posix classes */ - if (! posixes) { - posixes = scratch_list; + + /* Here there is an inversion list already loaded for the + * entire class */ + + if (namedclass % 2 == 0) { /* A non-complemented class, + like ANYOF_PUNCT */ + if (! LOC) { + /* For non-locale, just add it to any existing list + * */ + _invlist_union(posixes, + (AT_LEAST_ASCII_RESTRICTED) + ? ascii_source + : PL_XPosix_ptrs[classnum], + &posixes); } - else { - _invlist_union(posixes, scratch_list, &posixes); - SvREFCNT_dec(scratch_list); + else { /* Locale */ + SV* scratch_list = NULL; + + /* For above Latin1 code points, we use the full + * Unicode range */ + _invlist_intersection(PL_AboveLatin1, + PL_XPosix_ptrs[classnum], + &scratch_list); + /* And set the output to it, adding instead if + * there already is an output. Checking if + * 'posixes' is NULL first saves an extra clone. + * Its reference count will be decremented at the + * next union, etc, or if this is the only + * instance, at the end of the routine */ + if (! posixes) { + posixes = scratch_list; + } + else { + _invlist_union(posixes, scratch_list, &posixes); + SvREFCNT_dec_NN(scratch_list); + } + +#ifndef HAS_ISBLANK + if (namedclass != ANYOF_BLANK) { +#endif + /* Set this class in the node for runtime + * matching */ + ANYOF_CLASS_SET(ret, namedclass); +#ifndef HAS_ISBLANK + } + else { + /* No isblank(), use the hard-coded ASCII-range + * blanks, adding them to the running total. */ + + _invlist_union(posixes, ascii_source, &posixes); + } +#endif } - /* Add the ASCII-range blanks to the running total. */ - _invlist_union(posixes, PL_PosixBlank, &posixes); } - break; - case ANYOF_NBLANK: - if (hasISBLANK || ! LOC) { - DO_N_POSIX(ret, namedclass, posixes, - PL_PosixBlank, PL_XPosixBlank); - } - else { /* There is no isblank() and we are in locale */ - SV* scratch_list = NULL; - - /* Include all above-Latin1 non-blanks */ - _invlist_subtract(PL_AboveLatin1, PL_XPosixBlank, - &scratch_list); - - /* Add them to the running total of posix classes */ - _invlist_subtract(PL_AboveLatin1, PL_XPosixBlank, - &scratch_list); - if (! posixes) { - posixes = scratch_list; + else { /* A complemented class, like ANYOF_NPUNCT */ + if (! LOC) { + _invlist_union_complement_2nd( + posixes, + (AT_LEAST_ASCII_RESTRICTED) + ? ascii_source + : PL_XPosix_ptrs[classnum], + &posixes); + /* Under /d, everything in the upper half of the + * Latin1 range matches this complement */ + if (DEPENDS_SEMANTICS) { + ANYOF_FLAGS(ret) |= ANYOF_NON_UTF8_LATIN1_ALL; + } } - else { - _invlist_union(posixes, scratch_list, &posixes); - SvREFCNT_dec(scratch_list); + else { /* Locale */ + SV* scratch_list = NULL; + _invlist_subtract(PL_AboveLatin1, + PL_XPosix_ptrs[classnum], + &scratch_list); + if (! posixes) { + posixes = scratch_list; + } + else { + _invlist_union(posixes, scratch_list, &posixes); + SvREFCNT_dec_NN(scratch_list); + } +#ifndef HAS_ISBLANK + if (namedclass != ANYOF_NBLANK) { +#endif + ANYOF_CLASS_SET(ret, namedclass); +#ifndef HAS_ISBLANK + } + else { + /* Get the list of all code points in Latin1 + * that are not ASCII blanks, and add them to + * the running total */ + _invlist_subtract(PL_Latin1, ascii_source, + &scratch_list); + _invlist_union(posixes, scratch_list, &posixes); + SvREFCNT_dec_NN(scratch_list); + } +#endif } - - /* Get the list of all non-ASCII-blanks in Latin 1, and - * add them to the running total */ - _invlist_subtract(PL_Latin1, PL_PosixBlank, - &scratch_list); - _invlist_union(posixes, scratch_list, &posixes); - SvREFCNT_dec(scratch_list); } - break; - case ANYOF_CNTRL: - DO_POSIX(ret, namedclass, posixes, - PL_PosixCntrl, PL_XPosixCntrl); - break; - case ANYOF_NCNTRL: - DO_N_POSIX(ret, namedclass, posixes, - PL_PosixCntrl, PL_XPosixCntrl); - break; - case ANYOF_DIGIT: - /* There are no digits in the Latin1 range outside of - * ASCII, so call the macro that doesn't have to resolve - * them */ - DO_POSIX_LATIN1_ONLY_KNOWN_L1_RESOLVED(ret, namedclass, posixes, - PL_PosixDigit, "XPosixDigit", listsv); - break; - case ANYOF_NDIGIT: - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixDigit, PL_PosixDigit, "XPosixDigit", listsv, - runtime_posix_matches_above_Unicode); - break; - case ANYOF_GRAPH: - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixGraph, PL_L1PosixGraph, "XPosixGraph", listsv); - break; - case ANYOF_NGRAPH: - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixGraph, PL_L1PosixGraph, "XPosixGraph", listsv, - runtime_posix_matches_above_Unicode); - break; - case ANYOF_HORIZWS: - /* For these, we use the cp_list, as /d doesn't make a - * difference in what these match. There would be problems - * if these characters had folds other than themselves, as - * cp_list is subject to folding. It turns out that \h - * is just a synonym for XPosixBlank */ - _invlist_union(cp_list, PL_XPosixBlank, &cp_list); - break; - case ANYOF_NHORIZWS: - _invlist_union_complement_2nd(cp_list, - PL_XPosixBlank, &cp_list); - break; - case ANYOF_LOWER: - case ANYOF_NLOWER: - { /* These require special handling, as they differ under - folding, matching Cased there (which in the ASCII range - is the same as Alpha */ - - SV* ascii_source; - SV* l1_source; - const char *Xname; - - if (FOLD && ! LOC) { - ascii_source = PL_PosixAlpha; - l1_source = PL_L1Cased; - Xname = "Cased"; - } - else { - ascii_source = PL_PosixLower; - l1_source = PL_L1PosixLower; - Xname = "XPosixLower"; - } - if (namedclass == ANYOF_LOWER) { - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - ascii_source, l1_source, Xname, listsv); - } - else { - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, - posixes, ascii_source, l1_source, Xname, listsv, - runtime_posix_matches_above_Unicode); - } - break; - } - case ANYOF_PRINT: - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixPrint, PL_L1PosixPrint, "XPosixPrint", listsv); - break; - case ANYOF_NPRINT: - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixPrint, PL_L1PosixPrint, "XPosixPrint", listsv, - runtime_posix_matches_above_Unicode); - break; - case ANYOF_PUNCT: - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixPunct, PL_L1PosixPunct, "XPosixPunct", listsv); - break; - case ANYOF_NPUNCT: - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixPunct, PL_L1PosixPunct, "XPosixPunct", listsv, - runtime_posix_matches_above_Unicode); - break; - case ANYOF_PSXSPC: - DO_POSIX(ret, namedclass, posixes, - PL_PosixSpace, PL_XPosixSpace); - break; - case ANYOF_NPSXSPC: - DO_N_POSIX(ret, namedclass, posixes, - PL_PosixSpace, PL_XPosixSpace); - break; - case ANYOF_SPACE: - DO_POSIX(ret, namedclass, posixes, - PL_PerlSpace, PL_XPerlSpace); - break; - case ANYOF_NSPACE: - DO_N_POSIX(ret, namedclass, posixes, - PL_PerlSpace, PL_XPerlSpace); - break; - case ANYOF_UPPER: /* Same as LOWER, above */ - case ANYOF_NUPPER: - { - SV* ascii_source; - SV* l1_source; - const char *Xname; - - if (FOLD && ! LOC) { - ascii_source = PL_PosixAlpha; - l1_source = PL_L1Cased; - Xname = "Cased"; - } - else { - ascii_source = PL_PosixUpper; - l1_source = PL_L1PosixUpper; - Xname = "XPosixUpper"; - } - if (namedclass == ANYOF_UPPER) { - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - ascii_source, l1_source, Xname, listsv); - } - else { - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, - posixes, ascii_source, l1_source, Xname, listsv, - runtime_posix_matches_above_Unicode); - } - break; - } - case ANYOF_WORDCHAR: - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixWord, PL_L1PosixWord, "XPosixWord", listsv); - break; - case ANYOF_NWORDCHAR: - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_PosixWord, PL_L1PosixWord, "XPosixWord", listsv, - runtime_posix_matches_above_Unicode); - break; - case ANYOF_VERTWS: - /* For these, we use the cp_list, as /d doesn't make a - * difference in what these match. There would be problems - * if these characters had folds other than themselves, as - * cp_list is subject to folding */ - _invlist_union(cp_list, PL_VertSpace, &cp_list); - break; - case ANYOF_NVERTWS: - _invlist_union_complement_2nd(cp_list, - PL_VertSpace, &cp_list); - break; - case ANYOF_XDIGIT: - DO_POSIX(ret, namedclass, posixes, - PL_PosixXDigit, PL_XPosixXDigit); - break; - case ANYOF_NXDIGIT: - DO_N_POSIX(ret, namedclass, posixes, - PL_PosixXDigit, PL_XPosixXDigit); - break; - case ANYOF_MAX: - /* this is to handle \p and \P */ - break; - default: - vFAIL("Invalid [::] class"); - break; - } - + } + namedclass_done: continue; /* Go get next character */ } } /* end of namedclass \blah */ @@ -12372,7 +12185,8 @@ parseit: RExC_parse = save_parse; RExC_end = save_end; RExC_in_multi_char_class = 0; - SvREFCNT_dec(multi_char_matches); + SvREFCNT_dec_NN(multi_char_matches); + SvREFCNT_dec_NN(listsv); return ret; } @@ -12386,110 +12200,77 @@ parseit: if (namedclass > OOB_NAMEDCLASS) { /* this is a named class, like \w or [:digit:] or \p{foo} */ - /* Certain named classes have equivalents that can appear outside a - * character class, e.g. \w, \H. We use these instead of a - * character class. */ + /* All named classes are mapped into POSIXish nodes, with its FLAG + * argument giving which class it is */ switch ((I32)namedclass) { - U8 offset; - - /* The first group is for node types that depend on the charset - * modifier to the regex. We first calculate the base node - * type, and if it should be inverted */ - - case ANYOF_NWORDCHAR: - invert = ! invert; - /* FALLTHROUGH */ - case ANYOF_WORDCHAR: - op = ALNUM; - goto join_charset_classes; - - case ANYOF_NSPACE: - invert = ! invert; - /* FALLTHROUGH */ - case ANYOF_SPACE: - op = SPACE; - goto join_charset_classes; - - case ANYOF_NDIGIT: - invert = ! invert; - /* FALLTHROUGH */ - case ANYOF_DIGIT: - op = DIGIT; - - join_charset_classes: - - /* Now that we have the base node type, we take advantage - * of the enum ordering of the charset modifiers to get the - * exact node type, For example the base SPACE also has - * SPACEL, SPACEU, and SPACEA */ - - offset = get_regex_charset(RExC_flags); - - /* /aa is the same as /a for these */ - if (offset == REGEX_ASCII_MORE_RESTRICTED_CHARSET) { - offset = REGEX_ASCII_RESTRICTED_CHARSET; - } - else if (op == DIGIT && offset == REGEX_UNICODE_CHARSET) { - offset = REGEX_DEPENDS_CHARSET; /* There is no DIGITU */ - } - - op += offset; - - /* The number of varieties of each of these is the same, - * hence, so is the delta between the normal and - * complemented nodes */ - if (invert) { - op += NALNUM - ALNUM; - } - *flagp |= HASWIDTH|SIMPLE; + case ANYOF_UNIPROP: break; - /* The second group doesn't depend of the charset modifiers. - * We just have normal and complemented */ + /* These don't depend on the charset modifiers. They always + * match under /u rules */ case ANYOF_NHORIZWS: - invert = ! invert; - /* FALLTHROUGH */ case ANYOF_HORIZWS: - is_horizws: - op = (invert) ? NHORIZWS : HORIZWS; - *flagp |= HASWIDTH|SIMPLE; - break; + namedclass = ANYOF_BLANK + namedclass - ANYOF_HORIZWS; + /* FALLTHROUGH */ case ANYOF_NVERTWS: - invert = ! invert; - /* FALLTHROUGH */ case ANYOF_VERTWS: - op = (invert) ? NVERTWS : VERTWS; - *flagp |= HASWIDTH|SIMPLE; - break; - - case ANYOF_MAX: - break; - - case ANYOF_NBLANK: - invert = ! invert; - /* FALLTHROUGH */ - case ANYOF_BLANK: - if (AT_LEAST_UNI_SEMANTICS && ! AT_LEAST_ASCII_RESTRICTED) { - goto is_horizws; + op = POSIXU; + goto join_posix; + + /* The actual POSIXish node for all the rest depends on the + * charset modifier. The ones in the first set depend only on + * ASCII or, if available on this platform, locale */ + case ANYOF_ASCII: + case ANYOF_NASCII: +#ifdef HAS_ISASCII + op = (LOC) ? POSIXL : POSIXA; +#else + op = POSIXA; +#endif + goto join_posix; + + case ANYOF_NCASED: + case ANYOF_LOWER: + case ANYOF_NLOWER: + case ANYOF_UPPER: + case ANYOF_NUPPER: + /* under /a could be alpha */ + if (FOLD) { + if (ASCII_RESTRICTED) { + namedclass = ANYOF_ALPHA + (namedclass % 2); + } + else if (! LOC) { + break; + } } /* FALLTHROUGH */ + + /* The rest have more possibilities depending on the charset. We + * take advantage of the enum ordering of the charset modifiers to + * get the exact node type, */ default: - /* A generic posix class. All the /a ones can be handled - * by the POSIXA opcode. And all are closed under folding - * in the ASCII range, so FOLD doesn't matter */ - if (AT_LEAST_ASCII_RESTRICTED - || (! LOC && namedclass == ANYOF_ASCII)) + op = POSIXD + get_regex_charset(RExC_flags); + if (op > POSIXA) { /* /aa is same as /a */ + op = POSIXA; + } +#ifndef HAS_ISBLANK + if (op == POSIXL + && (namedclass == ANYOF_BLANK + || namedclass == ANYOF_NBLANK)) { - /* The odd numbered ones are the complements of the - * next-lower even number one */ - if (namedclass % 2 == 1) { - invert = ! invert; - namedclass--; - } - arg = namedclass_to_classnum(namedclass); - op = (invert) ? NPOSIXA : POSIXA; + op = POSIXA; + } +#endif + + join_posix: + /* The odd numbered ones are the complements of the + * next-lower even number one */ + if (namedclass % 2 == 1) { + invert = ! invert; + namedclass--; } + arg = namedclass_to_classnum(namedclass); break; } } @@ -12514,8 +12295,8 @@ parseit: else if (! LOC) { /* locale could vary these */ if (prevvalue == '0') { if (value == '9') { - op = (invert) ? NDIGITA : DIGITA; - *flagp |= HASWIDTH|SIMPLE; + arg = _CC_DIGIT; + op = POSIXA; } } } @@ -12541,11 +12322,16 @@ parseit: } else { RExC_emit = (regnode *)orig_emit; + if (PL_regkind[op] == POSIXD) { + if (invert) { + op += NPOSIXD - POSIXD; + } + } } ret = reg_node(pRExC_state, op); - if (PL_regkind[op] == POSIXD) { + if (PL_regkind[op] == POSIXD || PL_regkind[op] == NPOSIXD) { if (! SIZE_ONLY) { FLAGS(ret) = arg; } @@ -12557,7 +12343,9 @@ parseit: RExC_parse = (char *) cur_parse; - SvREFCNT_dec(listsv); + SvREFCNT_dec(posixes); + SvREFCNT_dec_NN(listsv); + SvREFCNT_dec(cp_list); return ret; } } @@ -12575,11 +12363,11 @@ parseit: /* If the highest code point is within Latin1, we can use the * compiled-in Alphas list, and not have to go out to disk. This - * yields two false positives, the masculine and feminine oridinal + * yields two false positives, the masculine and feminine ordinal * indicators, which are weeded out below using the * IS_IN_SOME_FOLD_L1() macro */ if (invlist_highest(cp_list) < 256) { - _invlist_intersection(PL_L1PosixAlpha, cp_list, &fold_intersection); + _invlist_intersection(PL_L1Posix_ptrs[_CC_ALPHA], cp_list, &fold_intersection); } else { @@ -12590,7 +12378,7 @@ parseit: SV* swash = swash_init("utf8", "_Perl_Any_Folds", &PL_sv_undef, 1, 0); PL_utf8_foldable = _get_swash_invlist(swash); - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); } /* This is a hash that for a particular fold gives all characters @@ -12617,7 +12405,7 @@ parseit: assert(PL_utf8_tofold); /* Verify that worked */ } PL_utf8_foldclosures = - _swash_inversion_hash(PL_utf8_tofold); + _swash_inversion_hash(PL_utf8_tofold); } } @@ -12792,7 +12580,7 @@ parseit: } } } - SvREFCNT_dec(fold_intersection); + SvREFCNT_dec_NN(fold_intersection); } /* And combine the result (if any) with any inversion list from posix @@ -12803,7 +12591,7 @@ parseit: if (! DEPENDS_SEMANTICS) { if (cp_list) { _invlist_union(cp_list, posixes, &cp_list); - SvREFCNT_dec(posixes); + SvREFCNT_dec_NN(posixes); } else { cp_list = posixes; @@ -12821,7 +12609,7 @@ parseit: &posixes); if (cp_list) { _invlist_union(cp_list, posixes, &cp_list); - SvREFCNT_dec(posixes); + SvREFCNT_dec_NN(posixes); } else { cp_list = posixes; @@ -12830,7 +12618,7 @@ parseit: if (depends_list) { _invlist_union(depends_list, nonascii_but_latin1_properties, &depends_list); - SvREFCNT_dec(nonascii_but_latin1_properties); + SvREFCNT_dec_NN(nonascii_but_latin1_properties); } else { depends_list = nonascii_but_latin1_properties; @@ -12872,14 +12660,14 @@ parseit: } _invlist_union(properties, cp_list, &cp_list); - SvREFCNT_dec(properties); + SvREFCNT_dec_NN(properties); } else { cp_list = properties; } if (warn_super) { - ANYOF_FLAGS(ret) |= ANYOF_WARN_SUPER; + OP(ret) = ANYOF_WARN_SUPER; } } @@ -12905,7 +12693,7 @@ parseit: /* Any swash can't be used as-is, because we've inverted things */ if (swash) { - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); swash = NULL; } @@ -12943,12 +12731,12 @@ parseit: && ! (ANYOF_FLAGS(ret) & ANYOF_CLASS) && ! HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION) { - UV start, end; - U8 op = END; /* The optimzation node-type */ + UV start, end; + U8 op = END; /* The optimzation node-type */ const char * cur_parse= RExC_parse; - invlist_iterinit(cp_list); - if (! invlist_iternext(cp_list, &start, &end)) { + invlist_iterinit(cp_list); + if (! invlist_iternext(cp_list, &start, &end)) { /* Here, the list is empty. This happens, for example, when a * Unicode property is the only thing in the character class, and @@ -12999,7 +12787,7 @@ parseit: SV* swash = swash_init("utf8", "_Perl_Any_Folds", &PL_sv_undef, 1, 0); PL_utf8_foldable = _get_swash_invlist(swash); - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); } if (_invlist_contains_cp(PL_utf8_foldable, value)) { op = EXACT; @@ -13029,6 +12817,7 @@ parseit: RExC_naughty++; } } + invlist_iterfinish(cp_list); if (op != END) { RExC_parse = (char *)orig_parse; @@ -13042,7 +12831,8 @@ parseit: alloc_maybe_populate_EXACT(pRExC_state, ret, flagp, 0, value); } - SvREFCNT_dec(listsv); + SvREFCNT_dec_NN(cp_list); + SvREFCNT_dec_NN(listsv); return ret; } } @@ -13087,6 +12877,7 @@ parseit: } } } + invlist_iterfinish(cp_list); /* Done with loop; remove any code points that are in the bitmap from * */ @@ -13096,7 +12887,7 @@ parseit: /* If have completely emptied it, remove it completely */ if (_invlist_len(cp_list) == 0) { - SvREFCNT_dec(cp_list); + SvREFCNT_dec_NN(cp_list); cp_list = NULL; } } @@ -13111,7 +12902,7 @@ parseit: if (depends_list) { if (cp_list) { _invlist_union(cp_list, depends_list, &cp_list); - SvREFCNT_dec(depends_list); + SvREFCNT_dec_NN(depends_list); } else { cp_list = depends_list; @@ -13121,7 +12912,7 @@ parseit: /* If there is a swash and more than one element, we can't use the swash in * the optimization below. */ if (swash && element_count > 1) { - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); swash = NULL; } @@ -13129,7 +12920,7 @@ parseit: && ! HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION) { ARG_SET(ret, ANYOF_NONBITMAP_EMPTY); - SvREFCNT_dec(listsv); + SvREFCNT_dec_NN(listsv); } else { /* av[0] stores the character class description in its textual form: @@ -13147,10 +12938,10 @@ parseit: av_store(av, 0, (HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION) ? listsv - : &PL_sv_undef); + : (SvREFCNT_dec_NN(listsv), &PL_sv_undef)); if (swash) { av_store(av, 1, swash); - SvREFCNT_dec(cp_list); + SvREFCNT_dec_NN(cp_list); } else { av_store(av, 1, NULL); @@ -13766,36 +13557,48 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) /* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */ static const char * const anyofs[] = { - "\\w", - "\\W", - "\\s", - "\\S", - "\\d", - "\\D", - "[:alnum:]", - "[:^alnum:]", +#if _CC_WORDCHAR != 0 || _CC_DIGIT != 1 || _CC_ALPHA != 2 || _CC_LOWER != 3 \ + || _CC_UPPER != 4 || _CC_PUNCT != 5 || _CC_PRINT != 6 \ + || _CC_ALPHANUMERIC != 7 || _CC_GRAPH != 8 || _CC_CASED != 9 \ + || _CC_SPACE != 10 || _CC_BLANK != 11 || _CC_XDIGIT != 12 \ + || _CC_PSXSPC != 13 || _CC_CNTRL != 14 || _CC_ASCII != 15 \ + || _CC_VERTSPACE != 16 + #error Need to adjust order of anyofs[] +#endif + "[\\w]", + "[\\W]", + "[\\d]", + "[\\D]", "[:alpha:]", "[:^alpha:]", - "[:ascii:]", - "[:^ascii:]", - "[:cntrl:]", - "[:^cntrl:]", - "[:graph:]", - "[:^graph:]", "[:lower:]", "[:^lower:]", - "[:print:]", - "[:^print:]", - "[:punct:]", - "[:^punct:]", "[:upper:]", "[:^upper:]", + "[:punct:]", + "[:^punct:]", + "[:print:]", + "[:^print:]", + "[:alnum:]", + "[:^alnum:]", + "[:graph:]", + "[:^graph:]", + "[:cased:]", + "[:^cased:]", + "[\\s]", + "[\\S]", + "[:blank:]", + "[:^blank:]", "[:xdigit:]", "[:^xdigit:]", "[:space:]", "[:^space:]", - "[:blank:]", - "[:^blank:]" + "[:cntrl:]", + "[:^cntrl:]", + "[:ascii:]", + "[:^ascii:]", + "[\\v]", + "[\\V]" }; RXi_GET_DECL(prog,progi); GET_RE_DEBUG_FLAGS_DECL; @@ -14048,13 +13851,13 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) Safefree(origs); } - SvREFCNT_dec(lv); + SvREFCNT_dec_NN(lv); } } Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); } - else if (k == POSIXD) { + else if (k == POSIXD || k == NPOSIXD) { U8 index = FLAGS(o) * 2; if (index > (sizeof(anyofs) / sizeof(anyofs[0]))) { Perl_sv_catpvf(aTHX_ sv, "[illegal type=%d])", index); @@ -14077,7 +13880,7 @@ SV * Perl_re_intuit_string(pTHX_ REGEXP * const r) { /* Assume that RE_INTUIT is set */ dVAR; - struct regexp *const prog = (struct regexp *)SvANY(r); + struct regexp *const prog = ReANY(r); GET_RE_DEBUG_FLAGS_DECL; PERL_ARGS_ASSERT_RE_INTUIT_STRING; @@ -14125,7 +13928,7 @@ void Perl_pregfree2(pTHX_ REGEXP *rx) { dVAR; - struct regexp *const r = (struct regexp *)SvANY(rx); + struct regexp *const r = ReANY(rx); GET_RE_DEBUG_FLAGS_DECL; PERL_ARGS_ASSERT_PREGFREE2; @@ -14135,6 +13938,7 @@ Perl_pregfree2(pTHX_ REGEXP *rx) } else { CALLREGFREE_PVT(rx); /* free the private data */ SvREFCNT_dec(RXp_PAREN_NAMES(r)); + Safefree(r->xpv_len_u.xpvlenu_pv); } if (r->substrs) { SvREFCNT_dec(r->anchored_substr); @@ -14144,11 +13948,12 @@ Perl_pregfree2(pTHX_ REGEXP *rx) Safefree(r->substrs); } RX_MATCH_COPY_FREE(rx); -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW SvREFCNT_dec(r->saved_copy); #endif Safefree(r->offs); SvREFCNT_dec(r->qr_anoncv); + rx->sv_u.svu_rx = 0; } /* reg_temp_copy() @@ -14172,30 +13977,42 @@ REGEXP * Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx) { struct regexp *ret; - struct regexp *const r = (struct regexp *)SvANY(rx); + struct regexp *const r = ReANY(rx); + const bool islv = ret_x && SvTYPE(ret_x) == SVt_PVLV; PERL_ARGS_ASSERT_REG_TEMP_COPY; if (!ret_x) ret_x = (REGEXP*) newSV_type(SVt_REGEXP); else { - if (SvPOKp(ret_x)) SvPV_free(ret_x); SvOK_off((SV *)ret_x); + if (islv) { + /* For PVLVs, SvANY points to the xpvlv body while sv_u points + to the regexp. (For SVt_REGEXPs, sv_upgrade has already + made both spots point to the same regexp body.) */ + REGEXP *temp = (REGEXP *)newSV_type(SVt_REGEXP); + assert(!SvPVX(ret_x)); + ret_x->sv_u.svu_rx = temp->sv_any; + temp->sv_any = NULL; + SvFLAGS(temp) = (SvFLAGS(temp) & ~SVTYPEMASK) | SVt_NULL; + SvREFCNT_dec_NN(temp); + /* SvCUR still resides in the xpvlv struct, so the regexp copy- + ing below will not set it. */ + SvCUR_set(ret_x, SvCUR(rx)); + } } /* This ensures that SvTHINKFIRST(sv) is true, and hence that sv_force_normal(sv) is called. */ SvFAKE_on(ret_x); - ret = (struct regexp *)SvANY(ret_x); + ret = ReANY(ret_x); - /* We can take advantage of the existing "copied buffer" mechanism in SVs - by pointing directly at the buffer, but flagging that the allocated - space in the copy is zero. As we've just done a struct copy, it's now - a case of zero-ing that, rather than copying the current length. */ - SvPV_set(ret_x, RX_WRAPPED(rx)); - SvFLAGS(ret_x) |= SvFLAGS(rx) & (SVf_POK|SVp_POK|SVf_UTF8); + SvFLAGS(ret_x) |= SvUTF8(rx); + /* We share the same string buffer as the original regexp, on which we + hold a reference count, incremented when mother_re is set below. + The string pointer is copied here, being part of the regexp struct. + */ memcpy(&(ret->xpv_cur), &(r->xpv_cur), sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur)); - SvLEN_set(ret_x, 0); if (r->offs) { const I32 npar = r->nparens+1; Newx(ret->offs, npar, regexp_paren_pair); @@ -14214,7 +14031,7 @@ Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx) anchored or float namesakes, and don't hold a second reference. */ } RX_MATCH_COPIED_off(ret_x); -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW ret->saved_copy = NULL; #endif ret->mother_re = ReREFCNT_inc(r->mother_re ? r->mother_re : rx); @@ -14240,7 +14057,7 @@ void Perl_regfree_internal(pTHX_ REGEXP * const rx) { dVAR; - struct regexp *const r = (struct regexp *)SvANY(rx); + struct regexp *const r = ReANY(rx); RXi_GET_DECL(r,ri); GET_RE_DEBUG_FLAGS_DECL; @@ -14361,8 +14178,8 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) { dVAR; I32 npar; - const struct regexp *r = (const struct regexp *)SvANY(sstr); - struct regexp *ret = (struct regexp *)SvANY(dstr); + const struct regexp *r = ReANY(sstr); + struct regexp *ret = ReANY(dstr); PERL_ARGS_ASSERT_RE_DUP_GUTS; @@ -14422,25 +14239,18 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) ret->subbeg = SAVEPVN(ret->subbeg, ret->sublen); else ret->subbeg = NULL; -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW ret->saved_copy = NULL; #endif - if (ret->mother_re) { - if (SvPVX_const(dstr) == SvPVX_const(ret->mother_re)) { - /* Our storage points directly to our mother regexp, but that's + /* Whether mother_re be set or no, we need to copy the string. We + cannot refrain from copying it when the storage points directly to + our mother regexp, because that's 1: a buffer in a different thread 2: something we no longer hold a reference on so we need to copy it locally. */ - /* Note we need to use SvCUR(), rather than - SvLEN(), on our mother_re, because its buffer may not be - the same size as our newly-allocated one. */ - SvPV_set(dstr, SAVEPVN(SvPVX_const(ret->mother_re), - SvCUR(ret->mother_re)+1)); - SvLEN_set(dstr, SvCUR(ret->mother_re)+1); - } - ret->mother_re = NULL; - } + RX_WRAPPED(dstr) = SAVEPVN(RX_WRAPPED(sstr), SvCUR(sstr)+1); + ret->mother_re = NULL; ret->gofs = 0; } #endif /* PERL_IN_XSUB_RE */ @@ -14463,7 +14273,7 @@ void * Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) { dVAR; - struct regexp *const r = (struct regexp *)SvANY(rx); + struct regexp *const r = ReANY(rx); regexp_internal *reti; int len; RXi_GET_DECL(r,ri); @@ -14567,7 +14377,7 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) - regnext - dig the "next" pointer out of a node */ regnode * -Perl_regnext(pTHX_ register regnode *p) +Perl_regnext(pTHX_ regnode *p) { dVAR; I32 offset; @@ -14650,7 +14460,7 @@ Perl_save_re_context(pTHX) PL_reg_leftiter = 0; PL_reg_poscache = NULL; PL_reg_poscache_size = 0; -#ifdef PERL_OLD_COPY_ON_WRITE +#ifdef PERL_ANY_COW PL_nrs = NULL; #endif @@ -14676,13 +14486,6 @@ Perl_save_re_context(pTHX) } #endif -static void -clear_re(pTHX_ void *r) -{ - dVAR; - ReREFCNT_dec((REGEXP *)r); -} - #ifdef DEBUGGING STATIC void