test for #127855 - Slowdown in m//g on COW strings of certain lengths
authorYves Orton <demerphq@gmail.com>
Fri, 8 Apr 2016 19:17:34 +0000 (21:17 +0200)
committerYves Orton <demerphq@gmail.com>
Fri, 8 Apr 2016 19:30:50 +0000 (21:30 +0200)
t/re/pat.t

index 295a9f7..906ffc8 100644 (file)
@@ -23,7 +23,7 @@ BEGIN {
     skip_all_without_unicode_tables();
 }
 
-plan tests => 789;  # Update this when adding/deleting tests.
+plan tests => 790;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1758,6 +1758,17 @@ EOP
                 fresh_perl_is($code, $expect, {}, "$bug - $test_name" );
             }
         }
+        {
+            # [perl #127855] Slowdown in m//g on COW strings of certain lengths
+            my $elapsed= -time;
+            my $len= 4e6;
+            my $zeros= 10000;
+            my $str= ( "0" x $zeros ) . ( "1" x ( $len - $zeros ) );
+            my $substr= substr( $str, 1 );
+            1 while $substr=~m/0/g;
+            $elapsed += time;
+            ok( $elapsed < 1, "should not COW on long string with substr and m//g");
+        }
 } # End of sub run_tests
 
 1;