Commit fabf08ee1f for perl
commit fabf08ee1f23af185107637e601f0601076de257
Author: Yves Orton <demerphq@gmail.com>
Date: Tue Oct 27 21:36:54 2026 +0100
regcomp: name lookbehind (IFMATCH/UNLESSM) properties, also SBOL etc
Name the lookbehind length, extra starts, and absolute-start anchor. Set
the length only on IFMATCH and UNLESSM nodes: SUSPEND shares setup code
but does not store a lookbehind length.
diff --git a/regcomp.c b/regcomp.c
index 6a07c5b421..a385ee6fb2 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -2016,7 +2016,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
if (OP(first) == OPEN)
sawopen = 1;
else
- if (OP(first) == IFMATCH && !FLAGS(first))
+ if (OP(first) == IFMATCH && !IS_LOOKBEHIND(first))
/* for now we can't handle lookbehind IFMATCH */
sawlookahead = 1;
else
@@ -2402,7 +2402,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
*/
if (REGNODE_TYPE(fop) == NOTHING && nop == END)
RExC_rx->extflags |= RXf_NULL;
- else if ((fop == MBOL || (fop == SBOL && !FLAGS(first))) && nop == END)
+ else if ((fop == MBOL || (fop == SBOL && !SBOL_IS_ABSOLUTE(first))) && nop == END)
/* when fop is SBOL first->flags will be true only when it was
* produced by parsing /\A/, and not when parsing /^/. This is
* very important for the split code as there we want to
@@ -4707,7 +4707,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
}
reginsert(pRExC_state, node, ret, depth+1);
- FLAGS(REGNODE_p(ret)) = flag;
+ if (node != SUSPEND)
+ LOOKBEHIND_MAX_CHARS_SET(REGNODE_p(ret), flag);
if (! REGTAIL_STUDY(pRExC_state, ret, reg_node(pRExC_state, TAIL)))
{
REQUIRE_BRANCHJ(flagp, 0);
@@ -5967,7 +5968,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
ret = reg_node(pRExC_state, SBOL);
/* SBOL is shared with /^/ so we set the flags so we can tell
* /\A/ from /^/ in split. */
- FLAGS(REGNODE_p(ret)) = 1;
+ SBOL_IS_ABSOLUTE_SET(REGNODE_p(ret), TRUE);
}
goto finish_meta_pat;
case 'G':
diff --git a/regcomp.h b/regcomp.h
index 317fbc0a3b..2cb0d6a35c 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -655,6 +655,13 @@ struct regnode_ssc {
FLAGS(p) = (val); \
} STMT_END
+#define LOOKBEHIND_MAX_CHARS(p) \
+ (assert(OP(p) == IFMATCH || OP(p) == UNLESSM), PREVENT_LVALUE(FLAGS(p)))
+#define LOOKBEHIND_MAX_CHARS_SET(p, val) STMT_START { \
+ assert(OP(p) == IFMATCH || OP(p) == UNLESSM); \
+ FLAGS(p) = (val); \
+} STMT_END
+
#define LOGICAL_MODE(p) \
(assert(OP(p) == LOGICAL), PREVENT_LVALUE(FLAGS(p) & EVAL_FLAGS_MASK))
#define LOGICAL_MODE_SET(p, val) STMT_START { \
@@ -694,6 +701,22 @@ struct regnode_ssc {
EVAL_OPTIMISTIC_FLAG : 0); \
} STMT_END
+#define SBOL_IS_ABSOLUTE(p) \
+ (assert(OP(p) == SBOL), PREVENT_LVALUE(FLAGS(p) != 0))
+#define SBOL_IS_ABSOLUTE_SET(p, val) STMT_START { \
+ assert(OP(p) == SBOL); \
+ FLAGS(p) = cBOOL(val); \
+} STMT_END
+
+#define LOOKBEHIND_EXTRA_STARTS(p) \
+ (assert(OP(p) == IFMATCH || OP(p) == UNLESSM), \
+ PREVENT_LVALUE(NEXT_OFF(p)))
+#define LOOKBEHIND_EXTRA_STARTS_SET(p, val) STMT_START { \
+ assert(OP(p) == IFMATCH || OP(p) == UNLESSM); \
+ NEXT_OFF_set((p), (val)); \
+} STMT_END
+
+#define IS_LOOKBEHIND(p) (LOOKBEHIND_MAX_CHARS(p) != 0)
/* the following define was set to 0xde in 075abff3
* as part of some linting logic. I have set it to 0
diff --git a/regcomp_debug.c b/regcomp_debug.c
index 79655362ec..f0ebf0da9b 100644
--- a/regcomp_debug.c
+++ b/regcomp_debug.c
@@ -1051,14 +1051,14 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_
sv_catpv(sv, bounds[FLAGS(o)]);
}
else if (k == BRANCHJ && (op == UNLESSM || op == IFMATCH)) {
- sv_catpvf(sv, "[%d", -(FLAGS(o)));
- if (NEXT_OFF(o)) {
- sv_catpvf(sv, "..-%d", FLAGS(o) - NEXT_OFF(o));
+ sv_catpvf(sv, "[%d", -(LOOKBEHIND_MAX_CHARS(o)));
+ if (LOOKBEHIND_EXTRA_STARTS(o)) {
+ sv_catpvf(sv, "..-%d", LOOKBEHIND_MAX_CHARS(o) - LOOKBEHIND_EXTRA_STARTS(o));
}
sv_catpvf(sv, "]");
}
else if (op == SBOL)
- sv_catpvf(sv, " /%s/", FLAGS(o) ? "\\A" : "^");
+ sv_catpvf(sv, " /%s/", SBOL_IS_ABSOLUTE(o) ? "\\A" : "^");
else if (op == EVAL) {
if (EVAL_IS_OPTIMISTIC(o))
sv_catpvf(sv, " optimistic");
diff --git a/regcomp_study.c b/regcomp_study.c
index cc08d4c7de..e525048e1e 100644
--- a/regcomp_study.c
+++ b/regcomp_study.c
@@ -3258,10 +3258,9 @@ Perl_study_chunk(pTHX_
scan_commit(pRExC_state, data, minlenp, is_inf);
}
- else if ( REGNODE_TYPE(OP(scan)) == BRANCHJ
+ else if ( (OP(scan) == IFMATCH || OP(scan) == UNLESSM)
/* Lookbehind, or need to calculate parens/evals/stclass: */
- && (FLAGS(scan) || data || (flags & SCF_DO_STCLASS))
- && (OP(scan) == IFMATCH || OP(scan) == UNLESSM))
+ && (IS_LOOKBEHIND(scan) || data || (flags & SCF_DO_STCLASS)))
{
if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY
|| OP(scan) == UNLESSM )
@@ -3296,7 +3295,7 @@ Perl_study_chunk(pTHX_
cur_last_close_op = *(data_fake.last_close_opp);
data_fake.pos_delta = delta;
- if ( flags & SCF_DO_STCLASS && !FLAGS(scan)
+ if ( flags & SCF_DO_STCLASS && !LOOKBEHIND_MAX_CHARS(scan)
&& OP(scan) == IFMATCH ) { /* Lookahead */
ssc_init(pRExC_state, &intrnl);
data_fake.start_class = &intrnl;
@@ -3319,7 +3318,7 @@ Perl_study_chunk(pTHX_
if ((f & SCF_DO_STCLASS_AND) && minnext == 0)
ssc_init(pRExC_state, &intrnl);
- if (FLAGS(scan)) {
+ if (LOOKBEHIND_MAX_CHARS(scan)) {
if ( deltanext < 0
|| deltanext > (I32) U8_MAX
|| minnext > (I32)U8_MAX
@@ -3335,7 +3334,7 @@ Perl_study_chunk(pTHX_
* matches to avoid breakage for those not using this
* extension) */
if (deltanext) {
- NEXT_OFF_set(scan, deltanext);
+ LOOKBEHIND_EXTRA_STARTS_SET(scan, deltanext);
if (
/* See a CLOSE op inside this lookbehind? */
cur_last_close_op != *(data_fake.last_close_opp)
@@ -3350,7 +3349,7 @@ Perl_study_chunk(pTHX_
is_positive ? "positive" : "negative");
}
}
- FLAGS(scan) = (U8)minnext + deltanext;
+ LOOKBEHIND_MAX_CHARS_SET(scan, (U8)minnext + deltanext);
}
if (data) {
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
@@ -3406,7 +3405,7 @@ Perl_study_chunk(pTHX_
StructCopy(data, &data_fake, scan_data_t);
if ((flags & SCF_DO_SUBSTR) && data->last_found) {
f |= SCF_DO_SUBSTR;
- if (FLAGS(scan))
+ if (LOOKBEHIND_MAX_CHARS(scan))
scan_commit(pRExC_state, &data_fake, minlenp, is_inf);
data_fake.last_found = newSVsv(data->last_found);
}
@@ -3421,7 +3420,7 @@ Perl_study_chunk(pTHX_
data_fake.pos_delta = delta;
if (is_inf)
data_fake.flags |= SF_IS_INF;
- if ( flags & SCF_DO_STCLASS && !FLAGS(scan)
+ if ( flags & SCF_DO_STCLASS && !LOOKBEHIND_MAX_CHARS(scan)
&& OP(scan) == IFMATCH ) { /* Lookahead */
ssc_init(pRExC_state, &intrnl);
data_fake.start_class = &intrnl;
@@ -3439,7 +3438,7 @@ Perl_study_chunk(pTHX_
f, depth+1, mutate_ok);
if ((f & SCF_DO_STCLASS_AND) && *minnextp == 0)
ssc_init(pRExC_state, &intrnl);
- if (FLAGS(scan)) {
+ if (LOOKBEHIND_MAX_CHARS(scan)) {
assert(0); /* This code has never been tested since this
is normally not compiled */
if ( deltanext < 0
@@ -3452,9 +3451,9 @@ Perl_study_chunk(pTHX_
}
if (deltanext) {
- NEXT_OFF_set(scan, deltanext);
+ LOOKBEHIND_EXTRA_STARTS_SET(scan, deltanext);
}
- FLAGS(scan) = (U8)*minnextp + deltanext;
+ LOOKBEHIND_MAX_CHARS_SET(scan, (U8)*minnextp + deltanext);
}
*minnextp += min;
@@ -3483,7 +3482,7 @@ Perl_study_chunk(pTHX_
data_fake.substrs[i].max_offset;
data->substrs[i].minlenp =
data_fake.substrs[i].minlenp;
- data->substrs[i].lookbehind += FLAGS(scan);
+ data->substrs[i].lookbehind += LOOKBEHIND_MAX_CHARS(scan);
}
}
}
diff --git a/regexec.c b/regexec.c
index 6a526ca838..a02c653278 100644
--- a/regexec.c
+++ b/regexec.c
@@ -202,8 +202,8 @@ static const char non_utf8_target_but_utf8_required[]
else if (type == PLUS) \
rn = REGNODE_AFTER_type(rn,tregnode_PLUS); \
else if (type == IFMATCH) \
- rn = (FLAGS(rn) == 0) ? REGNODE_AFTER_type(rn,tregnode_IFMATCH) \
- : rn + ARG1u(rn); \
+ rn = (!IS_LOOKBEHIND(rn)) ? REGNODE_AFTER_type(rn,tregnode_IFMATCH) \
+ : rn + SUBPATTERN_CONTINUE_OFFSET(rn); \
else rn += NEXT_OFF(rn); \
} \
} STMT_END
@@ -10603,10 +10603,10 @@ NULL
ST.wanted = 1;
ifmatch_trivial_fail_test:
ST.prev_match_end= match_end;
- ST.count = NEXT_OFF(scan) + 1; /* next_off repurposed to be
+ ST.count = LOOKBEHIND_EXTRA_STARTS(scan) + 1; /* next_off repurposed to be
lookbehind count, requires
non-zero flags */
- if (! FLAGS(scan)) { /* 'flags' zero means lookahed */
+ if (! LOOKBEHIND_MAX_CHARS(scan)) { /* 'flags' zero means lookahed */
/* Lookahead starts here and ends at the normal place */
ST.start = locinput;
@@ -10614,7 +10614,7 @@ NULL
match_end = NULL;
}
else {
- PERL_UINT_FAST8_T back_count = FLAGS(scan);
+ PERL_UINT_FAST8_T back_count = LOOKBEHIND_MAX_CHARS(scan);
char * s;
match_end = locinput;