In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/c354df01f41f08af4a9abac9e1869124c5691916?hp=2c39754a51ff0311c18539adf3808a52242313c3>
- Log ----------------------------------------------------------------- commit c354df01f41f08af4a9abac9e1869124c5691916 Author: David Mitchell <[email protected]> Date: Mon Sep 22 15:57:52 2014 +0100 create t/re/speed.t, t/re/speed_thr.t 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.) ----------------------------------------------------------------------- Summary of changes: MANIFEST | 2 + t/re/pat.t | 58 +------------ t/re/speed.t | 106 ++++++++++++++++++++++++ t/re/{regexp_unicode_prop_thr.t => speed_thr.t} | 0 4 files changed, 109 insertions(+), 57 deletions(-) create mode 100644 t/re/speed.t copy t/re/{regexp_unicode_prop_thr.t => speed_thr.t} (100%) diff --git a/MANIFEST b/MANIFEST index 65694ea..f708f20 100644 --- 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 diff --git a/t/re/pat.t b/t/re/pat.t index 1a6a48fe..926b67a 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -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 index 0000000..0922a95 --- /dev/null +++ b/t/re/speed.t @@ -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/regexp_unicode_prop_thr.t b/t/re/speed_thr.t similarity index 100% copy from t/re/regexp_unicode_prop_thr.t copy to t/re/speed_thr.t -- Perl5 Master Repository
