This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: [perl #126481] panic for !! with syntax error in /(?[...])/
authorKarl Williamson <khw@cpan.org>
Fri, 30 Oct 2015 04:07:11 +0000 (22:07 -0600)
committerKarl Williamson <khw@cpan.org>
Fri, 30 Oct 2015 17:09:11 +0000 (11:09 -0600)
This is fixed by not putting two adjacent '!' operators on the stack.
These are the only right-associative operators in the grammar, and they
just cancel each other out.

pod/perldelta.pod
regcomp.c
t/re/regex_sets.t

index 54d7151..f66a321 100644 (file)
@@ -348,6 +348,13 @@ these were short input strings, and the failures had to do with longer
 inputs.  This was fixed in Perl 5.23.4, but the improvement was not
 noticed until after that was released, so is included here now.
 
+=item *
+
+Certain syntax errors in
+L<perlrecharclass/Extended Bracketed Character Classes> caused panics
+instead of the proper error message.  This has now been fixed. [perl
+#126481]
+
 =back
 
 =head1 Known Problems
index b170c4d..df60d1b 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -13944,9 +13944,20 @@ redo_curchar:
                 av_push(stack, rhs);
                 goto redo_curchar;
 
-            case '!':   /* Highest priority, right associative, so just push
-                           onto stack */
-                av_push(stack, newSVuv(curchar));
+            case '!':   /* Highest priority, right associative */
+
+                /* If what's already at the top of the stack is another '!",
+                 * they just cancel each other out */
+                if (   (top_ptr = av_fetch(stack, top_index, FALSE))
+                    && (IS_OPERATOR(*top_ptr) && SvUV(*top_ptr) == '!'))
+                {
+                    only_to_avoid_leaks = av_pop(stack);
+                    SvREFCNT_dec(only_to_avoid_leaks);
+                }
+                else { /* Otherwise, since it's right associative, just push
+                          onto the stack */
+                    av_push(stack, newSVuv(curchar));
+                }
                 break;
 
             default:
index a5941ba..5a9807e 100644 (file)
@@ -159,6 +159,18 @@ if (! is_miniperl() && locales_enabled('LC_CTYPE')) {
        like("\c]", qr/(?[\c]])/, '\c] should match itself');
 }
 
+# RT #126481 !! with syntax error panics
+{
+    fresh_perl_like('no warnings "experimental::regex_sets"; qr/(?[ ! ! (\w])/',
+                    qr/^Unmatched \(/, {},
+                    'qr/(?[ ! ! (\w])/ doesnt panic');
+    # The following didn't panic before, but easy to add this here with a
+    # paren between the !!
+    fresh_perl_like('no warnings "experimental::regex_sets";qr/(?[ ! ( ! (\w)])/',
+                    qr/^Unmatched \(/, {},
+                    'qr/qr/(?[ ! ( ! (\w)])/');
+}
+
 done_testing();
 
 1;