tests: namespace.test
[jimtcl.git] / regtest.tcl
bloba46b849fb52e7a94faba779dc1d0cae1ffde176d
1 # These regression tests all provoked crashes at some point.
2 # Thus they are kept separate from the regular test suite in tests/
4 # REGTEST 1
5 # 27Jan2005 - SIGSEGV for bug on Jim_DuplicateObj().
7 for {set i 0} {$i < 100} {incr i} {
8 set a "x"
9 lappend a n
11 puts "TEST 1 PASSED"
13 # REGTEST 2
14 # 29Jan2005 - SEGFAULT parsing script composed of just one comment.
15 eval {#foobar}
16 puts "TEST 2 PASSED"
18 # REGTEST 3
19 # 29Jan2005 - "Error in Expression" with correct expression
20 set x 5
21 expr {$x-5}
22 puts "TEST 3 PASSED"
24 # REGTEST 4
25 # 29Jan2005 - SIGSEGV when run this code, due to expr's bug.
26 proc fibonacci {x} {
27 if {$x <= 1} {
28 expr 1
29 } else {
30 expr {[fibonacci [expr {$x-1}]] + [fibonacci [expr {$x-2}]]}
33 fibonacci 6
34 puts "TEST 4 PASSED"
36 # REGTEST 5
37 # 06Mar2005 - This looped forever...
38 for {set i 0} {$i < 10} {incr i} {continue}
39 puts "TEST 5 PASSED"
41 # REGTEST 6
42 # 07Mar2005 - Unset create variable + dict is using dict syntax sugar at
43 # currently non-existing variable
44 catch {unset thisvardoesnotexists(thiskeytoo)}
45 if {[catch {set thisvardoesnotexists}] == 0} {
46 puts "TEST 6 FAILED - unset created dict for non-existing variable"
47 break
49 puts "TEST 6 PASSED"
51 # REGTEST 7
52 # 04Nov2008 - variable parsing does not eat last brace
53 set a 1
54 list ${a}
55 puts "TEST 7 PASSED"
57 # REGTEST 8
58 # 04Nov2008 - string toupper/tolower do not convert to string rep
59 string tolower [list a]
60 string toupper [list a]
61 puts "TEST 8 PASSED"
63 # REGTEST 9
64 # 04Nov2008 - crash on exit when replacing Tcl proc with C command.
65 # Requires the clock extension to be built as a loadable module.
66 proc clock {args} {}
67 catch {package require clock}
68 # Note, crash on exit, so don't say we passed!
70 # REGTEST 10
71 # 05Nov2008 - incorrect lazy expression evaluation with unary not
72 expr {1 || !0}
73 puts "TEST 10 PASSED"
75 # REGTEST 11
76 # 14 Feb 2010 - access static variable in deleted proc
77 proc a {} {{x 1}} { rename a ""; incr x }
79 puts "TEST 11 PASSED"
81 # REGTEST 12
82 # 13 Sep 2010 - reference with invalid tag
83 set a b[ref value "tag name"]
84 getref [string range $a 1 end]
85 puts "TEST 12 PASSED"
87 # REGTEST 13
88 # 14 Sep 2010 - parse list with trailing backslash
89 set x "switch -0 \$on \\"
90 lindex $x 1
91 puts "TEST 13 PASSED"
93 # REGTEST 14
94 # 14 Sep 2010 - command expands to nothing
95 eval "{*}{}"
96 puts "TEST 14 PASSED"
98 # REGTEST 15
99 # 24 Feb 2010 - bad reference counting of the stack trace in 'error'
100 proc a {msg stack} {
101 tailcall error $msg $stack
103 catch {fail} msg opts
104 catch {a $msg $opts(-errorinfo)}
106 # REGTEST 16
107 # 24 Feb 2010 - rename the current proc
108 # Leaves unfreed objects on the stack
109 proc a {} { rename a newa}
112 # REGTEST 17
113 # 26 Nov 2010 - crashes on invalid dict sugar
114 catch {eval {$x(}}
115 puts "TEST 17 PASSED"
117 # REGTEST 18
118 # 12 Apr 2011 - crashes on unset for loop var
119 catch {
120 set j 0
121 for {set i 0} {$i < 5} {incr i} {
122 unset i
123 if {[incr j] == 5} {
124 break
128 puts "TEST 18 PASSED"
130 # REGTEST 19
131 # 25 May 2011 - crashes with double colon
132 catch {
133 expr {5 ne ::}
135 puts "TEST 19 PASSED"
137 # REGTEST 20
138 # 26 May 2011 - infinite recursion
139 proc a {} { global ::blah; set ::blah test }
141 puts "TEST 20 PASSED"
143 # REGTEST 21
144 # 26 May 2011 - infinite loop with null byte in subst
145 subst "abc\0def"
146 puts "TEST 21 PASSED"
148 # REGTEST 22
149 # 21 June 2011 - crashes on lappend to to value with script rep
150 set x rand
151 eval $x
152 lappend x b
153 puts "TEST 22 PASSED"
155 # REGTEST 23
156 # 27 July 2011 - unfreed objects on exit
157 catch {
158 set x abc
159 subst $x
160 regexp $x $x
162 # Actually, the test passes if no objects leaked on exit
163 puts "TEST 23 PASSED"
165 # REGTEST 24
166 # 13 Nov 2011 - invalid cached global var
167 proc a {} {
168 foreach i {1 2} {
169 incr z [set ::t]
170 unset ::t
173 set t 6
174 catch a
175 puts "TEST 24 PASSED"
177 # REGTEST 25
178 # 14 Nov 2011 - link global var to proc var
179 proc a {} {
180 set x 3
181 upvar 0 x ::globx
183 set globx 0
184 catch {
187 incr globx
188 puts "TEST 25 PASSED"
190 # REGTEST 26
191 # 2 Dec 2011 - infinite eval recursion
192 catch {
193 set x 0
194 set y {incr x; eval $y}
195 eval $y
196 } msg
197 puts "TEST 26 PASSED"
199 # REGTEST 27
200 # 2 Dec 2011 - infinite alias recursion
201 catch {
202 proc p {} {}
203 alias p p
205 } msg
206 puts "TEST 27 PASSED"
208 # REGTEST 28
209 # 16 Dec 2011 - ref count problem with finalizers
210 catch {
211 ref x x [list dummy]
212 collect
214 puts "TEST 28 PASSED"
216 # REGTEST 29
217 # Reference counting problem at exit
218 set x [lindex {} 0]
219 info source $x
220 eval $x
221 puts "TEST 29 PASSED"
223 # REGTEST 30
224 # non-UTF8 string tolower
225 string tolower "/mod/video/h\303\203\302\244xan_ witchcraft through the ages_20131101_0110.t"
226 puts "TEST 30 PASSED"
228 # REGTEST 31
229 # infinite lsort -unique with error
230 catch {lsort -unique -real {foo 42.0}}
231 puts "TEST 31 PASSED"
233 # REGTEST 32
234 # return -code eval should only used by tailcall, but this incorrect usage
235 # should not crash the interpreter
236 proc a {} { tailcall b }
237 proc b {} { return -code eval c }
238 proc c {} {}
239 catch -eval a
240 puts "TEST 32 PASSED"
242 # REGTEST 33
243 # unset array variable which doesn't exist
244 array unset blahblah abc
245 puts "TEST 33 PASSED"
247 # REGTEST 34
248 # onexception and writable conflict
249 set f [open [info nameofexecutable]]
250 $f onexception {incr x}
251 $f writable {incr y}
252 $f close
253 puts "TEST 34 PASSED"
255 # REGTEST 35
256 # caching of command resolution after local proc deleted
257 set result {}
258 proc x {} { }
259 proc p {n} {
260 if {$n in {2 3}} {
261 local proc x {} { }
265 foreach i {1 2 3 4} {
266 p $i
268 puts "TEST 35 PASSED"
270 # REGTEST 36
271 # divide integer by integer zero
272 catch {/ 1 0}
273 puts "TEST 36 PASSED"
275 # REGTEST 37
276 # ternary operator order
277 catch {expr {1 : 2 ? 3}}
278 puts "TEST 37 PASSED"
280 # REGTEST 38
281 # refcount with interpolation and expr
282 set b(-1) 5
283 set a $b($(-1))
284 puts "TEST 38 PASSED"
286 # REGTEST 39
287 # invalid ternary expr
288 catch {set a $(5?6,7?8:?9:10%11:12)}
289 puts "TEST 39 PASSED"
291 # REGTEST 40
292 # ref count problem - double free
293 set d [dict create a b]
294 lsort r($d)
295 catch {dict remove r($d) m}
296 puts "TEST 40 PASSED"
298 # REGTEST 41
299 # access invalid memory on no scan conversion char
300 catch {scan x %3}
301 puts "TEST 41 PASSED"
303 # REGTEST 42
304 # | and |& are not acceptable as prefixes
305 catch {exec dummy |x second}
306 puts "TEST 42 PASSED"
308 # REGTEST 43
309 # too many flags to format
310 catch {format %----------------------------------------d 1}
311 puts "TEST 43 PASSED"
313 # REGTEST 44
314 # lsort -unique with no duplicate - invalid memory write
315 lsort -unique {a b c d}
316 puts "TEST 44 PASSED"
318 # REGTEST 45
319 # regexp with missing close brace for count
320 catch [list regexp "u{0" x]
321 puts "TEST 45 PASSED"
323 # REGTEST 46
324 # scan with no stringrep
325 catch {scan $(1) $(1)}
326 puts "TEST 46 PASSED"
328 # REGTEST 47
329 # Invalid ternary expression
330 catch {set a $(99?9,99?9:*9:999)?9)}
331 puts "TEST 47 PASSED"
333 # REGTEST 48
334 # scan: -ve XPG3 specifier
335 catch {scan a {%-9999999$c}}
336 puts "TEST 48 PASSED"
338 # REGTEST 49
339 # format: precision too large
340 catch {format %1.9999999999f 1.0}
341 puts "TEST 49 PASSED"
343 # REGTEST 50
344 # expr missing operand
345 catch {expr {>>-$x}}
346 puts "TEST 50 PASSED"
348 # REGTEST 51
349 # expr convert invalid value to boolean
350 catch {expr {2 && "abc$"}}
351 puts "TEST 51 PASSED"
353 # TAKE THE FOLLOWING puts AS LAST LINE
355 puts "--- ALL TESTS PASSED ---"