This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
re/speed.t: increase watchdog timeout
[perl5.git] / t / re / speed.t
CommitLineData
c354df01
DM
1#!./perl
2#
3# This is a home for regular expression tests that don't fit into
4# the format supported by re/regexp.t, that specifically should run fast.
5#
6# All the tests in this file are ones that run exceptionally slowly
7# (each test taking seconds or even minutes) in the absence of particular
8# optimisations. Thus it is a sort of canary for optimisations being
9# broken.
10#
11# Although it includes a watchdog timeout, this is set to a generous limit
12# to allow for running on slow systems; therefore a broken optimisation
13# might be indicated merely by this test file taking unusually long to
14# run, rather than actually timing out.
15#
16
c354df01
DM
17BEGIN {
18 chdir 't' if -d 't';
19 @INC = ('../lib','.','../ext/re');
20 require Config; import Config;
21 require './test.pl';
22 skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
23 skip_all_without_unicode_tables();
24}
25
36827729 26plan tests => 57; #** update watchdog timeouts proportionally when adding tests
c354df01 27
0b1b7115
JH
28use strict;
29use warnings;
30use 5.010;
31
32sub run_tests;
33
34$| = 1;
35
c354df01
DM
36run_tests() unless caller;
37
38#
39# Tests start here.
40#
41sub run_tests {
42
43
36827729 44 watchdog(($::running_as_thread && $::running_as_thread) ? 150 : 225);
c354df01
DM
45
46 {
47 # [perl #120446]
48 # this code should be virtually instantaneous. If it takes 10s of
49 # seconds, there a bug in intuit_start.
50 # (this test doesn't actually test for slowness - that involves
51 # too much danger of false positives on loaded machines - but by
52 # putting it here, hopefully someone might notice if it suddenly
53 # runs slowly)
54 my $s = ('a' x 1_000_000) . 'b';
55 my $i = 0;
56 for (1..10_000) {
57 pos($s) = $_;
58 $i++ if $s =~/\Gb/g;
59 }
60 is($i, 0, "RT 120446: mustn't run slowly");
61 }
62
63 {
64 # [perl #120692]
65 # these tests should be virtually instantaneous. If they take 10s of
66 # seconds, there's a bug in intuit_start.
67
68 my $s = 'ab' x 1_000_000;
69 utf8::upgrade($s);
70 1 while $s =~ m/\Ga+ba+b/g;
71 pass("RT#120692 \\G mustn't run slowly");
72
73 $s=~ /^a{1,2}x/ for 1..10_000;
74 pass("RT#120692 a{1,2} mustn't run slowly");
75
76 $s=~ /ab.{1,2}x/;
77 pass("RT#120692 ab.{1,2} mustn't run slowly");
78
79 $s = "-a-bc" x 250_000;
80 $s .= "1a1bc";
81 utf8::upgrade($s);
82 ok($s =~ /\da\d{0,30000}bc/, "\\d{30000}");
83
84 $s = "-ab\n" x 250_000;
85 $s .= "abx";
86 ok($s =~ /^ab.*x/m, "distant float with /m");
87
88 my $r = qr/^abcd/;
89 $s = "abcd-xyz\n" x 500_000;
90 $s =~ /$r\d{1,2}xyz/m for 1..200;
91 pass("BOL within //m mustn't run slowly");
92
93 $s = "abcdefg" x 1_000_000;
94 $s =~ /(?-m:^)abcX?fg/m for 1..100;
95 pass("BOL within //m mustn't skip absolute anchored check");
96
97 $s = "abcdefg" x 1_000_000;
98 $s =~ /^XX\d{1,10}cde/ for 1..100;
99 pass("abs anchored float string should fail quickly");
100
0fa70a06
DM
101 # if /.*.../ fails to be optimised well (PREGf_IMPLICIT),
102 # things tend to go quadratic (RT #123743)
103
104 $s = ('0' x 200_000) . '::: 0c';
3e33f67a
DM
105 ok ($s !~ /.*:::\s*ab/, 'PREGf_IMPLICIT');
106 ok ($s !~ /.*:::\s*ab/i, 'PREGf_IMPLICIT/i');
107 ok ($s !~ /.*:::\s*ab/m, 'PREGf_IMPLICIT/m');
108 ok ($s !~ /.*:::\s*ab/mi, 'PREGf_IMPLICIT/mi');
109 ok ($s !~ /.*:::\s*ab/s, 'PREGf_IMPLICIT/s');
110 ok ($s !~ /.*:::\s*ab/si, 'PREGf_IMPLICIT/si');
111 ok ($s !~ /.*:::\s*ab/ms, 'PREGf_IMPLICIT/ms');
112 ok ($s !~ /.*:::\s*ab/msi, 'PREGf_IMPLICIT/msi');
113 ok ($s !~ /.*?:::\s*ab/, 'PREGf_IMPLICIT');
114 ok ($s !~ /.*?:::\s*ab/i, 'PREGf_IMPLICIT/i');
115 ok ($s !~ /.*?:::\s*ab/m, 'PREGf_IMPLICIT/m');
116 ok ($s !~ /.*?:::\s*ab/mi, 'PREGf_IMPLICIT/mi');
117 ok ($s !~ /.*?:::\s*ab/s, 'PREGf_IMPLICIT/s');
118 ok ($s !~ /.*?:::\s*ab/si, 'PREGf_IMPLICIT/si');
119 ok ($s !~ /.*?:::\s*ab/ms, 'PREGf_IMPLICIT/ms');
120 ok ($s !~ /.*?:::\s*ab/msi,'PREGf_IMPLICIT/msi');
49bc8c20
LM
121
122 for my $star ('*', '{0,}') {
123 for my $greedy ('', '?') {
124 for my $flags ('', 'i', 'm', 'mi') {
125 for my $s ('', 's') {
126 my $XBOL = $s ? 'SBOL' : 'MBOL';
127 my $text = "anchored($XBOL) implicit";
128 fresh_perl_like(<<"PROG", qr/\b\Q$text\E\b/, {}, "/.${star}${greedy}X/${flags}${s} anchors implicitly");
129BEGIN { \@INC = ('../lib', '.', '../ext/re'); }
130use re 'debug';
131qr/.${star}${greedy}:::\\s*ab/${flags}${s}
132PROG
133 }
134 }
135 }
136 }
c354df01
DM
137 }
138
139} # End of sub run_tests
140
1411;