Fix interaction of (?p{}) and (?>)

To: perl5-porters@perl.org (Mailing list Perl5)
Message-Id: <199909090840.EAA26471@monk.mps.ohio-state.edu>

p4raw-id: //depot/cfgperl@4112

diff --git a/regexec.c b/regexec.c
index 54f5e22..8361145 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2162,6 +2162,20 @@ S_regmatch(pTHX_ regnode *prog)
                    PL_reg_maxiter = 0;
 
                    if (regmatch(re->program + 1)) {
+                       /* Even though we succeeded, we need to restore
+                          global variables, since we may be wrapped inside
+                          SUSPEND, thus the match may be not finished yet. */
+
+                       /* XXXX Do this only if SUSPENDed? */
+                       PL_reg_call_cc = state.prev;
+                       PL_regcc = state.cc;
+                       PL_reg_re = state.re;
+                       cache_re(PL_reg_re);
+
+                       /* XXXX This is too dramatic a measure... */
+                       PL_reg_maxiter = 0;
+
+                       /* These are needed even if not SUSPEND. */
                        ReREFCNT_dec(re);
                        regcpblow(cp);
                        sayYES;

diff --git a/t/op/pat.t b/t/op/pat.t
index 6312c75..768d1b9 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,7 +4,7 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-print "1..188\n";
+print "1..191\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -865,3 +865,20 @@ print "not " unless("@a" eq ",f,,o,,o, ,b,,a,,r,");
 print "ok $test\n";
 $test++;
 
+$brackets = qr{
+                {  (?> [^{}]+ | (?p{ $brackets }) )* }
+             }x;
+
+"{{}" =~ $brackets;
+print "ok $test\n";            # Did we survive?
+$test++;
+
+"something { long { and } hairy" =~ $brackets;
+print "ok $test\n";            # Did we survive?
+$test++;
+
+"something { long { and } hairy" =~ m/((?p{ $brackets }))/;
+print "not " unless $1 eq "{ and }";
+print "ok $test\n";
+$test++;
+