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
|
# test suite for TclJS
# This file is designed so it can also run in a tclsh. Some JavaScript goodies,
# like 1/0, sqrt(-1) were excluded from the tests.
# [clock format 0] was excluded because the timezone string differed.
set vars [info vars] ;# for later cleanup
set version 0.5.3
set total 0
set passed 0
set fail 0
puts "------------------------ [info script] patchlevel: [info patchlevel]"
proc e.g. {cmd -> expected} {
incr ::total
incr ::fail ;# to also count exceptions
set res [uplevel 1 $cmd]
if ![string equal $res $expected] {
#if {$res != $expected} {} #should work, but wouldn't
#native sum2 {function (interp, args) {return eval(args.join("+"));}}
#e.g. {sum2 2 3 4} -> 9
e.g. {catch foo msg} -> 1
e.g. {set msg} -> {invalid command name "foo"}
e.g. {catch {expr 7*6}} -> 0
e.g. {catch {expr 7*6} msg; set msg} -> 42
e.g. {concat {a b} {c d}} -> {a b c d}
e.g. {set d [dict create a 1 b 2 c 3]} -> {a 1 b 2 c 3}
e.g. {dict exists $d c} -> 1
e.g. {dict exists $d x} -> 0
e.g. {dict get $d b} -> 2
e.g. {dict keys $d} -> {a b c}
e.g. {dict set d b 5} -> {a 1 b 5 c 3}
e.g. {dict set d x 7} -> {a 1 b 5 c 3 x 7}
e.g. {dict unset d b} -> {a 1 c 3 x 7}
e.g. {dict unset d x} -> {a 1 c 3}
e.g. {dict unset d nix} -> {a 1 c 3}
e.g. {dict set dx a 1} -> {a 1} ;# create new dict if not exists
e.g. {set home [file dirname [pwd]]; list} -> {}
e.g. {string equal [set env(HOME)] $home} -> 1
e.g. {string equal [set ::env(HOME)] $home} -> 1
e.g. {expr 6*7} -> 42
e.g. {expr {6 * 7 + 1}} -> 43
e.g. {set x 43} -> 43
e.g. {expr {$x-1}} -> 42
e.g. {expr $x-1} -> 42
if ![info exists auto_path] { ;#these tests are not for a real tclsh
e.g. {clock format 0} -> {Thu Jan 01 1970 01:00:00 GMT+0100 (CET)}
|
|
>
|
<
<
|
|
>
>
>
|
>
>
>
<
|
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
|
# test suite for TclJS
# This file is designed so it can also run in a tclsh. Some JavaScript goodies,
# like 1/0, sqrt(-1) were excluded from the tests.
# [clock format 0] was excluded because the timezone string differed.
set vars [info vars] ;# for later cleanup
set version 0.5.3
set total 0
set passed 0
set fail 0
puts "----- [info script] of [clock format [file mtime [info script]]], patchlevel: [info patchlevel]"
proc e.g. {cmd -> expected} {
#puts $cmd
incr ::total
incr ::fail ;# to also count exceptions
set res [uplevel 1 $cmd]
if ![string equal $res $expected] {
#if {$res != $expected} {}
puts "**** $cmd -> $res, expected: $expected"
} else {incr ::passed; incr ::fail -1}
}
# e.g. {exec echo hello} -> hello ;# needs blocking exec
e.g. {append new hello} -> hello
e.g. {set x foo} -> foo
e.g. {append x bar} -> foobar
proc sum args {expr [join $args +]}
e.g. {sum 1 2 3} -> 6
e.g. {catch foo msg} -> 1
e.g. {set msg} -> {invalid command name "foo"}
e.g. {catch {expr 7*6}} -> 0
e.g. {catch {expr 7*6} msg; set msg} -> 42
e.g. {clock format 0} -> {Thu Jan 01 01:00:00 CET 1970}
e.g. {concat {a b} {c d}} -> {a b c d}
e.g. {concat $::version} -> $version
e.g. {set d [dict create a 1 b 2 c 3]} -> {a 1 b 2 c 3}
e.g. {dict exists $d c} -> 1
e.g. {dict exists $d x} -> 0
e.g. {dict get $d b} -> 2
e.g. {dict keys $d} -> {a b c}
e.g. {dict set d b 5} -> {a 1 b 5 c 3}
e.g. {dict set d x 7} -> {a 1 b 5 c 3 x 7}
e.g. {dict unset d b} -> {a 1 c 3 x 7}
e.g. {dict unset d x} -> {a 1 c 3}
e.g. {dict unset d nix} -> {a 1 c 3}
e.g. {dict set dx a 1} -> {a 1} ;# create new dict if not exists
e.g. {set home [file dirname [pwd]]; list} -> {}
e.g. {string equal [set env(HOME)] $home} -> 1
# e.g. {string equal $::env(HOME) $home} -> 1
e.g. {string equal [set ::env(HOME)] $home} -> 1
e.g. {file dirname /foo/bar/grill} -> /foo/bar
e.g. {file tail /foo/bar/grill} -> grill
e.g. {expr 6*7} -> 42
e.g. {expr {6 * 7 + 1}} -> 43
e.g. {set x 43} -> 43
e.g. {expr {$x-1}} -> 42
e.g. {expr $x-1} -> 42
if ![info exists auto_path] { ;#these tests are not for a real tclsh
e.g. {set i [expr 1/0]} -> Infinity
e.g. {expr $i==$i+42} -> 1
e.g. {set n [expr sqrt(-1)]} -> NaN
e.g. {expr $n == $n} -> 0
e.g. {expr $n==$n} -> 0
e.g. {expr $n!=$n} -> 1
e.g. {info patchlevel} -> $version
|
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
123
|
e.g. {expr {$x+1}} -> 4
e.g. {set x a; set y b; expr {$x == $y}} -> 0
e.g. {expr {$x != $y}} -> 1
e.g. {expr 43 % 5} -> 3
e.g. {set x -44; expr {-$x}} -> 44
e.g. {expr 1<<3} -> 8
set forres ""
e.g. {for {set i 0} {$i < 5} {incr i} {append forres $i}; set forres} -> 01234
e.g. {foreach i {a b c d e} {append foreachres $i}; set foreachres} -> abcde
e.g. {format %x 255} -> ff
e.g. {format %X 254} -> FE
e.g. {set x 41} -> 41
e.g. {incr x} -> 42
e.g. {incr x 2} -> 44
e.g. {incr x -3} -> 41
e.g. {info args e.g.} -> {cmd -> expected}
e.g. {unset -nocomplain foo} -> {}
e.g. {info exists foo} -> 0
e.g. {set foo 42} -> 42
e.g. {info exists foo} -> 1
e.g. {info level} -> 0 ;# e.g. runs the command one level up
e.g. {proc f x {set y 0; info vars}} -> ""
e.g. {f 41} -> {x y}
set tmp [f 40]; e.g. {lappend tmp z} -> {x y z}
e.g. {info args f} -> x
e.g. {info body f} -> {set y 0; info vars}
e.g. {info bod f} -> {set y 0; info vars}
e.g. {join {a b c}} -> {a b c}
e.g. {join {a b c} +} -> {a+b+c}
|
>
>
>
>
>
>
|
|
|
|
|
|
|
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
123
124
125
126
127
128
129
130
131
132
133
|
e.g. {expr {$x+1}} -> 4
e.g. {set x a; set y b; expr {$x == $y}} -> 0
e.g. {expr {$x != $y}} -> 1
e.g. {expr 43 % 5} -> 3
e.g. {set x -44; expr {-$x}} -> 44
e.g. {expr 1<<3} -> 8
e.g. {file dirname foo/bar/grill} -> foo/bar
e.g. {file dirname /foo/bar/grill} -> /foo/bar
e.g. {file extension foo.txt} -> .txt
e.g. {file extension Makefile} -> ""
e.g. {file tail foo/bar/grill} -> grill
set forres ""
e.g. {for {set i 0} {$i < 5} {incr i} {append forres $i}; set forres} -> 01234
e.g. {foreach i {a b c d e} {append foreachres $i}; set foreachres} -> abcde
e.g. {format %x 255} -> ff
e.g. {format %X 254} -> FE
e.g. {set x 41} -> 41
e.g. {incr x} -> 42
e.g. {incr x 2} -> 44
e.g. {incr x -3} -> 41
e.g. {info args e.g.} -> {cmd -> expected}
e.g. {unset -nocomplain foo} -> {}
e.g. {info exists foo} -> 0
e.g. {set foo 42} -> 42
e.g. {info exists foo} -> 1
e.g. {info level} -> 0 ;# e.g. runs the command one level up
e.g. {proc f x {set y 0; info vars}} -> ""
e.g. {f 41} -> {x y}
set tmp [f 40]; e.g. {lappend tmp z} -> {x y z}
e.g. {info args f} -> x
e.g. {info body f} -> {set y 0; info vars}
e.g. {info bod f} -> {set y 0; info vars}
e.g. {join {a b c}} -> {a b c}
e.g. {join {a b c} +} -> {a+b+c}
|
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
e.g. {lsearch $x y} -> -1
e.g. {lsort {z x y}} -> {x y z}
e.g. {proc f args {expr [join $args +]}} -> ""
e.g. {f 1} -> 1
e.g. {f 1 2} -> 3
e.g. {f 1 2 3} -> 6
e.g. {regexp {X[ABC]Y} XAY} -> 1
e.g. {regexp {X[ABC]Y} XDY} -> 0
e.g. {regsub {[A-C]+} uBAAD x} -> uxD
e.g. {split "a b c d"} -> {a b {} c d}
e.g. {split " a b c d"} -> {{} a b {} c d}
e.g. {split "a b c d "} -> {a b {} c d {}}
e.g. {split usr/local/bin /} -> {usr local bin}
e.g. {split /usr/local/bin /} -> {{} usr local bin}
e.g. {split abc ""} -> {a b c}
e.g. {string compare a b} -> -1
e.g. {string compare b a} -> 1
e.g. {string compare b b} -> 0
e.g. {string equal foo foo} -> 1
e.g. {string equal foo bar} -> 0
e.g. {string index abcde 2} -> c
e.g. {string length ""} -> 0
e.g. {string length foo} -> 3
e.g. {string range hello 1 3} -> ell
e.g. {string tolower Tcl} -> tcl
e.g. {string toupper Tcl} -> TCL
e.g. {string trim " foo "} -> foo
e.g. {set x a.\x62.c} -> a.b.c ;# severe malfunction, breaks test suite operation :(
puts "total $total tests, passed $passed, failed $fail"
#----------- clean up variables used in tests
foreach var [info vars] {
set pos [lsearch $vars $var] ;# expr can't substitute commands yet
set neq [string compare $var vars]
unset vars var pos neq
puts "vars now: [info vars]"
puts "[llength [info commands]] commands implemented"
|
>
|
|
|
|
|
|
|
|
|
>
|
|
|
|
>
>
<
|
|
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
|
e.g. {lsearch $x y} -> -1
e.g. {lsort {z x y}} -> {x y z}
e.g. {proc f args {expr [join $args +]}} -> ""
e.g. {f 1} -> 1
e.g. {f 1 2} -> 3
e.g. {f 1 2 3} -> 6
e.g. {proc f {arg b} {expr $arg*$b}; f 6 7} -> 42 ;# should work with 'args'
e.g. {regexp {X[ABC]Y} XAY} -> 1
e.g. {regexp {X[ABC]Y} XDY} -> 0
e.g. {regsub {[A-C]+} uBAAD x} -> uxD
e.g. {split "a b c d"} -> {a b {} c d}
e.g. {split " a b c d"} -> {{} a b {} c d}
e.g. {split "a b c d "} -> {a b {} c d {}}
e.g. {split usr/local/bin /} -> {usr local bin}
e.g. {split /usr/local/bin /} -> {{} usr local bin}
e.g. {split abc ""} -> {a b c}
e.g. {string compare a b} -> -1
e.g. {string compare b a} -> 1
e.g. {string compare b b} -> 0
e.g. {string equal foo foo} -> 1
e.g. {string equal foo bar} -> 0
e.g. {string index abcde 2} -> c
e.g. {string length ""} -> 0
e.g. {string length foo} -> 3
e.g. {string range hello 1 3} -> ell
e.g. {string range hello 1 end} -> ello
e.g. {string tolower Tcl} -> tcl
e.g. {string toupper Tcl} -> TCL
e.g. {string trim " foo "} -> foo
e.g. {set x a.\x62.c} -> a.b.c
e.g. {set e \u20ac} -> "€" ;# breaks in node v0.6.19, works in v0.10.22
puts "total $total tests, passed $passed, failed $fail"
#----------- clean up variables used in tests
foreach var [info vars] {
set pos [lsearch $vars $var] ;# expr can't substitute commands yet
if {$var != "vars" && $pos < 0} {unset $var}
}
unset vars var pos
puts "vars now: [info vars]"
puts "[llength [info commands]] commands implemented"
|