This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
create t/re/speed.t, t/re/speed_thr.t
authorDavid Mitchell <davem@iabyn.com>
Mon, 22 Sep 2014 14:57:52 +0000 (15:57 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 22 Sep 2014 14:57:52 +0000 (15:57 +0100)
Some tests in re/pat.t are specifically expected to run very slowly if
certain optimisations break.

Move them into their own test file, along with a watchdog()

(There are probably some more tests that could be moved, but these are
the ones I'm aware of, principally because I wrote them.)

MANIFEST
t/re/pat.t
t/re/speed.t [new file with mode: 0644]
t/re/speed_thr.t [new file with mode: 0644]

index 65694ea..f708f20 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5306,6 +5306,8 @@ t/re/reg_posixcc.t                See if posix character classes behave consistently
 t/re/re_tests                  Regular expressions for regexp.t
 t/re/rt122747.t                        Test rt122747 assert faile (requires DEBUGGING)
 t/re/rxcode.t                  See if /(?{ code })/ works
+t/re/speed.t                   See if optimisations are keeping things fast
+t/re/speed_thr.t               ditto under threads
 t/re/subst_amp.t               See if $&-related substitution works
 t/re/subst.t                   See if substitution works
 t/re/substT.t                  See if substitution works with -T
index 1a6a48f..926b67a 100644 (file)
@@ -22,7 +22,7 @@ BEGIN {
     skip_all_without_unicode_tables();
 }
 
-plan tests => 739;  # Update this when adding/deleting tests.
+plan tests => 730;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1485,62 +1485,6 @@ EOP
           'undefining *^R within (??{}) does not result in a crash';
     }
 
-    {
-        # [perl #120446]
-        # this code should be virtually instantaneous. If it takes 10s of
-        # seconds, there a bug in intuit_start.
-        # (this test doesn't actually test for slowness - that involves
-        # too much danger of false positives on loaded machines - but by
-        # putting it here, hopefully someone might notice if it suddenly
-        # runs slowly)
-        my $s = ('a' x 1_000_000) . 'b';
-        my $i = 0;
-        for (1..10_000) {
-            pos($s) = $_;
-            $i++ if $s =~/\Gb/g;
-        }
-        is($i, 0, "RT 120446: mustn't run slowly");
-    }
-
-    {
-        # [perl #120692]
-        # these tests should be virtually instantaneous. If they take 10s of
-        # seconds, there's a bug in intuit_start.
-
-        my $s = 'ab' x 1_000_000;
-        utf8::upgrade($s);
-        1 while $s =~ m/\Ga+ba+b/g;
-        pass("RT#120692 \\G mustn't run slowly");
-
-        $s=~ /^a{1,2}x/ for  1..10_000;
-        pass("RT#120692 a{1,2} mustn't run slowly");
-
-        $s=~ /ab.{1,2}x/;
-        pass("RT#120692 ab.{1,2} mustn't run slowly");
-
-        $s = "-a-bc" x 250_000;
-        $s .= "1a1bc";
-        utf8::upgrade($s);
-        ok($s =~ /\da\d{0,30000}bc/, "\\d{30000}");
-
-        $s = "-ab\n" x 250_000;
-        $s .= "abx";
-        ok($s =~ /^ab.*x/m, "distant float with /m");
-
-        my $r = qr/^abcd/;
-        $s = "abcd-xyz\n" x 500_000;
-        $s =~ /$r\d{1,2}xyz/m for 1..200;
-        pass("BOL within //m  mustn't run slowly");
-
-        $s = "abcdefg" x 1_000_000;
-        $s =~ /(?-m:^)abcX?fg/m for 1..100;
-        pass("BOL within //m  mustn't skip absolute anchored check");
-
-        $s = "abcdefg" x 1_000_000;
-        $s =~ /^XX\d{1,10}cde/ for 1..100;
-        pass("abs anchored float string should fail quickly");
-
-    }
 
     # These are based on looking at the code in regcomp.c
     # We don't look for specific code, just the existence of an SSC
diff --git a/t/re/speed.t b/t/re/speed.t
new file mode 100644 (file)
index 0000000..0922a95
--- /dev/null
@@ -0,0 +1,106 @@
+#!./perl
+#
+# This is a home for regular expression tests that don't fit into
+# the format supported by re/regexp.t, that specifically should run fast.
+#
+# All the tests in this file are ones that run exceptionally slowly
+# (each test taking seconds or even minutes) in the absence of particular
+# optimisations. Thus it is a sort of canary for optimisations being
+# broken.
+#
+# Although it includes a watchdog timeout, this is set to a generous limit
+# to allow for running on slow systems; therefore a broken optimisation
+# might be indicated merely by this test file taking unusually long to
+# run, rather than actually timing out.
+#
+
+use strict;
+use warnings;
+use 5.010;
+
+sub run_tests;
+
+$| = 1;
+
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('../lib','.','../ext/re');
+    require Config; import Config;
+    require './test.pl';
+    skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
+    skip_all_without_unicode_tables();
+}
+
+plan tests => 9;  # Update this when adding/deleting tests.
+
+run_tests() unless caller;
+
+#
+# Tests start here.
+#
+sub run_tests {
+
+
+    watchdog(40 * (($::running_as_thread && $::running_as_thread) ? 2 : 1));
+
+    {
+        # [perl #120446]
+        # this code should be virtually instantaneous. If it takes 10s of
+        # seconds, there a bug in intuit_start.
+        # (this test doesn't actually test for slowness - that involves
+        # too much danger of false positives on loaded machines - but by
+        # putting it here, hopefully someone might notice if it suddenly
+        # runs slowly)
+        my $s = ('a' x 1_000_000) . 'b';
+        my $i = 0;
+        for (1..10_000) {
+            pos($s) = $_;
+            $i++ if $s =~/\Gb/g;
+        }
+        is($i, 0, "RT 120446: mustn't run slowly");
+    }
+
+    {
+        # [perl #120692]
+        # these tests should be virtually instantaneous. If they take 10s of
+        # seconds, there's a bug in intuit_start.
+
+        my $s = 'ab' x 1_000_000;
+        utf8::upgrade($s);
+        1 while $s =~ m/\Ga+ba+b/g;
+        pass("RT#120692 \\G mustn't run slowly");
+
+        $s=~ /^a{1,2}x/ for  1..10_000;
+        pass("RT#120692 a{1,2} mustn't run slowly");
+
+        $s=~ /ab.{1,2}x/;
+        pass("RT#120692 ab.{1,2} mustn't run slowly");
+
+        $s = "-a-bc" x 250_000;
+        $s .= "1a1bc";
+        utf8::upgrade($s);
+        ok($s =~ /\da\d{0,30000}bc/, "\\d{30000}");
+
+        $s = "-ab\n" x 250_000;
+        $s .= "abx";
+        ok($s =~ /^ab.*x/m, "distant float with /m");
+
+        my $r = qr/^abcd/;
+        $s = "abcd-xyz\n" x 500_000;
+        $s =~ /$r\d{1,2}xyz/m for 1..200;
+        pass("BOL within //m  mustn't run slowly");
+
+        $s = "abcdefg" x 1_000_000;
+        $s =~ /(?-m:^)abcX?fg/m for 1..100;
+        pass("BOL within //m  mustn't skip absolute anchored check");
+
+        $s = "abcdefg" x 1_000_000;
+        $s =~ /^XX\d{1,10}cde/ for 1..100;
+        pass("abs anchored float string should fail quickly");
+
+    }
+
+} # End of sub run_tests
+
+1;
diff --git a/t/re/speed_thr.t b/t/re/speed_thr.t
new file mode 100644 (file)
index 0000000..9ce1d3a
--- /dev/null
@@ -0,0 +1,3 @@
+#!./perl
+chdir 't' if -d 't';
+require './thread_it.pl';