1# Commands covered:  regexp, regsub
2#
3# This file contains a collection of tests for one or more of the Tcl
4# built-in commands.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright © 1991-1993 The Regents of the University of California.
8# Copyright © 1998 Sun Microsystems, Inc.
9# Copyright © 1998-1999 Scriptics Corporation.
10#
11# See the file "license.terms" for information on usage and redistribution
12# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13
14if {"::tcltest" ni [namespace children]} {
15    package require tcltest 2.5
16    namespace import -force ::tcltest::*
17}
18
19testConstraint nodep [info exists tcl_precision]
20
21# Procedure to evaluate a script within a proc, to test compilation
22# functionality
23
24proc evalInProc { script } {
25    proc testProc {} $script
26    set status [catch {
27	testProc
28    } result]
29    rename testProc {}
30    return $result
31    #return [list $status $result]
32}
33
34unset -nocomplain foo
35
36test regexpComp-1.1 {basic regexp operation} {
37    evalInProc {
38	regexp ab*c abbbc
39    }
40} 1
41test regexpComp-1.2 {basic regexp operation} {
42    evalInProc {
43	regexp ab*c ac
44    }
45} 1
46test regexpComp-1.3 {basic regexp operation} {
47    evalInProc {
48	regexp ab*c ab
49    }
50} 0
51test regexpComp-1.4 {basic regexp operation} {
52    evalInProc {
53	regexp -- -gorp abc-gorpxxx
54    }
55} 1
56test regexpComp-1.5 {basic regexp operation} {
57    evalInProc {
58	regexp {^([^ ]*)[ ]*([^ ]*)} "" a
59    }
60} 1
61test regexpComp-1.6 {basic regexp operation} {
62    list [catch {regexp {} abc} msg] $msg
63} {0 1}
64test regexpComp-1.7 {regexp utf compliance} {
65    # if not UTF-8 aware, result is "0 1"
66    evalInProc {
67	set foo "乎b q"
68	regexp "乎b q" "a乎b qw幎N wq" bar
69	list [string compare $foo $bar] [regexp 4 $bar]
70    }
71} {0 0}
72
73test regexpComp-1.8 {regexp ***= metasyntax} {
74    evalInProc {
75	regexp -- "***=o" "aeiou"
76    }
77} 1
78test regexpComp-1.9 {regexp ***= metasyntax} {
79    evalInProc {
80	set string "aeiou"
81	regexp -- "***=o" $string
82    }
83} 1
84test regexpComp-1.10 {regexp ***= metasyntax} {
85    evalInProc {
86	set string "aeiou"
87	set re "***=o"
88	regexp -- $re $string
89    }
90} 1
91test regexpComp-1.11 {regexp ***= metasyntax} {
92    evalInProc {
93	regexp -- "***=y" "aeiou"
94    }
95} 0
96test regexpComp-1.12 {regexp ***= metasyntax} {
97    evalInProc {
98	set string "aeiou"
99	regexp -- "***=y" $string
100    }
101} 0
102test regexpComp-1.13 {regexp ***= metasyntax} {
103    evalInProc {
104	set string "aeiou"
105	set re "***=y"
106	regexp -- $re $string
107    }
108} 0
109test regexpComp-1.14 {regexp ***= metasyntax} {
110    evalInProc {
111	set string "aeiou"
112	set re "***=e*o"
113	regexp -- $re $string
114    }
115} 0
116test regexpComp-1.15 {regexp ***= metasyntax} {
117    evalInProc {
118	set string "ae*ou"
119	set re "***=e*o"
120	regexp -- $re $string
121    }
122} 1
123test regexpComp-1.16 {regexp ***= metasyntax} {
124    evalInProc {
125	set string {ae*[o]?ua}
126	set re {***=e*[o]?u}
127	regexp -- $re $string
128    }
129} 1
130
131test regexpComp-2.1 {getting substrings back from regexp} {
132    evalInProc {
133	set foo {}
134	list [regexp ab*c abbbbc foo] $foo
135    }
136} {1 abbbbc}
137test regexpComp-2.2 {getting substrings back from regexp} {
138    evalInProc {
139	set foo {}
140	set f2 {}
141	list [regexp a(b*)c abbbbc foo f2] $foo $f2
142    }
143} {1 abbbbc bbbb}
144test regexpComp-2.3 {getting substrings back from regexp} {
145    evalInProc {
146	set foo {}
147	set f2 {}
148	list [regexp a(b*)(c) abbbbc foo f2] $foo $f2
149    }
150} {1 abbbbc bbbb}
151test regexpComp-2.4 {getting substrings back from regexp} {
152    evalInProc {
153	set foo {}
154	set f2 {}
155	set f3 {}
156	list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
157    }
158} {1 abbbbc bbbb c}
159test regexpComp-2.5 {getting substrings back from regexp} {
160    evalInProc {
161	set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
162	set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {};
163	list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \
164		12223345556789999aabbb \
165		foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \
166		$f6 $f7 $f8 $f9 $fa $fb
167    }
168} {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb}
169test regexpComp-2.6 {getting substrings back from regexp} {
170    evalInProc {
171	set foo 2; set f2 2; set f3 2; set f4 2
172	list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
173    }
174} {1 a a {} {}}
175test regexpComp-2.7 {getting substrings back from regexp} {
176    evalInProc {
177	set foo 1; set f2 1; set f3 1; set f4 1
178	list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
179    }
180} {1 ac a {} c}
181test regexpComp-2.8 {getting substrings back from regexp} {
182    evalInProc {
183	set match {}
184	list [regexp {^a*b} aaaab match] $match
185    }
186} {1 aaaab}
187
188test regexpComp-3.1 {-indices option to regexp} {
189    evalInProc {
190	set foo {}
191	list [regexp -indices ab*c abbbbc foo] $foo
192    }
193} {1 {0 5}}
194test regexpComp-3.2 {-indices option to regexp} {
195    evalInProc {
196	set foo {}
197	set f2 {}
198	list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2
199    }
200} {1 {0 5} {1 4}}
201test regexpComp-3.3 {-indices option to regexp} {
202    evalInProc {
203	set foo {}
204	set f2 {}
205	list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2
206    }
207} {1 {0 5} {1 4}}
208test regexpComp-3.4 {-indices option to regexp} {
209    evalInProc {
210	set foo {}
211	set f2 {}
212	set f3 {}
213	list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3
214    }
215} {1 {0 5} {1 4} {5 5}}
216test regexpComp-3.5 {-indices option to regexp} {
217    evalInProc {
218	set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {};
219	set f6 {}; set f7 {}; set f8 {}; set f9 {}
220	list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \
221		12223345556789999 \
222		foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \
223		$f6 $f7 $f8 $f9
224    }
225} {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}}
226test regexpComp-3.6 {getting substrings back from regexp} {
227    evalInProc {
228	set foo 2; set f2 2; set f3 2; set f4 2
229	list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4
230    }
231} {1 {1 1} {1 1} {-1 -1} {-1 -1}}
232test regexpComp-3.7 {getting substrings back from regexp} {
233    evalInProc {
234	set foo 1; set f2 1; set f3 1; set f4 1
235	list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4
236    }
237} {1 {1 2} {1 1} {-1 -1} {2 2}}
238
239test regexpComp-4.1 {-nocase option to regexp} {
240    evalInProc {
241	regexp -nocase foo abcFOo
242    }
243} 1
244test regexpComp-4.2 {-nocase option to regexp} {
245    evalInProc {
246	set f1 22
247	set f2 33
248	set f3 44
249	list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3
250    }
251} {1 aBbbxYXxxZ Bbb xYXxx}
252test regexpComp-4.3 {-nocase option to regexp} {
253    evalInProc {
254	regexp -nocase FOo abcFOo
255    }
256} 1
257set ::x abcdefghijklmnopqrstuvwxyz1234567890
258set ::x $x$x$x$x$x$x$x$x$x$x$x$x
259test regexpComp-4.4 {case conversion in regexp} {
260    evalInProc {
261	list [regexp -nocase $::x $::x foo] $foo
262    }
263} "1 $x"
264unset -nocomplain ::x
265
266test regexpComp-5.1 {exercise cache of compiled expressions} {
267    evalInProc {
268	regexp .*a b
269	regexp .*b c
270	regexp .*c d
271	regexp .*d e
272	regexp .*e f
273	regexp .*a bbba
274    }
275} 1
276test regexpComp-5.2 {exercise cache of compiled expressions} {
277    evalInProc {
278	regexp .*a b
279	regexp .*b c
280	regexp .*c d
281	regexp .*d e
282	regexp .*e f
283	regexp .*b xxxb
284    }
285} 1
286test regexpComp-5.3 {exercise cache of compiled expressions} {
287    evalInProc {
288	regexp .*a b
289	regexp .*b c
290	regexp .*c d
291	regexp .*d e
292	regexp .*e f
293	regexp .*c yyyc
294    }
295} 1
296test regexpComp-5.4 {exercise cache of compiled expressions} {
297    evalInProc {
298	regexp .*a b
299	regexp .*b c
300	regexp .*c d
301	regexp .*d e
302	regexp .*e f
303	regexp .*d 1d
304    }
305} 1
306test regexpComp-5.5 {exercise cache of compiled expressions} {
307    evalInProc {
308	regexp .*a b
309	regexp .*b c
310	regexp .*c d
311	regexp .*d e
312	regexp .*e f
313	regexp .*e xe
314    }
315} 1
316
317test regexpComp-6.1 {regexp errors} {
318    evalInProc {
319	list [catch {regexp a} msg] $msg
320    }
321} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
322test regexpComp-6.2 {regexp errors} {
323    evalInProc {
324	list [catch {regexp -nocase a} msg] $msg
325    }
326} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
327test regexpComp-6.3 {regexp errors} {
328    evalInProc {
329	list [catch {regexp -gorp a} msg] $msg
330    }
331} {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
332test regexpComp-6.4 {regexp errors} {
333    evalInProc {
334	list [catch {regexp a( b} msg] $msg
335    }
336} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
337test regexpComp-6.5 {regexp errors} {
338    evalInProc {
339	list [catch {regexp a( b} msg] $msg
340    }
341} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
342test regexpComp-6.6 {regexp errors} {
343    evalInProc {
344	list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
345    }
346} {0 1}
347test regexpComp-6.7 {regexp errors} {
348    evalInProc {
349	list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
350    }
351} {0 0}
352test regexpComp-6.8 {regexp errors} {
353    evalInProc {
354	unset -nocomplain f1
355	set f1 44
356	list [catch {regexp abc abc f1(f2)} msg] $msg
357    }
358} {1 {can't set "f1(f2)": variable isn't array}}
359test regexpComp-6.9 {regexp errors, -start bad int check} {
360    evalInProc {
361	list [catch {regexp -start bogus {^$} {}} msg] $msg
362    }
363} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
364
365test regexpComp-7.1 {basic regsub operation} {
366    evalInProc {
367	list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
368    }
369} {1 xax111aaa222xaa}
370test regexpComp-7.2 {basic regsub operation} {
371    evalInProc {
372	list [regsub aa+ aaaxaa &111 foo] $foo
373    }
374} {1 aaa111xaa}
375test regexpComp-7.3 {basic regsub operation} {
376    evalInProc {
377	list [regsub aa+ xaxaaa 111& foo] $foo
378    }
379} {1 xax111aaa}
380test regexpComp-7.4 {basic regsub operation} {
381    evalInProc {
382	list [regsub aa+ aaa 11&2&333 foo] $foo
383    }
384} {1 11aaa2aaa333}
385test regexpComp-7.5 {basic regsub operation} {
386    evalInProc {
387	list [regsub aa+ xaxaaaxaa &2&333 foo] $foo
388    }
389} {1 xaxaaa2aaa333xaa}
390test regexpComp-7.6 {basic regsub operation} {
391    evalInProc {
392	list [regsub aa+ xaxaaaxaa 1&22& foo] $foo
393    }
394} {1 xax1aaa22aaaxaa}
395test regexpComp-7.7 {basic regsub operation} {
396    evalInProc {
397	list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo
398    }
399} {1 xax1aa22aaxaa}
400test regexpComp-7.8 {basic regsub operation} {
401    evalInProc {
402	list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo
403    }
404} "1 {xax1\\aa22aaxaa}"
405test regexpComp-7.9 {basic regsub operation} {
406    evalInProc {
407	list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo
408    }
409} "1 {xax1\\122aaxaa}"
410test regexpComp-7.10 {basic regsub operation} {
411    evalInProc {
412	list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo
413    }
414} "1 {xax1\\aaaaaxaa}"
415test regexpComp-7.11 {basic regsub operation} {
416    evalInProc {
417	list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo
418    }
419} {1 xax1&aaxaa}
420test regexpComp-7.12 {basic regsub operation} {
421    evalInProc {
422	list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo
423    }
424} {1 xaxaaaaaaaaaaaaaaxaa}
425test regexpComp-7.13 {basic regsub operation} {
426    evalInProc {
427	set foo xxx
428	list [regsub abc xyz 111 foo] $foo
429    }
430} {0 xyz}
431test regexpComp-7.14 {basic regsub operation} {
432    evalInProc {
433	set foo xxx
434	list [regsub ^ xyz "111 " foo] $foo
435    }
436} {1 {111 xyz}}
437test regexpComp-7.15 {basic regsub operation} {
438    evalInProc {
439	set foo xxx
440	list [regsub -- -foo abc-foodef "111 " foo] $foo
441    }
442} {1 {abc111 def}}
443test regexpComp-7.16 {basic regsub operation} {
444    evalInProc {
445	set foo xxx
446	list [regsub x "" y foo] $foo
447    }
448} {0 {}}
449test regexpComp-7.17 {regsub utf compliance} {
450    evalInProc {
451	# if not UTF-8 aware, result is "0 1"
452	set foo "xyz555ijka乎bpqr"
453	regsub a乎b xyza乎bijka乎bpqr 555 bar
454	list [string compare $foo $bar] [regexp 4 $bar]
455    }
456} {0 0}
457
458test regexpComp-8.1 {case conversion in regsub} {
459    evalInProc {
460	list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
461    }
462} {1 xaAAaAAay}
463test regexpComp-8.2 {case conversion in regsub} {
464    evalInProc {
465	list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
466    }
467} {1 xaAAaAAay}
468test regexpComp-8.3 {case conversion in regsub} {
469    evalInProc {
470	set foo 123
471	list [regsub a(a+) xaAAaAAay & foo] $foo
472    }
473} {0 xaAAaAAay}
474test regexpComp-8.4 {case conversion in regsub} {
475    evalInProc {
476	set foo 123
477	list [regsub -nocase a CaDE b foo] $foo
478    }
479} {1 CbDE}
480test regexpComp-8.5 {case conversion in regsub} {
481    evalInProc {
482	set foo 123
483	list [regsub -nocase XYZ CxYzD b foo] $foo
484    }
485} {1 CbD}
486test regexpComp-8.6 {case conversion in regsub} {
487    evalInProc {
488	set x abcdefghijklmnopqrstuvwxyz1234567890
489	set x $x$x$x$x$x$x$x$x$x$x$x$x
490	set foo 123
491	list [regsub -nocase $x $x b foo] $foo
492    }
493} {1 b}
494
495test regexpComp-9.1 {-all option to regsub} {
496    evalInProc {
497	set foo 86
498	list [regsub -all x+ axxxbxxcxdx |&| foo] $foo
499    }
500} {4 a|xxx|b|xx|c|x|d|x|}
501test regexpComp-9.2 {-all option to regsub} {
502    evalInProc {
503	set foo 86
504	list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo
505    }
506} {4 a|XxX|b|xx|c|X|d|x|}
507test regexpComp-9.3 {-all option to regsub} {
508    evalInProc {
509	set foo 86
510	list [regsub x+ axxxbxxcxdx |&| foo] $foo
511    }
512} {1 a|xxx|bxxcxdx}
513test regexpComp-9.4 {-all option to regsub} {
514    evalInProc {
515	set foo 86
516	list [regsub -all bc axxxbxxcxdx |&| foo] $foo
517    }
518} {0 axxxbxxcxdx}
519test regexpComp-9.5 {-all option to regsub} {
520    evalInProc {
521	set foo xxx
522	list [regsub -all node "node node more" yy foo] $foo
523    }
524} {2 {yy yy more}}
525test regexpComp-9.6 {-all option to regsub} {
526    evalInProc {
527	set foo xxx
528	list [regsub -all ^ xxx 123 foo] $foo
529    }
530} {1 123xxx}
531test regexpComp-9.7 {Bug 84af1192f5: -all option to regsub} {
532    evalInProc {
533	regsub -all {\(.*} 123(qwe) ""
534    }
535} 123
536
537test regexpComp-10.1 {expanded syntax in regsub} {
538    evalInProc {
539	set foo xxx
540	list [regsub -expanded ". \#comment\n  . \#comment2" abc def foo] $foo
541    }
542} {1 defc}
543test regexpComp-10.2 {newline sensitivity in regsub} {
544    evalInProc {
545	set foo xxx
546	list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo
547    }
548} "1 {dabc\n123\n}"
549test regexpComp-10.3 {newline sensitivity in regsub} {
550    evalInProc {
551	set foo xxx
552	list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo
553    }
554} "1 {dabc\n123\nxb}"
555test regexpComp-10.4 {partial newline sensitivity in regsub} {
556    evalInProc {
557	set foo xxx
558	list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo
559    }
560} "1 {da\n123}"
561test regexpComp-10.5 {inverse partial newline sensitivity in regsub} {
562    evalInProc {
563	set foo xxx
564	list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo
565    }
566} "1 {da\nb123\nxb}"
567
568test regexpComp-11.1 {regsub errors} {
569    evalInProc {
570	list [catch {regsub a b} msg] $msg
571    }
572} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
573test regexpComp-11.2 {regsub errors} {
574    evalInProc {
575	list [catch {regsub -nocase a b} msg] $msg
576    }
577} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
578test regexpComp-11.3 {regsub errors} {
579    evalInProc {
580	list [catch {regsub -nocase -all a b} msg] $msg
581    }
582} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
583test regexpComp-11.4 {regsub errors} {
584    evalInProc {
585	list [catch {regsub a b c d e f} msg] $msg
586    }
587} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
588test regexpComp-11.5 {regsub errors} {
589    evalInProc {
590	list [catch {regsub -gorp a b c} msg] $msg
591    }
592} {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
593test regexpComp-11.6 {regsub errors} {
594    evalInProc {
595	list [catch {regsub -nocase a( b c d} msg] $msg
596    }
597} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
598test regexpComp-11.7 {regsub errors} {
599    evalInProc {
600	unset -nocomplain f1
601	set f1 44
602	list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
603    }
604} {1 {can't set "f1(f2)": variable isn't array}}
605test regexpComp-11.8 {regsub errors, -start bad int check} {
606    evalInProc {
607	list [catch {regsub -start bogus pattern string rep var} msg] $msg
608    }
609} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
610
611# This test crashes on the Mac unless you increase the Stack Space to about 1
612# Meg.  This is probably bigger than most users want...
613# 8.2.3 regexp reduced stack space requirements, but this should be
614# tested again
615test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
616    evalInProc {
617	list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
618    }
619} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}
620
621test regexpComp-13.1 {regsub of a very large string} {
622    # This test is designed to stress the memory subsystem in order
623    # to catch Bug #933.  It only fails if the Tcl memory allocator
624    # is in use.
625
626    set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
627    set filedata [string repeat $line 200]
628    for {set i 1} {$i<10} {incr i} {
629	regsub -all "BEGIN_TABLE " $filedata "" newfiledata
630    }
631    set x done
632} {done}
633
634test regexpComp-14.1 {CompileRegexp: regexp cache} {
635    evalInProc {
636	regexp .*a b
637	regexp .*b c
638	regexp .*c d
639	regexp .*d e
640	regexp .*e f
641	set x .
642	append x *a
643	regexp $x bbba
644    }
645} 1
646test regexpComp-14.2 {CompileRegexp: regexp cache, different flags} {
647    evalInProc {
648	regexp .*a b
649	regexp .*b c
650	regexp .*c d
651	regexp .*d e
652	regexp .*e f
653	set x .
654	append x *a
655	regexp -nocase $x bbba
656    }
657} 1
658
659testConstraint exec [llength [info commands exec]]
660test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -constraints {
661	exec
662} -setup {
663    set junk [makeFile {puts [regexp {} foo]} junk.tcl]
664} -body {
665    exec [interpreter] $junk
666} -cleanup {
667    removeFile junk.tcl
668} -result 1
669
670test regexpComp-15.1 {regexp -start} -body {
671    unset -nocomplain x
672    list [regexp -start -10 {\d} 1abc2de3 x] $x
673} -result {1 1}
674test regexpComp-15.2 {regexp -start} -body {
675    unset -nocomplain x
676    list [regexp -start 2 {\d} 1abc2de3 x] $x
677} -result {1 2}
678test regexpComp-15.3 {regexp -start} -body {
679    unset -nocomplain x
680    list [regexp -start 4 {\d} 1abc2de3 x] $x
681} -result {1 2}
682test regexpComp-15.4 {regexp -start} -body {
683    unset -nocomplain x
684    list [regexp -start 5 {\d} 1abc2de3 x] $x
685} -result {1 3}
686test regexpComp-15.5 {regexp -start, over end of string} -body {
687    unset -nocomplain x
688    list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
689} -result {0 0}
690test regexpComp-15.6 {regexp -start, loss of ^$ behavior} -body {
691    list [regexp -start 2 {^$} {}]
692} -result {0}
693
694test regexpComp-16.1 {regsub -start} -body {
695    unset -nocomplain x
696    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
697} -result {4 a1b/2c/3d/4e/5}
698test regexpComp-16.2 {regsub -start} -body {
699    unset -nocomplain x
700    list [regsub -all -start -25 {z} hello {/&} x] $x
701} -result {0 hello}
702test regexpComp-16.3 {regsub -start} -body {
703    unset -nocomplain x
704    list [regsub -all -start 3 {z} hello {/&} x] $x
705} -result {0 hello}
706test regexpComp-16.4 {regsub -start, \A behavior} -body {
707    set out {}
708    lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
709    lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
710} -result {5 /a/b/c/d/e 3 ab/c/d/e}
711
712test regexpComp-17.1 {regexp -inline} -body {
713    regexp -inline b ababa
714} -result {b}
715test regexpComp-17.2 {regexp -inline} -body {
716    regexp -inline (b) ababa
717} -result {b b}
718test regexpComp-17.3 {regexp -inline -indices} {
719    regexp -inline -indices (b) ababa
720} {{1 1} {1 1}}
721test regexpComp-17.4 {regexp -inline} {
722    regexp -inline {\w(\d+)\w} "   hello 23 there456def "
723} {e456d 456}
724test regexpComp-17.5 {regexp -inline no matches} {
725    regexp -inline {\w(\d+)\w} ""
726} {}
727test regexpComp-17.6 {regexp -inline no matches} {
728    regexp -inline hello goodbye
729} {}
730test regexpComp-17.7 {regexp -inline, no matchvars allowed} {
731    list [catch {regexp -inline b abc match} msg] $msg
732} {1 {regexp match variables not allowed when using -inline}}
733
734test regexpComp-18.1 {regexp -all} {
735    regexp -all b bbbbb
736} {5}
737test regexpComp-18.2 {regexp -all} {
738    regexp -all b abababbabaaaaaaaaaab
739} {6}
740test regexpComp-18.3 {regexp -all -inline} {
741    regexp -all -inline b abababbabaaaaaaaaaab
742} {b b b b b b}
743test regexpComp-18.4 {regexp -all -inline} {
744    regexp -all -inline {\w(\w)} abcdefg
745} {ab b cd d ef f}
746test regexpComp-18.5 {regexp -all -inline} {
747    regexp -all -inline {\w(\w)$} abcdefg
748} {fg g}
749test regexpComp-18.6 {regexp -all -inline} {
750    regexp -all -inline {\d+} 10:20:30:40
751} {10 20 30 40}
752test regexpComp-18.7 {regexp -all -inline} {
753    list [catch {regexp -all -inline b abc match} msg] $msg
754} {1 {regexp match variables not allowed when using -inline}}
755test regexpComp-18.8 {regexp -all} {
756    # This should not cause an infinite loop
757    regexp -all -inline {a*} a
758} {a}
759test regexpComp-18.9 {regexp -all} {
760    # Yes, the expected result is {a {}}.  Here's why:
761    # Start at index 0; a* matches the "a" there then stops.
762    # Go to index 1; a* matches the lambda (or {}) there then stops.  Recall
763    #   that a* matches zero or more "a"'s; thus it matches the string "b", as
764    #   there are zero or more "a"'s there.
765    # Go to index 2; this is past the end of the string, so stop.
766    regexp -all -inline {a*} ab
767} {a {}}
768test regexpComp-18.10 {regexp -all} {
769    # Yes, the expected result is {a {} a}.  Here's why:
770    # Start at index 0; a* matches the "a" there then stops.
771    # Go to index 1; a* matches the lambda (or {}) there then stops.   Recall
772    #   that a* matches zero or more "a"'s; thus it matches the string "b", as
773    #   there are zero or more "a"'s there.
774    # Go to index 2; a* matches the "a" there then stops.
775    # Go to index 3; this is past the end of the string, so stop.
776    regexp -all -inline {a*} aba
777} {a {} a}
778test regexpComp-18.11 {regexp -all} {
779    evalInProc {
780	regexp -all -inline {^a} aaaa
781    }
782} {a}
783test regexpComp-18.12 {regexp -all -inline -indices} {
784    evalInProc {
785	regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh
786    }
787} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}}
788
789test regexpComp-19.1 {regsub null replacement} {
790    evalInProc {
791	regsub -all {@} {@hel@lo@} "\0a\0" result
792	list $result [string length $result]
793    }
794} "\0a\0hel\0a\0lo\0a\0 14"
795
796test regexpComp-20.1 {regsub shared object shimmering} nodep {
797    evalInProc {
798	# Bug #461322
799	set a abcdefghijklmnopqurstuvwxyz
800	set b $a
801	set c abcdefghijklmnopqurstuvwxyz0123456789
802	regsub $a $c $b d
803	list $d [string length $d] [string bytelength $d]
804    }
805} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
806test regexpComp-20.2 {regsub shared object shimmering with -about} {
807    evalInProc {
808	eval regexp -about abc
809    }
810} {0 {}}
811
812test regexpComp-21.1 {regexp command compiling tests} {
813    evalInProc {
814	regexp foo bar
815    }
816} 0
817test regexpComp-21.2 {regexp command compiling tests} {
818    evalInProc {
819	regexp {^foo$} dogfood
820    }
821} 0
822test regexpComp-21.3 {regexp command compiling tests} {
823    evalInProc {
824	set a foo
825	regexp {^foo$} $a
826    }
827} 1
828test regexpComp-21.4 {regexp command compiling tests} {
829    evalInProc {
830	regexp foo dogfood
831    }
832} 1
833test regexpComp-21.5 {regexp command compiling tests} {
834    evalInProc {
835	regexp -nocase FOO dogfod
836    }
837} 0
838test regexpComp-21.6 {regexp command compiling tests} {
839    evalInProc {
840	regexp -n foo dogfoOd
841    }
842} 1
843test regexpComp-21.7 {regexp command compiling tests} {
844    evalInProc {
845	regexp -no -- FoO dogfood
846    }
847} 1
848test regexpComp-21.8 {regexp command compiling tests} {
849    evalInProc {
850	regexp -- foo dogfod
851    }
852} 0
853test regexpComp-21.9 {regexp command compiling tests} {
854    evalInProc {
855	list [catch {regexp -- -nocase foo dogfod} msg] $msg
856    }
857} {0 0}
858test regexpComp-21.10 {regexp command compiling tests} {
859    evalInProc {
860	list [regsub -all "" foo bar str] $str
861    }
862} {3 barfbarobaro}
863test regexpComp-21.11 {regexp command compiling tests} {
864    evalInProc {
865	list [regsub -all "" "" bar str] $str
866    }
867} {0 {}}
868
869test regexpComp-22.0.1 {Bug 1810038} {
870    evalInProc {
871	regexp ($|^X)* {}
872    }
873} 1
874
875test regexpComp-22.0.2 {regexp compile and backrefs, Bug 1857126} {
876    evalInProc {
877	regexp -- {([bc])\1} bb
878    }
879} 1
880
881set i 0
882foreach {str exp result} {
883    foo		^foo		1
884    foobar	^foobar$	1
885    foobar	bar$		1
886    foobar	^$		0
887    ""		^$		1
888    anything	$		1
889    anything	^.*$		1
890    anything	^.*a$		0
891    anything	^.*a.*$		1
892    anything	^.*.*$		1
893    anything	^.*..*$		1
894    anything	^.*b$		0
895    anything	^a.*$		1
896} {
897    test regexpComp-22.[incr i] {regexp command compiling tests} \
898	     [subst {evalInProc {set a "$str"; regexp {$exp} \$a}}] $result
899}
900
901set i 0
902foreach {str exp result} {
903    foo		^foo		1
904    foobar	^foobar$	1
905    foobar	bar$		1
906    foobar	^$		0
907    ""		^$		1
908    anything	$		1
909    anything	^.*$		1
910    anything	^.*a$		0
911    anything	^.*a.*$		1
912    anything	^.*.*$		1
913    anything	^.*..*$		1
914    anything	^.*b$		0
915    anything	^a.*$		1
916} {
917    test regexpComp-23.[incr i] {regexp command compiling tests INST_REGEXP} \
918	[subst {evalInProc {set a "$str"; set re "$exp"; regexp \$re \$a}}] $result
919}
920
921test regexpComp-24.1 {regexp command compiling tests} {
922    evalInProc {
923	set re foo
924	regexp -nocase $re bar
925    }
926} 0
927test regexpComp-24.2 {regexp command compiling tests} {
928    evalInProc {
929	set re {^foo$}
930	regexp $re dogfood
931    }
932} 0
933test regexpComp-24.3 {regexp command compiling tests} {
934    evalInProc {
935	set a foo
936	set re {^foo$}
937	regexp $re $a
938    }
939} 1
940test regexpComp-24.4 {regexp command compiling tests} {
941    evalInProc {
942	set re foo
943	regexp $re dogfood
944    }
945} 1
946test regexpComp-24.5 {regexp command compiling tests} {
947    evalInProc {
948	set re FOO
949	regexp -nocase $re dogfod
950    }
951} 0
952test regexpComp-24.6 {regexp command compiling tests} {
953    evalInProc {
954	set re foo
955	regexp -n $re dogfoOd
956    }
957} 1
958test regexpComp-24.7 {regexp command compiling tests} {
959    evalInProc {
960	set re FoO
961	regexp -no -- $re dogfood
962    }
963} 1
964test regexpComp-24.8 {regexp command compiling tests} {
965    evalInProc {
966	set re foo
967	regexp -- $re dogfod
968    }
969} 0
970test regexpComp-24.9 {regexp command compiling tests} {
971    evalInProc {
972	set re "("
973	list [catch {regexp -- $re dogfod} msg] $msg
974    }
975} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
976test regexpComp-24.10 {regexp command compiling tests} {
977    # Bug 1902436 - last * escaped
978    evalInProc {
979	set text {this is *bold* !}
980	set re {\*bold\*}
981	regexp -- $re $text
982    }
983} 1
984test regexpComp-24.11 {regexp command compiling tests} {
985    # Bug 1902436 - last * escaped
986    evalInProc {
987	set text {this is *bold* !}
988	set re {\*bold\*.*!}
989	regexp -- $re $text
990    }
991} 1
992
993# cleanup
994::tcltest::cleanupTests
995return
996
997# Local Variables:
998# mode: tcl
999# End:
1000