Diff

Differences From Artifact [da8fb3dc27]:

To Artifact [744eb2cb5e]:


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
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] patchlevel: [info patchlevel]"
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} {} #should work, but wouldn't
	#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
#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 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 [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. {clock format 0} -> {Thu Jan 01 1970 01:00:00 GMT+0100 (CET)}
    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
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. {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. {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}
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
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 tolower Tcl}     -> tcl
e.g. {string toupper Tcl}     -> TCL
e.g. {string trim " foo "}    -> foo
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 ;# severe malfunction, breaks test suite operation :(
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
    set neq [string compare $var vars]
    if {$var != "vars" && $pos < 0} {unset $var}
}
unset vars var pos neq
unset vars var pos
puts "vars now: [info vars]"
puts "[llength [info commands]] commands implemented"