Skip to content

Commit cf44e60

Browse files
committed
fix intuit_start() with \G
Intuit assumed that any anchor, including \G, anchored at BOS or after \n. This obviously isn't the case for \G, so exclude RXf_ANCH_GPOS from the RXf_ANCH branch. This has never been spotted before, since intuit used to be skipped when \G was present.
1 parent f1fb9b0 commit cf44e60

File tree

2 files changed

+26
-9
lines changed

2 files changed

+26
-9
lines changed

regexec.c

Lines changed: 5 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -557,13 +557,9 @@ Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char *strend,
557557
* with giant delta may be not rechecked).
558558
*/
559559

560-
/* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
561-
562560
/* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
563561
Otherwise, only SvCUR(sv) is used to get strbeg. */
564562

565-
/* XXXX We assume that strpos is strbeg unless sv. */
566-
567563
/* XXXX Some places assume that there is a fixed substring.
568564
An update may be needed if optimizer marks as "INTUITable"
569565
RExen without fixed substrings. Similarly, it is assumed that
@@ -671,14 +667,15 @@ Perl_re_intuit_start(pTHX_
671667
}
672668
check = prog->check_substr;
673669
}
674-
if (prog->extflags & RXf_ANCH) { /* Match at beg-of-str or after \n */
675-
ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
670+
if ((prog->extflags & RXf_ANCH) /* Match at beg-of-str or after \n */
671+
&& !(prog->extflags & RXf_ANCH_GPOS)) /* \G isn't a BOS or \n */
672+
{
673+
ml_anch = !( (prog->extflags & RXf_ANCH_SINGLE)
676674
|| ( (prog->extflags & RXf_ANCH_BOL)
677675
&& !multiline ) ); /* Check after \n? */
678676

679677
if (!ml_anch) {
680-
if ( !(prog->extflags & RXf_ANCH_GPOS) /* Checked by the caller */
681-
&& !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
678+
if ( !(prog->intflags & PREGf_IMPLICIT) /* not a real BOL */
682679
&& (strpos != strbeg)) {
683680
DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
684681
goto fail;

t/re/pat.t

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@ BEGIN {
2020
require './test.pl';
2121
}
2222

23-
plan tests => 681; # Update this when adding/deleting tests.
23+
plan tests => 688; # Update this when adding/deleting tests.
2424

2525
run_tests() unless caller;
2626

@@ -727,6 +727,26 @@ sub run_tests {
727727
unlike($str, qr/^...\G/, $message);
728728
ok($str =~ /\G../ && $& eq 'cd', $message);
729729
ok($str =~ /.\G./ && $& eq 'bc', $message);
730+
731+
}
732+
733+
{
734+
my $message = '\G and intuit and anchoring';
735+
$_ = "abcdef";
736+
pos = 0;
737+
ok($_ =~ /\Gabc/, $message);
738+
ok($_ =~ /^\Gabc/, $message);
739+
740+
pos = 3;
741+
ok($_ =~ /\Gdef/, $message);
742+
pos = 3;
743+
ok($_ =~ /\Gdef$/, $message);
744+
pos = 3;
745+
ok($_ =~ /abc\Gdef$/, $message);
746+
pos = 3;
747+
ok($_ =~ /^abc\Gdef$/, $message);
748+
pos = 3;
749+
ok($_ =~ /c\Gd/, $message);
730750
}
731751

732752
{

0 commit comments

Comments
 (0)