Tcl Library Source Code

Check-in [af6919a548]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Moved the larger test cases and data into separate files, less quoting that way. Added test case for the escape-able characters. Added test cases for invalid json. Shifted the json generating procedures to the common file, making them shared between Tcl and C implementations. Added a benchmark suite, using the test cases in the files as input.
Timelines: family | ancestors | descendants | both | ak-bug-6efa4f571af052-jsonc
Files: files | file ages | folders
SHA1: af6919a548bd1a4f26c80b565be4e08a5146de50
User & Date: andreask 2013-12-11 21:07:44
Original Comment: Moved the larger test cases and data into separate files, less quiting that way. Added test case for the escape-able characters. Added test cases for invalid json. Shifted the json generating procedures to the common file, making them shared between Tcl and C implementations. Added a benchmark suite, using the test cases in the files as input.
Context
2013-12-11
22:25
Fixed buglets which slipped through in previous commit. check-in: 1c1271bd98 user: andreask tags: ak-bug-6efa4f571af052-jsonc
21:07
Moved the larger test cases and data into separate files, less quoting that way. Added test case for the escape-able characters. Added test cases for invalid json. Shifted the json generating procedures to the common file, making them shared between Tcl and C implementations. Added a benchmark suite, using the test cases in the files as input. check-in: af6919a548 user: andreask tags: ak-bug-6efa4f571af052-jsonc
01:29
Implemented many-json2dict and validate over json-c. Test cases for many-json2dict reactivated, passing. New cases for validate, passing. Should add test cases for invalid json input. check-in: 08ac1421ee user: andreask tags: ak-bug-6efa4f571af052-jsonc
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added modules/json/json.bench.
















































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
# -*- tcl -*-
# Tcl Benchmark File
#
# This file contains a number of benchmarks for the 'json' parser
# to allow developers to monitor package performance.
#
# (c) 2013 Andreas Kupries <[email protected]>

# We need at least version 8.4 for the package and thus the
# benchmarks.

if {![package vsatisfies [package present Tcl] 8.4]} {
    bench_puts "Need Tcl 8.4+, found Tcl [package present Tcl]"
    return
}

# ### ### ### ######### ######### ######### ###########################
## Setting up the environment ...

package require Tcl 8.4

package forget json

set self  [file join [pwd] [file dirname [info script]]]
set mod   [file dirname $self]
set index [file join [file dirname $self] tcllibc pkgIndex.tcl]

if 1 {
    if {[file exists $index]} {
	set ::dir [file dirname $index]
	uplevel #0 [list source $index]
	unset ::dir
	package require tcllibc
    }
}

source [file join $self json.tcl]

proc cat {f} {
    set c [open $f]
    set d [read $c]
    close $c
    return $d
}

# ### ### ### ######### ######### ######### ###########################
## Get all the possible implementations

json::SwitchTo {}
foreach e [json::KnownImplementations] {
    ::json::LoadAccelerator $e
}

# ### ### ### ######### ######### ######### ###########################
## Benchmarks.
## Just the parser, on the valid inputs for the testsuite.

foreach impl [json::Implementations] {
    json::SwitchTo $impl

    bench_puts {=== parse =========}

    foreach f [glob -nocomplain -directory $self/test-data *.json] {
	set in [cat $f]

	bench -desc "parse [file rootname [file tail $f]] ($impl)" -body {
	    json::json2dict $in
	}
    }

    foreach f [glob -nocomplain -directory $self/test-data *.bench] {
	set in [cat $f]

	bench -desc "parse [file rootname [file tail $f]] ($impl)" -body {
	    json::json2dict $in
	}
    }

    bench_puts {=== validate =========}

    foreach f [glob -nocomplain -directory $self/test-data *.json] {
	set in [cat $f]

	bench -desc "validate [file rootname [file tail $f]] ($impl)" -body {
	    json::validate $in
	}
    }

    foreach f [glob -nocomplain -directory $self/test-data *.bench] {
	set in [cat $f]

	bench -desc "validate [file rootname [file tail $f]] ($impl)" -body {
	    json::validate $in
	}
    }
}

# ### ### ### ######### ######### ######### ###########################
## Complete

return

# ### ### ### ######### ######### ######### ###########################
## Notes ...

Changes to modules/json/json.tcl.

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
...
172
173
174
175
176
177
178






























179
180
181
182
183
namespace eval ::json {
    variable  selfdir [file dirname [info script]]
    variable  accel
    array set accel   {tcl 0 critcl 0}
    variable  loaded  {}

    variable apicmds {
	dict2json
	json2dict
	list2json
	many-json2dict
	string2json
	validate
    }
}

# ### ### ### ######### ######### #########
## Initialization: Choose an implementation,
## most prefered first. Loads only one of the
................................................................................
	if {[LoadAccelerator $e]} {
	    SwitchTo $e
	    break
	}
    }
    unset e
}































# ### ### ### ######### ######### #########
## Ready

package provide json 1.2






<

<

<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





148
149
150
151
152
153
154

155

156

157
158
159
160
161
162
163
...
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
209
210
namespace eval ::json {
    variable  selfdir [file dirname [info script]]
    variable  accel
    array set accel   {tcl 0 critcl 0}
    variable  loaded  {}

    variable apicmds {

	json2dict

	many-json2dict

	validate
    }
}

# ### ### ### ######### ######### #########
## Initialization: Choose an implementation,
## most prefered first. Loads only one of the
................................................................................
	if {[LoadAccelerator $e]} {
	    SwitchTo $e
	    break
	}
    }
    unset e
}

# ### ### ### ######### ######### #########
## These three procedures shared between Tcl and Critcl implementations.
## See also package "json::write".

proc ::json::dict2json {dictVal} {
    # XXX: Currently this API isn't symmetrical, as to create proper
    # XXX: JSON text requires type knowledge of the input data
    set json ""

    foreach {key val} $dictVal {
	# key must always be a string, val may be a number, string or
	# bare word (true|false|null)
	if {0 && ![string is double -strict $val]
	    && ![regexp {^(?:true|false|null)$} $val]} {
	    set val "\"$val\""
	}
    	append json "\"$key\": $val," \n
    }

    return "\{${json}\}"
}

proc ::json::list2json {listVal} {
    return "\[[join $listVal ,]\]"
}

proc ::json::string2json {str} {
    return "\"$str\""
}

# ### ### ### ######### ######### #########
## Ready

package provide json 1.2

Changes to modules/json/json.testsuite.

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
# -*- tcl -*-
# -------------------------------------------------------------------------
# Tests
# -------------------------------------------------------------------------

set i 0
foreach name [array names JSON] {
    set expected [transform $TCL($name) $name]

    test json-${impl}-1.[incr i] "test JSON $name" -body {
        set res [json::json2dict $JSON($name)]
	set res [transform $res $name]
	set res
    } -cleanup {
	unset res expected
    } -result $expected
}

set i 0
foreach name [array names JSON] {
    test json-${impl}-7.[incr i] "validate JSON $name" -body {
        json::validate $JSON($name)
    } -cleanup {













    } -result 1
}

# -------------------------------------------------------------------------
# More Tests - list2json, string2json
# TODO: dict2json
# -------------------------------------------------------------------------

test json-${impl}-2.0 {list2json} -body {






<
<





|
|






|
>
>
>
>
>
>
>
>
>
>
>
>
>
|








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
# -*- tcl -*-
# -------------------------------------------------------------------------
# Tests
# -------------------------------------------------------------------------

set i 0
foreach name [array names JSON] {


    test json-${impl}-1.[incr i] "test JSON $name" -body {
        set res [json::json2dict $JSON($name)]
	set res [transform $res $name]
	set res
    } -cleanup {
	unset res
    } -result [resultfor $name]
}

set i 0
foreach name [array names JSON] {
    test json-${impl}-7.[incr i] "validate JSON $name" -body {
        json::validate $JSON($name)
    } -result 1
}

set i 0
foreach name [array names FAIL] {
    test json-${impl}-8.[incr i] "test FAIL $name" -body {
	json::json2dict $FAIL($name)
    } -returnCodes error -result $ERR(${name}-${impl})
}

set i 0
foreach name [array names FAIL] {
    test json-${impl}-9.[incr i] "validate FAIL $name" -body {
        json::validate $FAIL($name)
    } -result 0
}

# -------------------------------------------------------------------------
# More Tests - list2json, string2json
# TODO: dict2json
# -------------------------------------------------------------------------

test json-${impl}-2.0 {list2json} -body {

Changes to modules/json/json_tcl.tcl.

327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
                } else {
                    unexpected $tokenCursor $token "VALUE"
                }
            }
        }
    }
}

proc ::json::dict2json_tcl {dictVal} {
    # XXX: Currently this API isn't symmetrical, as to create proper
    # XXX: JSON text requires type knowledge of the input data
    set json ""

    dict for {key val} $dictVal {
	# key must always be a string, val may be a number, string or
	# bare word (true|false|null)
	if {0 && ![string is double -strict $val]
	    && ![regexp {^(?:true|false|null)$} $val]} {
	    set val "\"$val\""
	}
    	append json "\"$key\": $val," \n
    }

    return "\{${json}\}"
}

proc ::json::list2json_tcl {listVal} {
    return "\[[join $listVal ,]\]"
}

proc ::json::string2json_tcl {str} {
    return "\"$str\""
}






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
327
328
329
330
331
332
333


























                } else {
                    unexpected $tokenCursor $token "VALUE"
                }
            }
        }
    }
}


























Changes to modules/json/jsonc.tcl.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
130
131
132
133
134
135
136






137
138
139
140
141
142
143
144
145
146
147
148
149
150
...
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
# Copyright (c) 2013 - C binding      - [email protected]

package require critcl
# @sak notprovided jsonc
package provide jsonc 1
package require Tcl 8.4

## Parts still written in Tcl.
critcl::tsources jsonc_tcl.tcl

critcl::cheaders -Ic c/*.h
critcl::csources c/*.c

# # ## ### Import base declarations, forwards ### ## # #

critcl::ccode {
    #include <string.h>
................................................................................
	    return value2obj(I, jso);
	}	
    }

    static Tcl_Obj *
    value2obj(Tcl_Interp *I, struct json_object *jso)
    {






	switch (json_object_get_type(jso)) {
	    case json_type_object: {
		/* Using List API here for compat with Tcl 8.4. */

		Tcl_Obj* result = Tcl_NewListObj(0, NULL);
		Tcl_Obj* key;
		Tcl_Obj* value;

		json_object_object_foreach(jso, k, v) {
		    key   = Tcl_NewStringObj(k, -1);
		    value = lazy_value2obj(I, v);

		    Tcl_ListObjAppendElement(I, result, key);
		    Tcl_ListObjAppendElement(I, result, value);
................................................................................
	    }

	    case json_type_int: {
		return Tcl_NewLongObj(json_object_get_int64(jso));
	    }

	    case json_type_array: {
		int len;
		struct array_list *ar = json_object_get_array(jso);
		Tcl_Obj* value;
		Tcl_Obj* result = Tcl_NewListObj(0, NULL);

		for (len = 0; len < ar->length; len++) {
		    value = lazy_value2obj(I, ar->array[len]);
		    Tcl_ListObjAppendElement(I, result, value);
		}
		return result;
	    }

	    case json_type_string: {
		int len = json_object_get_string_len(jso);
		return Tcl_NewStringObj(json_object_get_string(jso), len);
	    }
	}
	return NULL; /* unreachable */
    }
}







<
<
<







 







>
>
>
>
>
>



<
|
<
<







 







<
|
<
|









|







7
8
9
10
11
12
13



14
15
16
17
18
19
20
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

143


144
145
146
147
148
149
150
...
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
# Copyright (c) 2013 - C binding      - [email protected]

package require critcl
# @sak notprovided jsonc
package provide jsonc 1
package require Tcl 8.4




critcl::cheaders -Ic c/*.h
critcl::csources c/*.c

# # ## ### Import base declarations, forwards ### ## # #

critcl::ccode {
    #include <string.h>
................................................................................
	    return value2obj(I, jso);
	}	
    }

    static Tcl_Obj *
    value2obj(Tcl_Interp *I, struct json_object *jso)
    {
	struct array_list* ar;
	int                len;
	Tcl_Obj*           key;
	Tcl_Obj*           result;
	Tcl_Obj*           value;

	switch (json_object_get_type(jso)) {
	    case json_type_object: {
		/* Using List API here for compat with Tcl 8.4. */

		result = Tcl_NewListObj(0, NULL);



		json_object_object_foreach(jso, k, v) {
		    key   = Tcl_NewStringObj(k, -1);
		    value = lazy_value2obj(I, v);

		    Tcl_ListObjAppendElement(I, result, key);
		    Tcl_ListObjAppendElement(I, result, value);
................................................................................
	    }

	    case json_type_int: {
		return Tcl_NewLongObj(json_object_get_int64(jso));
	    }

	    case json_type_array: {

		ar     = json_object_get_array(jso);

		result = Tcl_NewListObj(0, NULL);

		for (len = 0; len < ar->length; len++) {
		    value = lazy_value2obj(I, ar->array[len]);
		    Tcl_ListObjAppendElement(I, result, value);
		}
		return result;
	    }

	    case json_type_string: {
		len = json_object_get_string_len(jso);
		return Tcl_NewStringObj(json_object_get_string(jso), len);
	    }
	}
	return NULL; /* unreachable */
    }
}

Added modules/json/test-data/array.json.












































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
[
      {
         "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"
      }
     ]

Added modules/json/test-data/array.result.



>
1
{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}

Added modules/json/test-data/array.sort.



>
1
list dict

Added modules/json/test-data/glossary.json.






























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
{
    "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"]}]}}
}

Added modules/json/test-data/glossary.result.



>
1
glossary {title {example glossary} mixlist {{a "" str} -0.09 null {} {member 1}} 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}}}}}

Added modules/json/test-data/glossary.sort.



>
1
dict * {dict GlossDiv {dict GlossList {list dict}}}

Added modules/json/test-data/menu.json.
























>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
{"menu": {
    "id": "file",
    "value": "File:",
    "unival": "\u6021:",
    "popup": {
        "menuitem": [
                     {"value": "Open", "onclick": "OpenDoc()"},
                     {"value": "Close", "onclick": "CloseDoc()"}
                    ]
    }
}
}

Added modules/json/test-data/menu.result.



>
1
menu {id file value File: unival @@@: popup {menuitem {{value Open onclick OpenDoc()} {value Close onclick CloseDoc()}}}}

Added modules/json/test-data/menu.sort.



>
1
dict * {dict popup {dict * {list dict}}}

Added modules/json/test-data/menu2.json.




























>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
{"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..."}
             ]
}
}

Added modules/json/test-data/menu2.result.



>
1
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...}}}}

Added modules/json/test-data/menu2.sort.



>
1
dict * {dict items {list 0 dict 1 dict 3 dict 4 dict 6 dict 7 dict}}

Added modules/json/test-data/widget.json.






































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
{"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;"
    }
}
}

Added modules/json/test-data/widget.result.



>
1
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;}}}

Added modules/json/test-data/widget.sort.



>
1
dict * {dict text dict window dict}

Changes to modules/json/test_support.tcl.

1


2
3
4
5
6
7
8
..
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


catch {unset JSON}
catch {unset TCL}
catch {unset DICTSORT}

proc dictsort3 {spec data} {
    while [llength $spec] {
        set type [lindex $spec 0]
................................................................................
                    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 1}} 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) {{}}

proc resultfor {name} {
    global TCL
    transform $TCL($name) $name
}

proc transform {res name} {
>
>







 







>
|
|
|
|
|

<
>
>
>
>
|
<
<
<
<
|
|
|
<
<
>
|
>
|
|
<
<
<
<
<
<
|
<
<

<
>
>

|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>

|
<
<
<
<
<
<
<
>
|
>
>
|
>
>
|
<
<
<
>
>

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<
<
>
>
>
|
<
<
<
<
<
<
<
<
<
<
<
|
>
>
>

<
<
<

<
<
>
>
>

<
<
>
>
>

<
<

<
<







1
2
3
4
5
6
7
8
9
10
..
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
#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]
................................................................................
                    incr idx
                }
                return $json
            }
            string {
                return $data
            }
            default {
		error "Invalid type"
	    }
        }
    }
}


foreach f [TestFilesGlob test-data/*.json] {
    set name [file rootname [file tail $f]]
    set JSON($name) [tcltest::viewFile $f]
}





foreach f [TestFilesGlob test-data/*.result] {
    set name [file rootname [file tail $f]]
    set TCL($name) [tcltest::viewFile $f]


}

foreach f [TestFilesGlob test-data/*.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 f [TestFilesGlob test-data/*.fail] {
    set name [file rootname [file tail $f]]
    set FAIL($name) [tcltest::viewFile $f]
}












foreach f [TestFilesGlob test-data/*.err] {
    set name [file rootname [file tail $f]]
    set ERR($name) [tcltest::viewFile $f]
}






set FAIL(escape1)        {"\%"}
set  ERR(escape1-tcl)    {unexpected token "END" at position 0; expecting VALUE}
set  ERR(escape1-critcl) {invalid string sequence}



set FAIL(escape2)        {"\."}
set  ERR(escape2-tcl)    {unexpected token "END" at position 0; expecting VALUE}
set  ERR(escape2-critcl) {invalid string sequence}







proc resultfor {name} {
    global TCL
    transform $TCL($name) $name
}

proc transform {res name} {