+ case COMMIT:
+ reginfo->cutpoint = PL_regeol;
+ /* FALLTHROUGH */
+ case PRUNE:
+ PL_reginput = locinput;
+ if (!scan->flags)
+ sv_yes_mark = sv_commit = (SV*)rexi->data->data[ ARG( scan ) ];
+ PUSH_STATE_GOTO(COMMIT_next,next);
+ /* NOTREACHED */
+ case COMMIT_next_fail:
+ no_final = 1;
+ /* FALLTHROUGH */
+ case OPFAIL:
+ sayNO;
+ /* NOTREACHED */
+
+#define ST st->u.mark
+ case MARKPOINT:
+ ST.prev_mark = mark_state;
+ ST.mark_name = sv_commit = sv_yes_mark
+ = (SV*)rexi->data->data[ ARG( scan ) ];
+ mark_state = st;
+ ST.mark_loc = PL_reginput = locinput;
+ PUSH_YES_STATE_GOTO(MARKPOINT_next,next);
+ /* NOTREACHED */
+ case MARKPOINT_next:
+ mark_state = ST.prev_mark;
+ sayYES;
+ /* NOTREACHED */
+ case MARKPOINT_next_fail:
+ if (popmark && sv_eq(ST.mark_name,popmark))
+ {
+ if (ST.mark_loc > startpoint)
+ reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
+ popmark = NULL; /* we found our mark */
+ sv_commit = ST.mark_name;
+
+ DEBUG_EXECUTE_r({
+ PerlIO_printf(Perl_debug_log,
+ "%*s %ssetting cutpoint to mark:%"SVf"...%s\n",
+ REPORT_CODE_OFF+depth*2, "",
+ PL_colors[4], SVfARG(sv_commit), PL_colors[5]);
+ });
+ }
+ mark_state = ST.prev_mark;
+ sv_yes_mark = mark_state ?
+ mark_state->u.mark.mark_name : NULL;
+ sayNO;
+ /* NOTREACHED */
+ case SKIP:
+ PL_reginput = locinput;
+ if (scan->flags) {
+ /* (*SKIP) : if we fail we cut here*/
+ ST.mark_name = NULL;
+ ST.mark_loc = locinput;
+ PUSH_STATE_GOTO(SKIP_next,next);
+ } else {
+ /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was,
+ otherwise do nothing. Meaning we need to scan
+ */
+ regmatch_state *cur = mark_state;
+ SV *find = (SV*)rexi->data->data[ ARG( scan ) ];
+
+ while (cur) {
+ if ( sv_eq( cur->u.mark.mark_name,
+ find ) )
+ {
+ ST.mark_name = find;
+ PUSH_STATE_GOTO( SKIP_next, next );
+ }
+ cur = cur->u.mark.prev_mark;
+ }
+ }
+ /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */
+ break;
+ case SKIP_next_fail:
+ if (ST.mark_name) {
+ /* (*CUT:NAME) - Set up to search for the name as we
+ collapse the stack*/
+ popmark = ST.mark_name;
+ } else {
+ /* (*CUT) - No name, we cut here.*/
+ if (ST.mark_loc > startpoint)
+ reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1);
+ /* but we set sv_commit to latest mark_name if there
+ is one so they can test to see how things lead to this
+ cut */
+ if (mark_state)
+ sv_commit=mark_state->u.mark.mark_name;
+ }
+ no_final = 1;
+ sayNO;
+ /* NOTREACHED */
+#undef ST
+ case FOLDCHAR:
+ n = ARG(scan);
+ if ( n == (U32)what_len_TRICKYFOLD(locinput,do_utf8,ln) ) {
+ locinput += ln;
+ } else if ( 0xDF == n && !do_utf8 && !UTF ) {
+ sayNO;
+ } else {
+ U8 folded[UTF8_MAXBYTES_CASE+1];
+ STRLEN foldlen;
+ const char * const l = locinput;
+ char *e = PL_regeol;
+ to_uni_fold(n, folded, &foldlen);
+
+ if (ibcmp_utf8((const char*) folded, 0, foldlen, 1,
+ l, &e, 0, do_utf8)) {
+ sayNO;
+ }
+ locinput = e;
+ }
+ nextchr = UCHARAT(locinput);
+ break;
+ case LNBREAK:
+ if ((n=is_LNBREAK(locinput,do_utf8))) {
+ locinput += n;
+ nextchr = UCHARAT(locinput);
+ } else
+ sayNO;
+ break;
+
+#define CASE_CLASS(nAmE) \
+ case nAmE: \
+ if ((n=is_##nAmE(locinput,do_utf8))) { \
+ locinput += n; \
+ nextchr = UCHARAT(locinput); \
+ } else \
+ sayNO; \
+ break; \
+ case N##nAmE: \
+ if ((n=is_##nAmE(locinput,do_utf8))) { \
+ sayNO; \
+ } else { \
+ locinput += UTF8SKIP(locinput); \
+ nextchr = UCHARAT(locinput); \
+ } \
+ break
+
+ CASE_CLASS(VERTWS);
+ CASE_CLASS(HORIZWS);
+#undef CASE_CLASS
+
https://perl5.git.perl.org / perl5.git / blobdiff