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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
|
#use fileutil/fileutil.tcl fileutil
catch {unset JSON}
catch {unset TCL}
catch {unset DICTSORT}
proc dictsort3 {spec data} {
while [llength $spec] {
set type [lindex $spec 0]
set spec [lrange $spec 1 end]
switch -- $type {
dict {
lappend spec * string
set json {}
foreach {key} [lsort [dict keys $data]] {
set val [dict get $data $key]
foreach {keymatch valtype} $spec {
if {[string match $keymatch $key]} {
lappend json $key [dictsort3 $valtype $val]
break
}
}
}
return $json
}
list {
lappend spec * string
set json {}
set idx 0
foreach {val} $data {
foreach {keymatch valtype} $spec {
if {$idx == $keymatch || $keymatch eq "*"} {
lappend json [dictsort3 $valtype $val]
break
}
}
incr idx
}
return $json
}
string {
return $data
}
default {
error "Invalid type"
}
}
}
}
foreach f [TestFilesGlob tests/*.json] {
set name [file rootname [file tail $f]]
set JSON($name) [tcltest::viewFile $f]
}
foreach f [TestFilesGlob tests/*.result] {
set name [file rootname [file tail $f]]
set TCL($name) [tcltest::viewFile $f]
}
foreach f [TestFilesGlob tests/*.sort] {
set name [file rootname [file tail $f]]
set DICTSORT($name) [tcltest::viewFile $f]
}
# Postprocessing result of one test case, insert proper expected unicodepoint
set TCL(menu) [string map [list @@@ \u6021] $TCL(menu)]
set JSON(emptyList) {[]}
set TCL(emptyList) {}
set JSON(emptyList2) {{"menu": []}}
set TCL(emptyList2) {menu {}}
set JSON(emptyList3) {["menu", []]}
set TCL(emptyList3) {menu {}}
set JSON(emptyList4) {[[]]}
set TCL(emptyList4) {{}}
set JSON(escapes) {"\t\r\n\f\b\/\\\""}
set TCL(escapes) "\t\r\n\f\b/\\\""
foreach {label json tcl} {
fp1.1 1.1 1.1
fp1. 1. 1.
fp.1 .1 .1
fp0.1 0.1 0.1
fp1 1 1
} {
set JSON($label) $json
set TCL($label) $tcl
}
foreach f [TestFilesGlob tests/*.fail] {
set name [file rootname [file tail $f]]
set FAIL($name) [tcltest::viewFile $f]
}
foreach f [TestFilesGlob tests/*.err] {
set name [file rootname [file tail $f]]
set ERR($name) [tcltest::viewFile $f]
}
## Tcl has strict escape checking.
## C uses Tcl_UtfBacklash, and allows lots of irregular escapes.
set FAIL(escape1) {"\%"}
set ERR(escape1-tcl) {unexpected token ""\%"" at position 0; expecting STRING}
set ERR(escape1-critcl) {bad escape 3 bytes before end, around ``%''}
set FAIL(escape2) {"\."}
set ERR(escape2-tcl) {unexpected token ""\."" at position 0; expecting STRING}
set ERR(escape2-critcl) {bad escape 3 bytes before end, around ``.''}
set FAIL(escape3) {["\%"]}
set ERR(escape3-tcl) {unexpected token ""\%"" at position 1; expecting STRING}
set ERR(escape3-critcl) {bad escape 4 bytes before end, around ``%''}
set FAIL(escape4) {["\."]}
set ERR(escape4-tcl) {unexpected token ""\."" at position 1; expecting STRING}
set ERR(escape4-critcl) {bad escape 4 bytes before end, around ``.''}
set FAIL(escape5) {{"a":"\%"}}
set ERR(escape5-tcl) {unexpected token ""\%"" at position 3; expecting STRING}
set ERR(escape5-critcl) {bad escape 4 bytes before end, around ``%''}
set FAIL(escape6) {{"a":"\."}}
set ERR(escape6-tcl) {unexpected token ""\."" at position 3; expecting STRING}
set ERR(escape6-critcl) {bad escape 4 bytes before end, around ``.''}
proc resultfor {name} {
global TCL
transform $TCL($name) $name
}
proc transform {res name} {
global DICTSORT
if {[info exists DICTSORT($name)]} {
return [dictsort3 $DICTSORT($name) $res]
} else {
return $res
}
}
proc transform* {res args} {
set t {}
foreach r $res n $args {
lappend t [transform $r $n]
}
return $t
}
|
