Blob Blame History Raw
From 8121278aa8fe72e9e8aca8651c7f1d4fa204ac1d Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 2 Apr 2018 21:54:59 -0600
Subject: [PATCH] PATCH: [perl #132167] Parse error in regex_sets
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

When popping the stack, the code inappropriately also subtracted one
from the result.  This is probably left over from an earlier change in
the implementation.  The top of the stack contained the correct value;
subtracting was a mistake.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 regcomp.c         |  2 +-
 t/re/regex_sets.t | 11 +++++++++++
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/regcomp.c b/regcomp.c
index 018d5646fc..39ab260efa 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15689,7 +15689,7 @@ redo_curchar:
                  * fence.  Get rid of it */
                 fence_ptr = av_pop(fence_stack);
                 assert(fence_ptr);
-                fence = SvIV(fence_ptr) - 1;
+                fence = SvIV(fence_ptr);
                 SvREFCNT_dec_NN(fence_ptr);
                 fence_ptr = NULL;
 
diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t
index e9644bd4e6..e70df81254 100644
--- a/t/re/regex_sets.t
+++ b/t/re/regex_sets.t
@@ -204,6 +204,17 @@ for my $char ("٠", "٥", "٩") {
     like("a", qr/$pat/, "/$pat/ compiles and matches 'a'");
 }
 
+{   # [perl #132167]
+    fresh_perl_is('no warnings "experimental::regex_sets";
+        print "c" =~ qr/(?[ ( \p{Uppercase} ) + (\p{Lowercase} - ([a] + [b]))  ])/;',
+        1, {},
+        'qr/(?[ ( \p{Uppercase} ) + (\p{Lowercase} - ([a] + [b]))  ]) compiles and properly matches');
+    fresh_perl_is('no warnings "experimental::regex_sets";
+        print "b" =~ qr/(?[ ( \p{Uppercase} ) + (\p{Lowercase} - ([a] + [b]))  ])/;',
+        "", {},
+        'qr/(?[ ( \p{Uppercase} ) + (\p{Lowercase} - ([a] + [b]))  ]) compiles and properly matches');
+}
+
 done_testing();
 
 1;
-- 
2.14.3