PATCH: [perl #126481] panic for !! with syntax error in /(?[...])/

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.

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 54d7151..f66a321 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -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

diff --git a/regcomp.c b/regcomp.c
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:

diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t
index a5941ba..5a9807e 100644 (file)
--- a/t/re/regex_sets.t
+++ b/t/re/regex_sets.t
@@ -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;