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
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
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
# json.test - Copyright (C) 2006 ActiveState Software Inc.
#
# Tests for the Tcllib json package
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
# RCS: @(#) $Id: json.test,v 1.7 2009/05/26 11:45:59 kanryu6 Exp $
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
testsNeedTcl [expr {[catch {package require dict}] ? "8.5" : "8.4"}]
testsNeedTcltest 1.0
testing {
useLocal json.tcl json
}
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"}
}
}
}
set JSON(array) {[
{
"precision": "zip",
"Latitude": 37.7668,
"Longitude": -122.3959,
"Address": "",
"City": "SAN FRANCISCO",
"State": "CA",
"Zip": "94107",
"Country": "US"
},
{
"precision": "zip",
"Latitude": 37.371991,
"Longitude": -122.026020,
"Address": "",
"City": "SUNNYVALE",
"State": "CA",
"Zip": "94085",
"Country": "US"
}
]}
set TCL(array) {{precision zip Latitude 37.7668 Longitude -122.3959 Address {} City {SAN FRANCISCO} State CA Zip 94107 Country US} {precision zip Latitude 37.371991 Longitude -122.026020 Address {} City SUNNYVALE State CA Zip 94085 Country US}}
set DICTSORT(array) {list dict}
set JSON(glossary) {{
"glossary": {
"title": "example glossary",
"mixlist": ["a \"\" str", -0.09, null, "", {"member":true}],
"GlossDiv": {
"title": "S",
"GlossList": [{
"ID": "SGML",
"GlossTerm": "Standard \\\" Language",
"Acronym": "SGML\\",
"Abbrev": "ISO 8879:1986",
"GlossDef":
"A meta-markup language, used ...",
"GlossSeeAlso": ["GML", "XML", "markup"]}]}}
}}
set TCL(glossary) {glossary {title {example glossary} mixlist {{a "" str} -0.09 null {} {member true}} GlossDiv {title S GlossList {{ID SGML GlossTerm {Standard \" Language} Acronym SGML\\ Abbrev {ISO 8879:1986} GlossDef {A meta-markup language, used ...} GlossSeeAlso {GML XML markup}}}}}}
set DICTSORT(glossary) {dict * {dict GlossDiv {dict GlossList {list dict}}}}
set JSON(menu) {{"menu": {
"id": "file",
"value": "File:",
"unival": "\u6021:",
"popup": {
"menuitem": [
{"value": "Open", "onclick": "OpenDoc()"},
{"value": "Close", "onclick": "CloseDoc()"}
]
}
}
}}
set TCL(menu) [list menu [list id file value File: unival \u6021: popup {menuitem {{value Open onclick OpenDoc()} {value Close onclick CloseDoc()}}}]]
set DICTSORT(menu) {dict * {dict popup {dict * {list dict}}}}
set JSON(widget) {{"widget": {
"debug": "on",
"window": {
"title":"Sample Widget",
"name": "main_window",
"width": 500,
"height": 500},
"text": {
"data": "Click Here",
"size": 36,
"style": "bold",
"name": null,
"hOffset":250,
"vOffset": 100,
"alignment": "center",
"onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;"
}
}
}}
set TCL(widget) {widget {debug on window {title {Sample Widget} name main_window width 500 height 500} text {data {Click Here} size 36 style bold name null hOffset 250 vOffset 100 alignment center onMouseUp {sun1.opacity = (sun1.opacity / 100) * 90;}}}}
set DICTSORT(widget) {dict * {dict text dict window dict}}
set JSON(menu2) {{"menu": {
"header": "Viewer",
"items": [
{"id": "Open"},
{"id": "OpenNew", "label": "Open New"},
null,
{"id": "ZoomIn", "label": "Zoom In"},
{"id": "ZoomOut", "label": "Zoom Out"},
null,
{"id": "Help"},
{"id": "About", "label": "About Viewer..."}
]
}
}}
set TCL(menu2) {menu {header Viewer items {{id Open} {id OpenNew label {Open New}} null {id ZoomIn label {Zoom In}} {id ZoomOut label {Zoom Out}} null {id Help} {id About label {About Viewer...}}}}}
set DICTSORT(menu2) {dict * {dict items {list 0 dict 1 dict 3 dict 4 dict 6 dict 7 dict}}}
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) {{}}
# -------------------------------------------------------------------------
# Tests
# -------------------------------------------------------------------------
set i 0
foreach name [array names JSON] {
test json-1.[incr i] "test JSON $name" {
set res [json::json2dict $JSON($name)]
if {[info exists DICTSORT($name)]} {
return [string equal [dictsort3 $DICTSORT($name) $res] [dictsort3 $DICTSORT($name) $TCL($name)]]
} else {
return [string equal $res $TCL($name)]
}
} 1
}
# -------------------------------------------------------------------------
catch {unset JSON}
catch {unset TCL}
catch {unset DICTSORT}
testsuiteCleanup
# Local Variables:
# mode: tcl
# indent-tabs-mode: nil
# End:
|
