In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/49bc8c204e5c79057de13cec3a02f8a247d71bc0?hp=bbac6b2092e662cc7df6fe1e0cbdc7f6be3a717e>
- Log ----------------------------------------------------------------- commit 49bc8c204e5c79057de13cec3a02f8a247d71bc0 Author: Lukas Mai <[email protected]> Date: Mon Aug 24 21:43:11 2015 +0200 test implicit anchors using re.pm [perl #125810] M t/re/speed.t commit 02853b7253a0d11283c87b470e8dcd7e88ea479d Author: Lukas Mai <[email protected]> Date: Mon Aug 24 21:42:38 2015 +0200 implicitly anchor .{0,} like .* [perl #125810] M regcomp.c ----------------------------------------------------------------------- Summary of changes: regcomp.c | 28 +++++++++++++++------------- t/re/speed.t | 18 +++++++++++++++++- 2 files changed, 32 insertions(+), 14 deletions(-) diff --git a/regcomp.c b/regcomp.c index 9075fc5..3fbf8bf 100644 --- a/regcomp.c +++ b/regcomp.c @@ -10912,6 +10912,20 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) do_curly: if ((flags&SIMPLE)) { + if (min == 0 && max == REG_INFTY) { + reginsert(pRExC_state, STAR, ret, depth+1); + ret->flags = 0; + MARK_NAUGHTY(4); + RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN; + goto nest_check; + } + if (min == 1 && max == REG_INFTY) { + reginsert(pRExC_state, PLUS, ret, depth+1); + ret->flags = 0; + MARK_NAUGHTY(3); + RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN; + goto nest_check; + } MARK_NAUGHTY_EXP(2, 2); reginsert(pRExC_state, CURLY, ret, depth+1); Set_Node_Offset(ret, parse_start+1); /* MJD */ @@ -10985,22 +10999,10 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) *flagp = (op != '+') ? (WORST|SPSTART|HASWIDTH) : (WORST|HASWIDTH); - if (op == '*' && (flags&SIMPLE)) { - reginsert(pRExC_state, STAR, ret, depth+1); - ret->flags = 0; - MARK_NAUGHTY(4); - RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN; - } - else if (op == '*') { + if (op == '*') { min = 0; goto do_curly; } - else if (op == '+' && (flags&SIMPLE)) { - reginsert(pRExC_state, PLUS, ret, depth+1); - ret->flags = 0; - MARK_NAUGHTY(3); - RExC_seen |= REG_UNBOUNDED_QUANTIFIER_SEEN; - } else if (op == '+') { min = 1; goto do_curly; diff --git a/t/re/speed.t b/t/re/speed.t index de793b8..28acf88 100644 --- a/t/re/speed.t +++ b/t/re/speed.t @@ -23,7 +23,7 @@ BEGIN { skip_all_without_unicode_tables(); } -plan tests => 25; # Update this when adding/deleting tests. +plan tests => 57; # Update this when adding/deleting tests. use strict; use warnings; @@ -118,6 +118,22 @@ sub run_tests { ok ($s !~ /.*?:::\s*ab/si, 'PREGf_IMPLICIT/si'); ok ($s !~ /.*?:::\s*ab/ms, 'PREGf_IMPLICIT/ms'); ok ($s !~ /.*?:::\s*ab/msi,'PREGf_IMPLICIT/msi'); + + for my $star ('*', '{0,}') { + for my $greedy ('', '?') { + for my $flags ('', 'i', 'm', 'mi') { + for my $s ('', 's') { + my $XBOL = $s ? 'SBOL' : 'MBOL'; + my $text = "anchored($XBOL) implicit"; + fresh_perl_like(<<"PROG", qr/\b\Q$text\E\b/, {}, "/.${star}${greedy}X/${flags}${s} anchors implicitly"); +BEGIN { \@INC = ('../lib', '.', '../ext/re'); } +use re 'debug'; +qr/.${star}${greedy}:::\\s*ab/${flags}${s} +PROG + } + } + } + } } } # End of sub run_tests -- Perl5 Master Repository
