Commit | Line | Data |
---|---|---|
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 |
17 | BEGIN { |
18 | chdir 't' if -d 't'; | |
c354df01 DM |
19 | require Config; import Config; |
20 | require './test.pl'; | |
624c42e2 | 21 | set_up_inc('../lib','.','../ext/re'); |
c354df01 DM |
22 | } |
23 | ||
624c42e2 N |
24 | skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader; |
25 | skip_all_without_unicode_tables(); | |
26 | ||
0b9cb33b | 27 | plan tests => 59; #** update watchdog timeouts proportionally when adding tests |
c354df01 | 28 | |
0b1b7115 JH |
29 | use strict; |
30 | use warnings; | |
31 | use 5.010; | |
32 | ||
33 | sub run_tests; | |
34 | ||
35 | $| = 1; | |
36 | ||
c354df01 DM |
37 | run_tests() unless caller; |
38 | ||
39 | # | |
40 | # Tests start here. | |
41 | # | |
42 | sub run_tests { | |
43 | ||
44 | ||
36827729 | 45 | watchdog(($::running_as_thread && $::running_as_thread) ? 150 : 225); |
c354df01 DM |
46 | |
47 | { | |
48 | # [perl #120446] | |
49 | # this code should be virtually instantaneous. If it takes 10s of | |
50 | # seconds, there a bug in intuit_start. | |
51 | # (this test doesn't actually test for slowness - that involves | |
52 | # too much danger of false positives on loaded machines - but by | |
53 | # putting it here, hopefully someone might notice if it suddenly | |
54 | # runs slowly) | |
55 | my $s = ('a' x 1_000_000) . 'b'; | |
56 | my $i = 0; | |
57 | for (1..10_000) { | |
58 | pos($s) = $_; | |
59 | $i++ if $s =~/\Gb/g; | |
60 | } | |
61 | is($i, 0, "RT 120446: mustn't run slowly"); | |
62 | } | |
63 | ||
64 | { | |
65 | # [perl #120692] | |
66 | # these tests should be virtually instantaneous. If they take 10s of | |
67 | # seconds, there's a bug in intuit_start. | |
68 | ||
69 | my $s = 'ab' x 1_000_000; | |
70 | utf8::upgrade($s); | |
71 | 1 while $s =~ m/\Ga+ba+b/g; | |
72 | pass("RT#120692 \\G mustn't run slowly"); | |
73 | ||
74 | $s=~ /^a{1,2}x/ for 1..10_000; | |
75 | pass("RT#120692 a{1,2} mustn't run slowly"); | |
76 | ||
77 | $s=~ /ab.{1,2}x/; | |
78 | pass("RT#120692 ab.{1,2} mustn't run slowly"); | |
79 | ||
80 | $s = "-a-bc" x 250_000; | |
81 | $s .= "1a1bc"; | |
82 | utf8::upgrade($s); | |
83 | ok($s =~ /\da\d{0,30000}bc/, "\\d{30000}"); | |
84 | ||
85 | $s = "-ab\n" x 250_000; | |
86 | $s .= "abx"; | |
87 | ok($s =~ /^ab.*x/m, "distant float with /m"); | |
88 | ||
89 | my $r = qr/^abcd/; | |
90 | $s = "abcd-xyz\n" x 500_000; | |
91 | $s =~ /$r\d{1,2}xyz/m for 1..200; | |
92 | pass("BOL within //m mustn't run slowly"); | |
93 | ||
94 | $s = "abcdefg" x 1_000_000; | |
95 | $s =~ /(?-m:^)abcX?fg/m for 1..100; | |
96 | pass("BOL within //m mustn't skip absolute anchored check"); | |
97 | ||
98 | $s = "abcdefg" x 1_000_000; | |
99 | $s =~ /^XX\d{1,10}cde/ for 1..100; | |
100 | pass("abs anchored float string should fail quickly"); | |
101 | ||
0fa70a06 DM |
102 | # if /.*.../ fails to be optimised well (PREGf_IMPLICIT), |
103 | # things tend to go quadratic (RT #123743) | |
104 | ||
105 | $s = ('0' x 200_000) . '::: 0c'; | |
3e33f67a DM |
106 | ok ($s !~ /.*:::\s*ab/, 'PREGf_IMPLICIT'); |
107 | ok ($s !~ /.*:::\s*ab/i, 'PREGf_IMPLICIT/i'); | |
108 | ok ($s !~ /.*:::\s*ab/m, 'PREGf_IMPLICIT/m'); | |
109 | ok ($s !~ /.*:::\s*ab/mi, 'PREGf_IMPLICIT/mi'); | |
110 | ok ($s !~ /.*:::\s*ab/s, 'PREGf_IMPLICIT/s'); | |
111 | ok ($s !~ /.*:::\s*ab/si, 'PREGf_IMPLICIT/si'); | |
112 | ok ($s !~ /.*:::\s*ab/ms, 'PREGf_IMPLICIT/ms'); | |
113 | ok ($s !~ /.*:::\s*ab/msi, 'PREGf_IMPLICIT/msi'); | |
114 | ok ($s !~ /.*?:::\s*ab/, 'PREGf_IMPLICIT'); | |
115 | ok ($s !~ /.*?:::\s*ab/i, 'PREGf_IMPLICIT/i'); | |
116 | ok ($s !~ /.*?:::\s*ab/m, 'PREGf_IMPLICIT/m'); | |
117 | ok ($s !~ /.*?:::\s*ab/mi, 'PREGf_IMPLICIT/mi'); | |
118 | ok ($s !~ /.*?:::\s*ab/s, 'PREGf_IMPLICIT/s'); | |
119 | ok ($s !~ /.*?:::\s*ab/si, 'PREGf_IMPLICIT/si'); | |
120 | ok ($s !~ /.*?:::\s*ab/ms, 'PREGf_IMPLICIT/ms'); | |
121 | ok ($s !~ /.*?:::\s*ab/msi,'PREGf_IMPLICIT/msi'); | |
49bc8c20 | 122 | |
624c42e2 | 123 | |
49bc8c20 LM |
124 | for my $star ('*', '{0,}') { |
125 | for my $greedy ('', '?') { | |
126 | for my $flags ('', 'i', 'm', 'mi') { | |
127 | for my $s ('', 's') { | |
128 | my $XBOL = $s ? 'SBOL' : 'MBOL'; | |
129 | my $text = "anchored($XBOL) implicit"; | |
a44fa0ed CB |
130 | TODO: |
131 | { | |
132 | local $main::TODO = 'regdump gets mangled by the VMS pipe implementation' if $^O eq 'VMS'; | |
133 | fresh_perl_like(<<"PROG", qr/\b\Q$text\E\b/, {}, "/.${star}${greedy}X/${flags}${s} anchors implicitly"); | |
624c42e2 | 134 | BEGIN { require './test.pl'; set_up_inc('../lib', '.', '../ext/re'); } |
49bc8c20 LM |
135 | use re 'debug'; |
136 | qr/.${star}${greedy}:::\\s*ab/${flags}${s} | |
137 | PROG | |
a44fa0ed | 138 | } |
49bc8c20 LM |
139 | } |
140 | } | |
141 | } | |
142 | } | |
c354df01 DM |
143 | } |
144 | ||
624c42e2 | 145 | |
68b940af DM |
146 | { |
147 | # [perl #127855] Slowdown in m//g on COW strings of certain lengths | |
148 | # this should take milliseconds, but took 10's of seconds. | |
149 | my $elapsed= -time; | |
150 | my $len= 4e6; | |
151 | my $zeros= 40000; | |
152 | my $str= ( "0" x $zeros ) . ( "1" x ( $len - $zeros ) ); | |
153 | my $substr= substr( $str, 1 ); | |
154 | 1 while $substr=~m/0/g; | |
155 | $elapsed += time; | |
156 | ok( $elapsed <= 1, "should not COW on long string with substr and m//g"); | |
157 | } | |
158 | ||
0b9cb33b KW |
159 | # [perl #133185] Infinite loop |
160 | like("!\xdf", eval 'qr/\pp(?aai)\xdf/', | |
161 | 'Compiling qr/\pp(?aai)\xdf/ doesn\'t loop'); | |
68b940af | 162 | |
c354df01 DM |
163 | } # End of sub run_tests |
164 | ||
165 | 1; |