Re: [PATCH] Add recursive regexes similar to PCRE

Date: Wed, 4 Oct 2006 15:45:15 +0200
Message-ID: <9b18b3110610040645s563220a2id6f235494b497e90@mail.gmail.com>

Subject: Re: [PATCH] Add recursive regexes similar to PCRE
From: demerphq <demerphq@gmail.com>
Date: Wed, 4 Oct 2006 21:05:10 +0200
Message-ID: <9b18b3110610041205m2660eb43m1315cf4b0653db96@mail.gmail.com>

p4raw-id: //depot/perl@28939

1 files changed, 31 insertions, 3 deletions

diff --git a/t/op/pat.t b/t/op/pat.t
index 59499b196b..c1d8e2dc33 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -3632,7 +3632,31 @@ $brackets = qr{
 	      }x;
 ok("{b{c}d" !~ m/^((??{ $brackets }))/, "bracket mismatch");
 
-
+SKIP:{
+    our @stack=();
+    my @expect=qw(
+        stuff1
+        stuff2
+        <stuff1>and<stuff2>
+        right
+        <right>
+        <<right>>
+        <<<right>>>
+        <<stuff1>and<stuff2>><<<<right>>>>
+    );
+
+    local $_='<<<stuff1>and<stuff2>><<<<right>>>>>';
+    ok(/^(<((?:(?>[^<>]+)|(?1))*)>(?{push @stack, $2 }))$/,
+        "Recursion should match");
+    ok(@stack==@expect)
+        or skip("Won't test individual results as count isn't equal",
+                0+@expect);
+    foreach my $idx (@expect) {
+        ok($expect[$idx] eq $stack[$idx], 
+            "Expecting '$expect' at stack pos #$idx");
+    }
+        
+}
 # stress test CURLYX/WHILEM.
 #
 # This test includes varying levels of nesting, and according to
@@ -3734,11 +3758,15 @@ ok("{b{c}d" !~ m/^((??{ $brackets }))/, "bracket mismatch");
 }
 
 
-# Keep the following test last -- it may crash perl
+# Keep the following tests last -- they may crash perl
 
 ok(("a" x (2**15 - 10)) =~ /^()(a|bb)*$/, "Recursive stack cracker: #24274")
     or print "# Unexpected outcome: should pass or crash perl\n";
 
+ok((q(a)x 100) =~ /^(??{'(.)'x 100})/, 
+        "Regexp /^(??{'(.)'x 100})/ crashes older perls")
+    or print "# Unexpected outcome: should pass or crash perl\n";
+
 # Don't forget to update this!
-BEGIN{print "1..1253\n"};
+BEGIN{print "1..1264\n"};