X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f654391eb8fbdef379cce3c487d00fbac784ebdb..56de9929c84969b1f18f48c90312eccd086cd2e8:/regcomp.c diff --git a/regcomp.c b/regcomp.c index fbff672..c699996 100644 --- a/regcomp.c +++ b/regcomp.c @@ -749,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) @@ -756,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 @@ -768,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 */ @@ -783,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)) @@ -817,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)) @@ -2442,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 @@ -2950,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, @@ -3169,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); } } @@ -3577,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]))) @@ -3605,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; } @@ -3615,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; @@ -3654,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]))) { @@ -3664,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 @@ -3731,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); } @@ -3848,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) { @@ -4114,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)) @@ -4147,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; @@ -4164,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) @@ -4178,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); - } - } - } 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)); + 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_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); @@ -4474,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); } } } @@ -4546,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)) @@ -4562,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 ) { @@ -4753,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; @@ -4986,8 +4851,9 @@ S_has_runtime_code(pTHX_ RExC_state_t * const pRExC_state, OP *expr, } /* TODO ideally should handle [..], (#..), /#.../x to reduce false * positives here */ - if (pat[s] == '(' && pat[s+1] == '?' && - (pat[s+2] == '{' || (pat[s+2] == '?' && pat[s+3] == '{')) + if (pat[s] == '(' && s+2 <= plen && pat[s+1] == '?' && + (pat[s+2] == '{' + || (s + 2 <= plen && pat[s+2] == '?' && pat[s+3] == '{')) ) return 1; } @@ -5093,7 +4959,7 @@ 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; @@ -5139,7 +5005,7 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, if (!r2->num_code_blocks) /* we guessed wrong */ { - SvREFCNT_dec(qr); + SvREFCNT_dec_NN(qr); return 1; } @@ -5188,7 +5054,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; } @@ -5344,12 +5210,16 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, 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_Posix_ptrs[_CC_CNTRL] = _new_invlist_C_array(PosixCntrl_invlist); PL_XPosix_ptrs[_CC_CNTRL] = _new_invlist_C_array(XPosixCntrl_invlist); PL_Posix_ptrs[_CC_DIGIT] = _new_invlist_C_array(PosixDigit_invlist); + PL_L1Posix_ptrs[_CC_DIGIT] = _new_invlist_C_array(PosixDigit_invlist); PL_L1Posix_ptrs[_CC_GRAPH] = _new_invlist_C_array(L1PosixGraph_invlist); PL_Posix_ptrs[_CC_GRAPH] = _new_invlist_C_array(PosixGraph_invlist); @@ -6256,8 +6126,8 @@ reStudy: data.offset_float_min, data.minlen_float, longest_float_length, - data.flags & SF_FL_BEFORE_EOL, - data.flags & SF_FL_BEFORE_MEOL)) + cBOOL(data.flags & SF_FL_BEFORE_EOL), + cBOOL(data.flags & SF_FL_BEFORE_MEOL))) { r->float_min_offset = data.offset_float_min - data.lookbehind_float; r->float_max_offset = data.offset_float_max; @@ -6281,8 +6151,8 @@ reStudy: data.offset_fixed, data.minlen_fixed, longest_fixed_length, - data.flags & SF_FIX_BEFORE_EOL, - data.flags & SF_FIX_BEFORE_MEOL)) + cBOOL(data.flags & SF_FIX_BEFORE_EOL), + cBOOL(data.flags & SF_FIX_BEFORE_MEOL))) { r->anchored_offset = data.offset_fixed - data.lookbehind_fixed; SvREFCNT_inc_simple_void_NN(data.longest_fixed); @@ -6299,11 +6169,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); @@ -6371,11 +6241,11 @@ reStudy: 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); @@ -6440,7 +6310,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; } @@ -6480,6 +6350,14 @@ reStudy: PerlIO_printf(Perl_debug_log, "\n"); }); #endif + +#ifdef USE_ITHREADS + /* under ithreads the ?pat? PMf_USED flag on the pmop is simulated + * by setting the regexp SV to readonly-only instead. If the + * pattern's been recompiled, the USEDness should remain. */ + if (old_re && SvREADONLY(old_re)) + SvREADONLY_on(rx); +#endif return rx; } @@ -6584,7 +6462,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; @@ -6661,7 +6539,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); @@ -6930,11 +6808,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"); @@ -7055,7 +6933,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) @@ -7174,7 +7051,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* @@ -7247,6 +7126,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; } @@ -7375,9 +7261,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); @@ -7541,7 +7425,7 @@ void Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, bool complement_b, SV** output) { /* Take the union of two inversion lists and point to it. *output - * should be defined upon input, and if it points to one of the two lists, + * SHOULD BE DEFINED upon input, and if it points to one of the two lists, * the reference count to that list will be decremented. The first list, * , may be NULL, in which case a copy of the second list is returned. * If is TRUE, the union is taken of the complement @@ -7588,7 +7472,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) { @@ -7601,14 +7485,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); @@ -7762,16 +7646,17 @@ 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); - } - /* If we've changed b, restore it */ if (complement_b) { array_b[0] = 1; } + /* We may be removing a reference to one of the inputs */ + if (a == *output || b == *output) { + assert(! invlist_is_iterating(*output)); + SvREFCNT_dec_NN(*output); + } + *output = u; return; } @@ -7780,7 +7665,7 @@ void Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, bool complement_b, SV** i) { /* Take the intersection of two inversion lists and point to it. *i - * should be defined upon input, and if it points to one of the two lists, + * SHOULD BE DEFINED upon input, and if it points to one of the two lists, * the reference count to that list will be decremented. * If is TRUE, the result will be the intersection of * and the complement (or inversion) of instead of directly. @@ -7832,7 +7717,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' */ @@ -7842,10 +7727,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; @@ -7983,16 +7868,17 @@ 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); - } - /* If we've changed b, restore it */ if (complement_b) { array_b[0] = 1; } + /* We may be removing a reference to one of the inputs */ + if (a == *i || b == *i) { + assert(! invlist_is_iterating(*i)); + SvREFCNT_dec_NN(*i); + } + *i = r; return; } @@ -8017,10 +7903,11 @@ Perl__add_range_to_invlist(pTHX_ SV* invlist, const UV start, const UV end) len = _invlist_len(invlist); } - /* If comes after the final entry, can just append it to the end */ + /* If comes after the final entry actually in the list, can just append it + * to the end, */ if (len == 0 - || start >= invlist_array(invlist) - [_invlist_len(invlist) - 1]) + || (! ELEMENT_RANGE_MATCHES_INVLIST(len - 1) + && start >= invlist_array(invlist)[len - 1])) { _append_range_to_invlist(invlist, start, end); return invlist; @@ -8034,7 +7921,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; } @@ -8058,6 +7945,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); @@ -8163,6 +8052,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) { @@ -8180,7 +8085,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; } @@ -8198,6 +8103,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) { @@ -8241,6 +8154,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) { @@ -8273,6 +8188,11 @@ Perl__invlist_dump(pTHX_ SV* const invlist, const char * const header) 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) { @@ -8368,6 +8288,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 */ @@ -8660,7 +8581,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);*/ @@ -9553,6 +9474,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)) { @@ -10120,10 +10051,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: @@ -10164,7 +10099,8 @@ tryagain: case '[': { char * const oregcomp_parse = ++RExC_parse; - ret = regclass(pRExC_state, flagp,depth+1); + ret = regclass(pRExC_state, flagp,depth+1, + FALSE /* means parse the whole char class */ ); if (*RExC_parse != ']') { RExC_parse = oregcomp_parse; vFAIL("Unmatched ["); @@ -10218,6 +10154,7 @@ tryagain: literal text handling code. */ switch ((U8)*++RExC_parse) { + U8 arg; /* Special Escapes */ case 'A': RExC_seen_zerolen++; @@ -10258,22 +10195,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; @@ -10296,60 +10225,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 */ @@ -10357,32 +10288,15 @@ tryagain: case 'p': case 'P': { - char* const oldregxend = RExC_end; #ifdef DEBUGGING char* parse_start = RExC_parse - 2; #endif - if (RExC_parse[1] == '{') { - /* a lovely hack--pretend we saw [\pX] instead */ - RExC_end = strchr(RExC_parse, '}'); - if (!RExC_end) { - const U8 c = (U8)*RExC_parse; - RExC_parse += 2; - RExC_end = oldregxend; - vFAIL2("Missing right brace on \\%c{}", c); - } - RExC_end++; - } - else { - RExC_end = RExC_parse + 2; - if (RExC_end > oldregxend) - RExC_end = oldregxend; - } RExC_parse--; - ret = regclass(pRExC_state, flagp,depth+1); + ret = regclass(pRExC_state, flagp,depth+1, + TRUE /* means just parse this element */ ); - RExC_end = oldregxend; RExC_parse--; Set_Node_Offset(ret, parse_start + 2); @@ -10698,25 +10612,21 @@ tryagain: break; case 'o': { - STRLEN brace_len = len; UV result; const char* error_msg; - bool valid = grok_bslash_o(p, + bool valid = grok_bslash_o(&p, &result, - &brace_len, &error_msg, - 1); - p += brace_len; + TRUE, /* out warnings */ + FALSE, /* not strict */ + UTF); if (! valid) { RExC_parse = p; /* going to die anyway; point to exact spot of failure */ vFAIL(error_msg); } - else - { - ender = result; - } + ender = result; if (PL_encoding && ender < 0x100) { goto recode_encoding; } @@ -10727,24 +10637,22 @@ tryagain: } case 'x': { - STRLEN brace_len = len; UV result; const char* error_msg; - bool valid = grok_bslash_x(p, + bool valid = grok_bslash_x(&p, &result, - &brace_len, &error_msg, - 1); - p += brace_len; + TRUE, /* out warnings */ + FALSE, /* not strict */ + UTF); if (! valid) { RExC_parse = p; /* going to die anyway; point to exact spot of failure */ vFAIL(error_msg); } - else { - ender = result; - } + ender = result; + if (PL_encoding && ender < 0x100) { goto recode_encoding; } @@ -10894,7 +10802,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)) @@ -10916,7 +10824,7 @@ tryagain: len += foldlen - 1; } else { - *(s++) = ender; + *(s++) = (char) ender; maybe_exact &= ! IS_IN_SOME_FOLD_L1(ender); } } @@ -11250,9 +11158,9 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value, SV *free_me) 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 */ @@ -11302,69 +11210,6 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value, SV *free_me) return namedclass; } -/* 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. - * 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 */ -#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 @@ -11372,7 +11217,7 @@ S_regpposixcc(pTHX_ RExC_state_t *pRExC_state, I32 value, SV *free_me) #define HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION (SvCUR(listsv) != initial_listsv_len) STATIC regnode * -S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) +S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, const bool stop_at_1) { /* parse a bracketed class specification. Most of these will produce an ANYOF node; * but something like [a] will produce an EXACT node; [aA], an EXACTFish @@ -11416,6 +11261,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) AV * multi_char_matches = NULL; /* Code points that fold to more than one character; used under /i */ UV n; + char * stop_ptr = RExC_end; /* where to stop parsing */ /* Unicode properties are stored in a swash; this holds the current one * being parsed. If this swash is the only above-latin1 component of the @@ -11465,10 +11311,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) /* Assume we are going to generate an ANYOF node. */ ret = reganode(pRExC_state, ANYOF, 0); - if (!SIZE_ONLY) { - ANYOF_FLAGS(ret) = 0; - } - if (UCHARAT(RExC_parse) == '^') { /* Complement of range. */ RExC_parse++; invert = TRUE; @@ -11480,6 +11322,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) listsv = &PL_sv_undef; /* For code scanners: listsv always non-NULL. */ } else { + ANYOF_FLAGS(ret) = 0; + RExC_emit += ANYOF_SKIP; if (LOC) { ANYOF_FLAGS(ret) |= ANYOF_LOCALE; @@ -11490,12 +11334,12 @@ 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)) - { + /* Check that they didn't say [:posix:] instead of [[:posix:]] */ + if (!SIZE_ONLY && POSIXCC(nextvalue)) { const char *s = RExC_parse; const char c = *s++; - while (isALNUM(*s)) + while (isWORDCHAR(*s)) s++; if (*s && c == *s && s[1] == ']') { SAVEFREESV(RExC_rx_sv); @@ -11508,12 +11352,18 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } } + /* If the caller wants us to just parse a single element, accomplish this + * by faking the loop ending condition */ + if (stop_at_1 && RExC_end > RExC_parse) { + stop_ptr = RExC_parse + 1; + } + /* allow 1st char to be ] (allowing it to be - is dealt with later) */ if (UCHARAT(RExC_parse) == ']') goto charclassloop; parseit: - while (RExC_parse < RExC_end && UCHARAT(RExC_parse) != ']') { + while (RExC_parse < stop_ptr && UCHARAT(RExC_parse) != ']') { charclassloop: @@ -11581,7 +11431,7 @@ parseit: { char *e; - /* This routine will handle any undefined properties */ + /* We will handle any undefined properties ourselves */ U8 swash_init_flags = _CORE_SWASH_INIT_RETURN_IF_UNDEF; if (RExC_parse >= RExC_end) @@ -11610,7 +11460,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--; @@ -11633,7 +11487,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 */ @@ -11643,7 +11497,7 @@ parseit: ); if (! swash || ! (invlist = _get_swash_invlist(swash))) { if (swash) { - SvREFCNT_dec(swash); + SvREFCNT_dec_NN(swash); swash = NULL; } @@ -11682,7 +11536,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 { @@ -11709,12 +11563,12 @@ parseit: RExC_parse--; /* function expects to be pointed at the 'o' */ { const char* error_msg; - bool valid = grok_bslash_o(RExC_parse, + bool valid = grok_bslash_o(&RExC_parse, &value, - &numlen, &error_msg, - SIZE_ONLY); - RExC_parse += numlen; + SIZE_ONLY, + FALSE, /* Not strict */ + UTF); if (! valid) { vFAIL(error_msg); } @@ -11727,12 +11581,12 @@ parseit: RExC_parse--; /* function expects to be pointed at the 'x' */ { const char* error_msg; - bool valid = grok_bslash_x(RExC_parse, + bool valid = grok_bslash_x(&RExC_parse, &value, - &numlen, &error_msg, - 1); - RExC_parse += numlen; + TRUE, /* Output warnings */ + FALSE, /* Not strict */ + UTF); if (! valid) { vFAIL(error_msg); } @@ -11766,7 +11620,7 @@ 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, @@ -11777,36 +11631,35 @@ parseit: } break; } - } /* end of \blah */ + } /* end of handling backslash escape sequences */ #ifdef EBCDIC else literal_endpoint++; #endif - /* What matches in a locale is not known until runtime. This - * includes what the Posix classes (like \w, [:space:]) match. - * Room must be reserved (one time per class) to store such - * classes, either if Perl is compiled so that locale nodes always - * should have this space, or if there is such class info to be - * stored. The space will contain a bit for each named class that - * is to be matched against. This isn't needed for \p{} and - * pseudo-classes, as they are not affected by locale, and hence - * are dealt with separately */ - if (LOC - && ! need_class - && (ANYOF_LOCALE == ANYOF_CLASS - || (namedclass > OOB_NAMEDCLASS && namedclass < ANYOF_MAX))) - { - need_class = 1; - if (SIZE_ONLY) { - RExC_size += ANYOF_CLASS_SKIP - ANYOF_SKIP; - } - else { - RExC_emit += ANYOF_CLASS_SKIP - ANYOF_SKIP; - ANYOF_CLASS_ZERO(ret); - } - ANYOF_FLAGS(ret) |= ANYOF_CLASS; - } + /* What matches in a locale is not known until runtime. This includes + * what the Posix classes (like \w, [:space:]) match. Room must be + * reserved (one time per class) to store such classes, either if Perl + * is compiled so that locale nodes always should have this space, or + * if there is such class info to be stored. The space will contain a + * bit for each named class that is to be matched against. This isn't + * needed for \p{} and pseudo-classes, as they are not affected by + * locale, and hence are dealt with separately */ + if (LOC + && ! need_class + && (ANYOF_LOCALE == ANYOF_CLASS + || (namedclass > OOB_NAMEDCLASS && namedclass < ANYOF_MAX))) + { + need_class = 1; + if (SIZE_ONLY) { + RExC_size += ANYOF_CLASS_SKIP - ANYOF_SKIP; + } + else { + RExC_emit += ANYOF_CLASS_SKIP - ANYOF_SKIP; + ANYOF_CLASS_ZERO(ret); + } + ANYOF_FLAGS(ret) |= ANYOF_CLASS; + } if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */ @@ -11835,283 +11688,253 @@ parseit: if (! SIZE_ONLY) { U8 classnum = namedclass_to_classnum(namedclass); - switch ((I32)namedclass) { - - case ANYOF_ALPHANUMERIC: /* C's alnum, in contrast to \w */ - case ANYOF_ALPHA: - case ANYOF_GRAPH: - case ANYOF_PRINT: - case ANYOF_PUNCT: - case ANYOF_WORDCHAR: - if ( ! PL_utf8_swash_ptrs[classnum]) { - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_Posix_ptrs[classnum], PL_L1Posix_ptrs[classnum], swash_property_names[classnum], listsv); - break; - } - if (! PL_XPosix_ptrs[classnum]) { - PL_XPosix_ptrs[classnum] - = _swash_to_invlist(PL_utf8_swash_ptrs[classnum]); - } - /* FALL THROUGH */ + 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; + } -#ifdef HAS_ISBLANK - case ANYOF_BLANK: -#endif - case ANYOF_CNTRL: - case ANYOF_PSXSPC: - case ANYOF_SPACE: - case ANYOF_XDIGIT: - do_posix: + _invlist_union_maybe_complement_2nd( + cp_list, + PL_XPosix_ptrs[classnum], + cBOOL(namedclass % 2), /* Complement if odd + (NHORIZWS, NVERTWS) + */ + &cp_list); + } + } + else if (classnum == _CC_ASCII) { +#ifdef HAS_ISASCII if (LOC) { - SV* scratch_list = NULL; - - /* Set this class in the node for runtime matching */ ANYOF_CLASS_SET(ret, namedclass); - - /* 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 +#endif /* Not isascii(); just use the hard-coded definition for it */ + _invlist_union_maybe_complement_2nd( + posixes, + PL_ASCII, + cBOOL(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; } - else { - _invlist_union(posixes, scratch_list, &posixes); - SvREFCNT_dec(scratch_list); + + /* 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]); } } - else { - /* For non-locale, just add it to any existing list */ - _invlist_union(posixes, - (AT_LEAST_ASCII_RESTRICTED) - ? PL_Posix_ptrs[classnum] - : PL_XPosix_ptrs[classnum], - &posixes); - } - break; - case ANYOF_NALPHANUMERIC: - case ANYOF_NALPHA: - case ANYOF_NGRAPH: - case ANYOF_NPRINT: - case ANYOF_NPUNCT: - case ANYOF_NWORDCHAR: - if ( ! PL_utf8_swash_ptrs[classnum]) { - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_Posix_ptrs[classnum], PL_L1Posix_ptrs[classnum], swash_property_names[classnum], listsv, - runtime_posix_matches_above_Unicode); - break; - } - if (! PL_XPosix_ptrs[classnum]) { - PL_XPosix_ptrs[classnum] - = _swash_to_invlist(PL_utf8_swash_ptrs[classnum]); - } - /* FALL THROUGH */ + /* 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 { /* 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); + } -#ifdef HAS_ISBLANK - case ANYOF_NBLANK: +#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 - case ANYOF_NCNTRL: - case ANYOF_NPSXSPC: - case ANYOF_NSPACE: - case ANYOF_NXDIGIT: - do_n_posix: - if (LOC) { - SV* scratch_list = NULL; - ANYOF_CLASS_SET(ret, namedclass); - _invlist_subtract(PL_AboveLatin1, - PL_XPosix_ptrs[classnum], - &scratch_list); - if (! posixes) { - posixes = scratch_list; - } - else { - _invlist_union(posixes, scratch_list, &posixes); - SvREFCNT_dec(scratch_list); } } - else { - _invlist_union_complement_2nd( + 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; - } - } - break; - - case ANYOF_ASCII: -#ifdef HAS_ISASCII - 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; + /* 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; + } } -#ifdef HAS_ISASCII - } -#endif - break; - -#ifndef HAS_ISBLANK - case ANYOF_BLANK: - if (! LOC) { - goto do_posix; - } - 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, + else { /* Locale */ + SV* scratch_list = NULL; + _invlist_subtract(PL_AboveLatin1, PL_XPosix_ptrs[classnum], &scratch_list); - /* Add it to the running total of posix classes */ - if (! posixes) { - posixes = scratch_list; - } - else { - _invlist_union(posixes, scratch_list, &posixes); - SvREFCNT_dec(scratch_list); - } - /* Add the ASCII-range blanks to the running total. */ - _invlist_union(posixes, PL_Posix_ptrs[classnum], &posixes); - } - break; - case ANYOF_NBLANK: - if (! LOC) { - goto do_n_posix; - } - 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_XPosix_ptrs[classnum], - &scratch_list); - - /* Add them to the running total of posix classes */ - _invlist_subtract(PL_AboveLatin1, PL_XPosix_ptrs[classnum], - &scratch_list); - if (! posixes) { - posixes = scratch_list; - } - else { - _invlist_union(posixes, scratch_list, &posixes); - SvREFCNT_dec(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_Posix_ptrs[classnum], - &scratch_list); - _invlist_union(posixes, scratch_list, &posixes); - SvREFCNT_dec(scratch_list); } - break; -#endif - 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_Posix_ptrs[classnum], swash_property_names[classnum], listsv); - break; - case ANYOF_NDIGIT: - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - PL_Posix_ptrs[classnum], PL_Posix_ptrs[classnum], swash_property_names[classnum], listsv, - runtime_posix_matches_above_Unicode); - break; - case ANYOF_LOWER: - case ANYOF_NLOWER: - case ANYOF_UPPER: - case ANYOF_NUPPER: - { /* 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_Posix_ptrs[_CC_ALPHA]; - l1_source = PL_L1Cased; - Xname = "Cased"; - } - else { - ascii_source = PL_Posix_ptrs[classnum]; - l1_source = PL_L1Posix_ptrs[classnum]; - Xname = swash_property_names[classnum]; - } - if (namedclass % 2) { /* If odd, is the complemented version */ - DO_N_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, - posixes, ascii_source, l1_source, Xname, listsv, - runtime_posix_matches_above_Unicode); - } - else { - DO_POSIX_LATIN1_ONLY_KNOWN(ret, namedclass, posixes, - ascii_source, l1_source, Xname, listsv); - } - break; - } - case ANYOF_HORIZWS: - /* For these, we use the cp_list, as 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. - * - * It turns out that \h is just a synonym for XPosixBlank */ - classnum = _CC_BLANK; - /* FALL THROUGH */ - - case ANYOF_VERTWS: - _invlist_union(cp_list, PL_XPosix_ptrs[classnum], &cp_list); - break; - - case ANYOF_NHORIZWS: - classnum = _CC_BLANK; - /* FALL THROUGH */ - - case ANYOF_NVERTWS: - _invlist_union_complement_2nd(cp_list, - PL_XPosix_ptrs[classnum], - &cp_list); - break; - - case ANYOF_UNIPROP: /* this is to handle \p and \P */ - break; - - default: - vFAIL("Invalid [::] class"); - break; - } - + } + namedclass_done: continue; /* Go get next character */ } } /* end of namedclass \blah */ @@ -12356,8 +12179,8 @@ parseit: RExC_parse = save_parse; RExC_end = save_end; RExC_in_multi_char_class = 0; - SvREFCNT_dec(multi_char_matches); - SvREFCNT_dec(listsv); + SvREFCNT_dec_NN(multi_char_matches); + SvREFCNT_dec_NN(listsv); return ret; } @@ -12371,110 +12194,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_UNIPROP: - 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; } } @@ -12499,8 +12289,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; } } } @@ -12526,6 +12316,11 @@ parseit: } else { RExC_emit = (regnode *)orig_emit; + if (PL_regkind[op] == POSIXD) { + if (invert) { + op += NPOSIXD - POSIXD; + } + } } ret = reg_node(pRExC_state, op); @@ -12543,7 +12338,7 @@ parseit: RExC_parse = (char *) cur_parse; SvREFCNT_dec(posixes); - SvREFCNT_dec(listsv); + SvREFCNT_dec_NN(listsv); SvREFCNT_dec(cp_list); return ret; } @@ -12577,7 +12372,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 @@ -12779,7 +12574,7 @@ parseit: } } } - SvREFCNT_dec(fold_intersection); + SvREFCNT_dec_NN(fold_intersection); } /* And combine the result (if any) with any inversion list from posix @@ -12790,7 +12585,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; @@ -12808,7 +12603,7 @@ parseit: &posixes); if (cp_list) { _invlist_union(cp_list, posixes, &cp_list); - SvREFCNT_dec(posixes); + SvREFCNT_dec_NN(posixes); } else { cp_list = posixes; @@ -12817,7 +12612,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; @@ -12859,14 +12654,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; } } @@ -12892,7 +12687,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; } @@ -12930,12 +12725,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 @@ -12986,7 +12781,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; @@ -13016,6 +12811,7 @@ parseit: RExC_naughty++; } } + invlist_iterfinish(cp_list); if (op != END) { RExC_parse = (char *)orig_parse; @@ -13029,8 +12825,8 @@ parseit: alloc_maybe_populate_EXACT(pRExC_state, ret, flagp, 0, value); } - SvREFCNT_dec(cp_list); - SvREFCNT_dec(listsv); + SvREFCNT_dec_NN(cp_list); + SvREFCNT_dec_NN(listsv); return ret; } } @@ -13075,6 +12871,7 @@ parseit: } } } + invlist_iterfinish(cp_list); /* Done with loop; remove any code points that are in the bitmap from * */ @@ -13084,7 +12881,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; } } @@ -13099,7 +12896,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; @@ -13109,7 +12906,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; } @@ -13117,7 +12914,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: @@ -13135,10 +12932,10 @@ parseit: av_store(av, 0, (HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION) ? listsv - : (SvREFCNT_dec(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); @@ -13755,10 +13552,11 @@ 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[] = { #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_SPACE != 9 \ - || _CC_BLANK != 10 || _CC_XDIGIT != 11 || _CC_PSXSPC != 12 \ - || _CC_CNTRL != 13 || _CC_ASCII != 14 || _CC_VERTSPACE != 15 + || _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]", @@ -13779,6 +13577,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) "[:^alnum:]", "[:graph:]", "[:^graph:]", + "[:cased:]", + "[:^cased:]", "[\\s]", "[\\S]", "[:blank:]", @@ -14045,7 +13845,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) Safefree(origs); } - SvREFCNT_dec(lv); + SvREFCNT_dec_NN(lv); } } @@ -14189,7 +13989,7 @@ Perl_reg_temp_copy (pTHX_ REGEXP *ret_x, REGEXP *rx) ret_x->sv_u.svu_rx = temp->sv_any; temp->sv_any = NULL; SvFLAGS(temp) = (SvFLAGS(temp) & ~SVTYPEMASK) | SVt_NULL; - SvREFCNT_dec(temp); + 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));