In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/c333712c4a550eeb3146b964d8508f772e294a49?hp=f16e7fa35c1302aa056db5d8d022b7861c1dd2e8>
- Log -----------------------------------------------------------------
commit c333712c4a550eeb3146b964d8508f772e294a49
Author: Karl Williamson <k...@cpan.org>
Date: Wed Aug 31 17:05:45 2016 -0600
PATCH: [perl #129122] regex sets syntax error
This was caused by two statements being in the wrong order. One should
save something on the stack before changing it, not after.
However fixing this led to the discovery of another bug in which an
error case was failed to be detected.
M regcomp.c
M t/re/reg_mesg.t
M t/re/regex_sets.t
commit 2cb86ab37f2186d7853067c7afb2938963f7ac3e
Author: Karl Williamson <k...@cpan.org>
Date: Wed Aug 31 16:57:20 2016 -0600
regcomp.c: Typo, spacing in comment
M regcomp.c
-----------------------------------------------------------------------
Summary of changes:
regcomp.c | 9 +++++++--
t/re/reg_mesg.t | 6 +++---
t/re/regex_sets.t | 15 +++++++++++++++
3 files changed, 25 insertions(+), 5 deletions(-)
diff --git a/regcomp.c b/regcomp.c
index bba5a2b..e7e41ff 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15081,8 +15081,8 @@ redo_curchar:
}
/* Stack the position of this undealt-with left paren */
- fence = top_index + 1;
av_push(fence_stack, newSViv(fence));
+ fence = top_index + 1;
break;
case '\\':
@@ -15163,7 +15163,12 @@ redo_curchar:
vFAIL("Unexpected ')'");
}
- /* If at least two thing on the stack, treat this as an
+ /* If nothing after the fence, is missing an operand */
+ if (top_index - fence < 0) {
+ RExC_parse++;
+ goto bad_syntax;
+ }
+ /* If at least two things on the stack, treat this as an
* operator */
if (top_index - fence >= 1) {
goto join_operators;
diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index 5ca9b8f..52bec7a 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -221,8 +221,8 @@ my @death =
'/(?[ \x{} ])/' => 'Number with no digits {#} m/(?[ \x{}{#} ])/',
'/(?[ \cK + ) ])/' => 'Unexpected \')\' {#} m/(?[ \cK + ){#} ])/',
'/(?[ \cK + ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ \cK +
{#}])/',
- '/(?[ ( ) ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ ( )
{#}])/',
- '/(?[[0]+()+])/' => 'Incomplete expression within \'(?[ ])\' {#}
m/(?[[0]+()+{#}])/',
+ '/(?[ ( ) ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ ( ){#}
])/',
+ '/(?[[0]+()+])/' => 'Incomplete expression within \'(?[ ])\' {#}
m/(?[[0]+(){#}+])/',
'/(?[ \p{foo} ])/' => 'Can\'t find Unicode property definition "foo" {#}
m/(?[ \p{foo}{#} ])/',
'/(?[ \p{ foo = bar } ])/' => 'Can\'t find Unicode property definition "foo =
bar" {#} m/(?[ \p{ foo = bar }{#} ])/',
'/(?[ \8 ])/' => 'Unrecognized escape \8 in character class {#} m/(?[ \8{#}
])/',
@@ -267,7 +267,7 @@ my @death =
'/(?[\ -!])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[\
-!{#}])/', # [perl #126180]
'/(?[\ ^!])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[\
^!{#}])/', # [perl #126180]
'/(?[\ |!])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[\
|!{#}])/', # [perl #126180]
- '/(?[()-!])/' => 'Incomplete expression within \'(?[ ])\' {#}
m/(?[()-!{#}])/', # [perl #126204]
+ '/(?[()-!])/' => 'Incomplete expression within \'(?[ ])\' {#}
m/(?[(){#}-!])/', # [perl #126204]
'/(?[!()])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[!(){#}])/',
# [perl #126404]
'/\w{/' => 'Unescaped left brace in regex is illegal here {#} m/\w{{#}/',
'/\q{/' => 'Unescaped left brace in regex is illegal here {#} m/\q{{#}/',
diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t
index 544d670..810e301 100644
--- a/t/re/regex_sets.t
+++ b/t/re/regex_sets.t
@@ -184,6 +184,21 @@ for my $char ("Ù ", "Ù¥", "Ù©") {
'qr/qr/(?[ ! ( ! (\w)])/');
}
+{ # RT #129122
+ my $pat = '(?[ ( [ABC] - [B] ) + ( [abc] - [b] ) + [def] ])';
+ like("A", qr/$pat/, "'A' matches /$pat/");
+ unlike("B", qr/$pat/, "'B' doesn't match /$pat/");
+ like("C", qr/$pat/, "'C' matches /$pat/");
+ unlike("D", qr/$pat/, "'D' doesn't match /$pat/");
+ like("a", qr/$pat/, "'a' matches /$pat/");
+ unlike("b", qr/$pat/, "'b' doesn't match /$pat/");
+ like("c", qr/$pat/, "'c' matches /$pat/");
+ like("d", qr/$pat/, "'d' matches /$pat/");
+ like("e", qr/$pat/, "'e' matches /$pat/");
+ like("f", qr/$pat/, "'f' matches /$pat/");
+ unlike("g", qr/$pat/, "'g' doesn't match /$pat/");
+}
+
done_testing();
1;
--
Perl5 Master Repository
