test for #127855 - Slowdown in m//g on COW strings of certain lengths

diff --git a/t/re/pat.t b/t/re/pat.t
index 295a9f7..906ffc8 100644 (file)
--- a/t/re/pat.t
+++ b/t/re/pat.t
@@ -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;