blob: e62d0a98a56f53e50a3072b988350f04b73cf5bb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
# REGTEST 1
# 27Jan2005 - SIGSEGV for bug on Jim_DuplicateObj().
for {set i 0} {$i < 100} {incr i} {
set a "x"
lappend a n
}
puts "TEST 1 PASSED"
# REGTEST 2
# 29Jan2005 - SEGFAULT parsing script composed of just one comment.
eval {#foobar}
puts "TEST 2 PASSED"
# REGTEST 3
# 29Jan2005 - "Error in Expression" with correct expression
set x 5
expr {$x-5}
puts "TEST 3 PASSED"
# REGTEST 4
# 29Jan2005 - SIGSEGV when run this code, due to expr's bug.
proc fibonacci {x} {
if {$x <= 1} {
expr 1
} else {
expr {[fibonacci [expr {$x-1}]] + [fibonacci [expr {$x-2}]]}
}
}
fibonacci 6
puts "TEST 4 PASSED"
# REGTEST 5
# 06Mar2005 - This looped forever...
for {set i 0} {$i < 10} {incr i} {continue}
puts "TEST 5 PASSED"
# REGTEST 6
# 07Mar2005 - Unset create variable + dict is using dict syntax sugar at
# currently non-existing variable
catch {unset thisvardoesnotexists(thiskeytoo)}
if {[catch {set thisvardoesnotexists}] == 0} {
puts "TEST 6 FAILED - unset created dict for non-existing variable"
break
}
puts "TEST 6 PASSED"
# REGTEST 7
# 04Nov2008 - variable parsing does not eat last brace
set a 1
list ${a}
puts "TEST 7 PASSED"
# REGTEST 8
# 04Nov2008 - string toupper/tolower do not convert to string rep
string tolower [list a]
string toupper [list a]
puts "TEST 8 PASSED"
# REGTEST 9
# 04Nov2008 - crash on exit when replacing Tcl proc with C command. Requires the aio extension
proc open {args} {}
catch {package require aio}
# Note, crash on exit, so don't say we passed!
# REGTEST 10
# 05Nov2008 - incorrect lazy expression evaluation with unary not
expr {1 || !0}
puts "TEST 10 PASSED"
# REGTEST 11
# 14 Feb 2010 - access static variable in deleted proc
proc a {} {{x 1}} { rename a ""; incr x }
a
puts "TEST 11 PASSED"
# REGTEST 12
# 13 Sep 2010 - reference with invalid tag
set a b[ref value "tag name"]
getref [string range $a 1 end]
puts "TEST 12 PASSED"
# REGTEST 13
# 14 Sep 2010 - parse list with trailing backslash
set x "switch -0 \$on \\"
lindex $x 1
puts "TEST 13 PASSED"
# REGTEST 14
# 14 Sep 2010 - command expands to nothing
eval "{*}{}"
puts "TEST 14 PASSED"
# REGTEST 15
# 24 Feb 2010 - bad reference counting of the stack trace in 'error'
proc a {msg stack} {
tailcall error $msg $stack
}
catch {fail} msg opts
catch {a $msg $opts(-errorinfo)}
# REGTEST 16
# 24 Feb 2010 - rename the current proc
# Leaves unfreed objects on the stack
proc a {} { rename a newa}
a
# REGTEST 17
# 26 Nov 2010 - crashes on invalid dict sugar
catch {eval {$x(}}
puts "TEST 17 PASSED"
# REGTEST 18
# 12 Apr 2011 - crashes on unset for loop var
catch {
for {set i 0} {$i < 5} {incr i} {unset i}
}
puts "TEST 18 PASSED"
# TAKE THE FOLLOWING puts AS LAST LINE
puts "--- ALL TESTS PASSED ---"
|
