This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #22395] regexp /(.*)[bc]/ 10000 times slower in 5.8.0 vs 5.6.1
authoryves orton <unknown>
Fri, 17 Nov 2006 09:48:14 +0000 (01:48 -0800)
committerH.Merijn Brand <h.m.brand@xs4all.nl>
Fri, 17 Nov 2006 20:25:27 +0000 (20:25 +0000)
From: "yves orton via RT" <perlbug-followup@perl.org>
Message-ID: <rt-3.5.HEAD-1666-1163785693-404.22395-15-0@perl.org>

p4raw-id: //depot/perl@29310

regcomp.c
t/op/pat.t

index a69d0b3..f8052a1 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -4207,7 +4207,8 @@ reStudy:
            first = NEXTOPER(first);
            goto again;
        }
-       else if (!sawopen && (OP(first) == STAR &&
+       else if ((!sawopen || !RExC_sawback) &&
+           (OP(first) == STAR &&
            PL_regkind[OP(NEXTOPER(first))] == REG_ANY) &&
            !(r->reganch & ROPT_ANCH) )
        {
index 68328f8..b431db3 100755 (executable)
@@ -4054,7 +4054,15 @@ for my $c ("z", "\0", "!", chr(254), chr(256)) {
     }
     iseq($^R,'Nothing');
 }
-
+{
+    local $Message="RT#22395";
+    our $count;
+    for my $l (1,10,100,1000) {
+       $count=0;
+       ('a' x $l) =~ /(.*)(?{$count++})[bc]/;
+       iseq($l+1,$count,"Should be L+1 not L*(L+3)/2 (L=$l)");
+    }
+}
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
 # Keep the following tests last -- they may crash perl
@@ -4100,4 +4108,4 @@ ok((q(a)x 100) =~ /^(??{'(.)'x 100})/,
 # Put new tests above the dotted line about a page above this comment
 
 # Don't forget to update this!
-BEGIN { print "1..1358\n" };
+BEGIN { print "1..1363\n" };