Check-in [1a97144602]
Not logged in

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

Overview
Comment:update rl_json to version 0.11.0
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1a97144602fe5f2236bb739a8e5ebb4342a47f4a
User & Date: chw 2020-02-10 09:19:41
Context
2020-02-10
10:28
tweak rl_json for Win32 builds check-in: 428dbafaa6 user: chw tags: trunk
09:21
merge with trunk check-in: 54008bb933 user: chw tags: wtf-8-experiment
09:19
update rl_json to version 0.11.0 check-in: 1a97144602 user: chw tags: trunk
06:45
add tk upstream changes check-in: a211db3b97 user: chw tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added assets/rl_json0.11/pkgIndex.tcl.





>
>
1
2
package ifneeded rl_json 0.11.0 \
    [list load librl_json[info sharedlibextension] rl_json]

Deleted assets/rl_json0.9.13/pkgIndex.tcl.

1
2
package ifneeded rl_json 0.9.13 \
    [list load librl_json[info sharedlibextension] rl_json]
<
<




Changes to jni/rl_json/Android.mk.

19
20
21
22
23
24
25



26
27
28
29
30

31
32
33
34
35
36
37
LOCAL_C_INCLUDES := $(tcl_includes) $(tk_includes) $(LOCAL_PATH)/generic

LOCAL_EXPORT_C_INCLUDES := $(LOCAL_C_INCLUDES)

LOCAL_SRC_FILES := \
	generic/parser.c \
	generic/rl_json.c \



	generic/rl_jsonStubInit.c

LOCAL_CFLAGS := $(tcl_cflags) $(tk_cflags) \
	-DPACKAGE_NAME="\"rl_json\"" \
	-DPACKAGE_VERSION="\"0.9.13\"" \

	-O2

LOCAL_SHARED_LIBRARIES := libtcl

LOCAL_LDLIBS := -llog

include $(BUILD_SHARED_LIBRARY)







>
>
>




|
>







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
LOCAL_C_INCLUDES := $(tcl_includes) $(tk_includes) $(LOCAL_PATH)/generic

LOCAL_EXPORT_C_INCLUDES := $(LOCAL_C_INCLUDES)

LOCAL_SRC_FILES := \
	generic/parser.c \
	generic/rl_json.c \
	generic/json_types.c \
	generic/dedup.c \
	generic/api.c \
	generic/rl_jsonStubInit.c

LOCAL_CFLAGS := $(tcl_cflags) $(tk_cflags) \
	-DPACKAGE_NAME="\"rl_json\"" \
	-DPACKAGE_VERSION="\"0.11.0\"" \
	-DTIP445_SHIM=1 -DDEDUP=1 \
	-O2

LOCAL_SHARED_LIBRARIES := libtcl

LOCAL_LDLIBS := -llog

include $(BUILD_SHARED_LIBRARY)

Changes to jni/rl_json/Makefile.in.

199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
214
215
216
#========================================================================
# Your doc target should differentiate from doc builds (by the developer)
# and doc installs (see install-doc), which just install the docs on the
# end user machine when building from source.
#========================================================================

doc:
	@echo "If you have documentation to create, place the commands to"

	@echo "build the docs in the 'doc:' target.  For example:"
	@echo "        xml2nroff sample.xml > sample.n"
	@echo "        xml2html sample.xml > sample.html"

install: all install-binaries install-libraries install-doc

install-binaries: binaries install-lib-binaries install-bin-binaries

#========================================================================
# This rule installs platform-independent files, such as header files.







<
>
|
|
<







199
200
201
202
203
204
205

206
207
208

209
210
211
212
213
214
215
#========================================================================
# Your doc target should differentiate from doc builds (by the developer)
# and doc installs (see install-doc), which just install the docs on the
# end user machine when building from source.
#========================================================================

doc:


doc/json.html:
	cd doc && man2html -r json.n > json.html


install: all install-binaries install-libraries install-doc

install-binaries: binaries install-lib-binaries install-bin-binaries

#========================================================================
# This rule installs platform-independent files, such as header files.

Changes to jni/rl_json/README.md.

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
..
95
96
97
98
99
100
101





















































































102
103
104
105
106
107
108
...
144
145
146
147
148
149
150










151
152
153
154
155
156
157
...
202
203
204
205
206
207
208

























209
210
211
212
213
214
215
dictionary which hold the values to interpolate.  When interpolating from
variables in the current scope, they name scalar or array variables which hold
the values to interpolate.  In either case if the named key or variable doesn't
exist, a JSON null is interpolated in its place.

Quick Reference
---------------
* [json get *json_val* ?*key* ... ?*modifier*??]  - Extract the value of a portion of the *json_val*, returns the closest native Tcl type (other than JSON) for the extracted portion.
* [json parse *json_val*]  - A deprecated synonym for [json get *json_val*].
* [json get_typed *json_val* ?*key* ... ?*modifier*??]  - Extract the value of a portion of the *json_val*, returns a two element list: the first being the value that would be returned by [json get] and the second being the JSON type of the extracted portion.
* [json extract *json_val* ?*key* ...?]  - Extract the value of a portion of the *json_val*, returns the JSON fragment.
* [json exists *json_val* ?*key* ... ?*modifier*??]  - Tests whether the supplied key path and modifier resolve to something that exists in *json_val*

* [json set *json_variable_name* ?*key* ...? *value*]  - Updates the JSON value stored in the variable *json_variable_name*, replacing the value referenced by *key* ... with the JSON value *value*.
* [json unset *json_variable_name* ?*key* ...?]  - Updates the JSON value stored in the variable *json_variable_name*, removing the value referenced by *key* ...
* [json isnull *json_val* ?*key* ...?]  - Return a boolean indicating whether the named JSON value is null.
* [json type *json_val* ?*key* ...?]  - Return the type of the named JSON value, one of "object", "array", "string", "number", "boolean" or "null".
* [json normalize *json_val*]  - Return a "normalized" version of the input *json_val* - all optional whitespace trimmed.
* [json template *json_val* ?*dictionary*?]  - Return a JSON value by interpolating the values from *dictionary* into the template, or from variables in the current scope if *dictionary* is not supplied, in the manner described above.




* [json new *type* *value*]  - Return a JSON fragment of type *type* and value *value*.
* [json fmt *type* *value*]  - A deprecated synonym for [json new *type* *value*].
* [json foreach *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - Evaluate *script* in a loop in a similar way to the [foreach] command.  In each iteration, the values stored in the iterator variables in *varlist* are the JSON fragments from *json_val*.  Supports iterating over JSON arrays and JSON objects.  In the JSON object case, *varlist* must be a two element list, with the first specifiying the variable to hold the key and the second the value.  In the JSON array case, the rules are the same as the [foreach] command.
* [json lmap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - As for [json foreach], except that it is collecting - the result from each evaluation of *script* is added to a list and returned as the result of the [json lmap] command.  If the *script* results in a TCL_CONTINUE code, that iteration is skipped and no element is added to the result list.  If it results in TCL_BREAK the iterations are stopped and the results accumulated so far are returned.






* [json pretty *json_val*]  - Returns a pretty-printed string representation of *json_val*.  Useful for debugging or inspecting the structure of JSON data.



Paths
-----

The commands [json get], [json get_typed], [json extract] and [json exists]
accept a path specification that names some subset of the supplied *json_val*.
The rules are similar to the equivalent concept in the [dict] command, except
that the paths used by [json] allow indexing into JSON arrays by the integer
key (or a string matching the regex "^end(-[0-9]+)?$"), and that the last
element can be a modifier:
* **?type** - Returns the type of the named fragment.
* **?length** - When the path refers to an array, this returns the length of the array.  When the path refers to a string, this returns the number of characters in the string.  All other types throw an error.
* **?size** - Valid only for objects, returns the number of keys defined in the object.
* **?keys** - Valid only for objects, returns a list of the keys in the object.

A literal value that would match one of the above modifiers can be used as the last element in the path by doubling the ?:

~~~tcl
json get {
    {
        "foo": {
            "?size": "quite big"


        }
    }
} foo ??size
~~~

Returns "quite big"





























Examples
--------



Produce a JSON value from a template:
~~~tcl
json template {
    {
        "thing1": "~S:val1",
        "thing2": ["a", "~N:val2", "~S:val2", "~B:val2", "~S:val3", "~L:~S:val1"],
................................................................................
    }
}
~~~
Result:
~~~json
{"thing1":"hello","thing2":["a",1000000.0,"1e6",true,null,"~S:val1"],"subdoc1":{"thing3":"~S:val1"},"subdoc2":{"thing3":"hello"}}
~~~






















































































## Performance

Good performance was a requirement for rl_json, because it is used to handle
large volumes of data flowing to and from various JSON based REST apis.  It's
generally the fastest option for working with JSON values in Tcl from the
options I've tried, with the next closest being yajltcl.  These benchmarks
................................................................................
    old_json_parse |  241.595
     rl_json_parse |    5.540
       rl_json_get |    4.950
           yajltcl |    8.800
rl_json_get_native |    0.800
```











### Generating

This benchmark compares the relative performance of various ways of
dynamically generating a JSON document.  Although all the methods produce the
same string, only the "template" and "template_dict" variants handle nulls in
the general case - the others manually test for null only for the one field
that is known to be null, so the performance of these variants would be worse
................................................................................
     rl_json_new |   10.240
        template |    4.520
         yajltcl |    7.700
   template_dict |    2.500
    yajltcl_dict |    7.530
```


























Under the Hood
--------------

Older versions used the yajl c library to parse the JSON string and properly
quote generated strings when serializing JSON values, but currently a custom
built parser and string quoter is used, removing the libyajl dependency.  JSON
values are parsed to an internal format using Tcl_Objs and stored as the







|
<
<

<
>


<
<


>
>
>
>
|
|


>
>
>
>
>
>

>
>




|



|
|
|
|
|
|
<
<




|
|
>
>


|


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



>
>







 







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







 







>
>
>
>
>
>
>
>
>
>







 







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







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
...
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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
...
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
...
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
360
361
362
363
364
365
366
367
368
369
370
371
372
373
dictionary which hold the values to interpolate.  When interpolating from
variables in the current scope, they name scalar or array variables which hold
the values to interpolate.  In either case if the named key or variable doesn't
exist, a JSON null is interpolated in its place.

Quick Reference
---------------
* [json get *json_val* ?*key* ...?]  - Extract the value of a portion of the *json_val*, returns the closest native Tcl type (other than JSON) for the extracted portion.


* [json extract *json_val* ?*key* ...?]  - Extract the value of a portion of the *json_val*, returns the JSON fragment.

* [json exists *json_val* ?*key* ...?]  - Tests whether the supplied key path resolve to something that exists in *json_val*
* [json set *json_variable_name* ?*key* ...? *value*]  - Updates the JSON value stored in the variable *json_variable_name*, replacing the value referenced by *key* ... with the JSON value *value*.
* [json unset *json_variable_name* ?*key* ...?]  - Updates the JSON value stored in the variable *json_variable_name*, removing the value referenced by *key* ...


* [json normalize *json_val*]  - Return a "normalized" version of the input *json_val* - all optional whitespace trimmed.
* [json template *json_val* ?*dictionary*?]  - Return a JSON value by interpolating the values from *dictionary* into the template, or from variables in the current scope if *dictionary* is not supplied, in the manner described above.
* [json string *value*]  - Return a JSON string with the value *value*.
* [json number *value*]  - Return a JSON number with the value *value*.
* [json boolean *value*]  - Return a JSON boolean with the value *value*.  Any of the forms accepted by Tcl_GetBooleanFromObj are accepted and normalized.
* [json object ?*key* *value* ?*key* *value* ...??]  - Return a JSON object with the keys and values specified.  *value* is a list of two elements, the first being the type {string, number, boolean, null, object, array, json}, and the second being the value.
* [json object *packed_value*]  - An alternate syntax that takes the list of keys and values as a single arg instead of a list of args, but is otherwise the same.
* [json array ?*elem* ...?]  - Return a JSON array containing each of the elements given.  *elem* is a list of two elements, the first being the type {string, number, boolean, null, object, array, json}, and the second being the value.
* [json foreach *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - Evaluate *script* in a loop in a similar way to the [foreach] command.  In each iteration, the values stored in the iterator variables in *varlist* are the JSON fragments from *json_val*.  Supports iterating over JSON arrays and JSON objects.  In the JSON object case, *varlist* must be a two element list, with the first specifiying the variable to hold the key and the second the value.  In the JSON array case, the rules are the same as the [foreach] command.
* [json lmap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - As for [json foreach], except that it is collecting - the result from each evaluation of *script* is added to a list and returned as the result of the [json lmap] command.  If the *script* results in a TCL_CONTINUE code, that iteration is skipped and no element is added to the result list.  If it results in TCL_BREAK the iterations are stopped and the results accumulated so far are returned.
* [json amap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - As for [json lmap], but the result is a JSON array rather than a list.  If the result of each iteration is a JSON value it is added to the array as-is, otherwise it is converted to a JSON string.
* [json omap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - As for [json lmap], but the result is a JSON object rather than a list.  The result of each iteration must be a dictionary (or a list of 2n elements, including n = 0).  Tcl_ObjType snooping is done to ensure that the iteration over the result is efficient for both dict and list cases.  Each entry in the dictionary will be added to the result object.  If the value for each key in the iteration result is a JSON value it is  added to the array as-is, otherwise it is converted to a JSON string.
* [json isnull *json_val* ?*key* ...?]  - Return a boolean indicating whether the named JSON value is null.
* [json type *json_val* ?*key* ...?]  - Return the type of the named JSON value, one of "object", "array", "string", "number", "boolean" or "null".
* [json length *json_val* ?*key* ...?]  - Return the length of the of the named JSON array, number of entries in the named JSON object, or number of characters in the named JSON string.  Other JSON value types are not supported.
* [json keys *json_val* ?*key* ...?]  - Return the keys in the of the named JSON object, found by following the path of *key*s.
* [json pretty *json_val*]  - Returns a pretty-printed string representation of *json_val*.  Useful for debugging or inspecting the structure of JSON data.
* [json decode *bytes* ?*encoding*?]  - Decode the binary *bytes* into a character string according to the JSON standards.  The optional *encoding* arg can be one of *utf-8*, *utf-16le*, *utf-16be*, *utf-32le*, *utf-32be*.  The encoding is guessed from the BOM (byte order mark) if one is present and *encoding* isn't specified.
* [json valid ?*-extensions* *extensionlist*? ?*-details* *detailsvar*?  *json_val*]  - Return true if *json_val* conforms to the JSON grammar with the extensions in *extensionlist*.  Currently only one extension is supported: *comments*, and is the default.  To reject comments, use *-extensions {}*.  If *-details detailsvar* is supplied and the validation fails, the variable *detailsvar* is set to a dictionary with the keys *errmsg*, *doc* and *char_ofs*.  *errmsg* contains the reason for the failure, *doc* contains the failing json value, and *char_ofs* is the character index into *doc* of the first invalid character.

Paths
-----

The commands [json get], [json extract], [json set], [json unset] and [json exists]
accept a path specification that names some subset of the supplied *json_val*.
The rules are similar to the equivalent concept in the [dict] command, except
that the paths used by [json] allow indexing into JSON arrays by the integer
key (or a string matching the regex "^end(-[0-9]+)?$").  If a path to [json set]
includes a key within an object that doesn't exist, it and all later elements of
the path are created as nested keys into (new) objects.  If a path element into
an array is outside the current bounds of the array, it resolves to a JSON null
(for [json get], [json extract], [json exists]), or appends or prepends null
elements to resolve the path (for [json set], or does nothing ([json unset]).



~~~tcl
json get {
    {
        "foo": [
            { "name": "first" },
            { "name": "second" },
            { "name": "third" }
        }
    }
} foo end-1 name
~~~

Returns "second"

Properly Interpreting JSON from Other Systems
---------------------------------------------

Rl_json operates on characters, not bytes, and so considerations of encoding
are strictly out of scope.  However, interoperating with other systems
properly in a way that conforms to the standards is a bit tricky, and requires
support for encodings Tcl currently doesn't natively support, like utf-32be.
encodings Tcl currently doesn't natively support, like utf-32be.
To ease this burden and take care of things like replacing broken encoding
sequences, the [json decode] subcommand is provided.  Using it in an application
would look something like:

~~~tcl
proc readjson file {
    set h [open $file rb]    ;# Note that the file is opened in binary mode
    try {
        json decode [read $h]
    } finally {
        close $h
    }
}
~~~

If the encoding is known via some out-of-band channel (like headers in an
HTTP response), it can be supplied to override the BOM-based detection.
The supported encodings are those listed in the JSON standards: utf-8 (the
default), utf-16le, utf-16be, utf-32le and utf-32be.

Examples
--------

## Creating a document from a template

Produce a JSON value from a template:
~~~tcl
json template {
    {
        "thing1": "~S:val1",
        "thing2": ["a", "~N:val2", "~S:val2", "~B:val2", "~S:val3", "~L:~S:val1"],
................................................................................
    }
}
~~~
Result:
~~~json
{"thing1":"hello","thing2":["a",1000000.0,"1e6",true,null,"~S:val1"],"subdoc1":{"thing3":"~S:val1"},"subdoc2":{"thing3":"hello"}}
~~~

## Construct a JSON array from a SQL result set

~~~tcl
# Given:
# sqlite> select * from languages;
# 'Tcl',1,'http://core.tcl-lang.org/'
# 'Node.js',1,'https://nodejs.org/'
# 'Python',1,'https://www.python.org/'
# 'INTERCAL',0,'http://www.catb.org/~esr/intercal/'
# 'Unlambda',0,NULL

set langs {[]}
sqlite3 db languages.sqlite3
db eval {
    select
        rowid,
        name,
        active,
        url
    from
        languages
} {
    if {$url eq ""} {unset url}

    json set langs end+1 [json template {
        {
            "id":       "~N:rowid",
            "name":     "~S:name",
            "details": {
                "active":   "~B:active",  // Template values can be nested anywhere
                "url":      "~S:url"      /* Both types of comments are
                                             allowed but stripped at parse-time */
            }
        }
    }]
}

puts [json pretty $langs]
~~~
Result:
~~~json
[
    {
        "id":      1,
        "name":    "Tcl",
        "details": {
            "active": true,
            "url":    "http://core.tcl-lang.org/"
        }
    },
    {
        "id":      2,
        "name":    "Node.js",
        "details": {
            "active": true,
            "url":    "https://nodejs.org/"
        }
    },
    {
        "id":      3,
        "name":    "Python",
        "details": {
            "active": true,
            "url":    "https://www.python.org/"
        }
    },
    {
        "id":      4,
        "name":    "INTERCAL",
        "details": {
            "active": false,
            "url":    "http://www.catb.org/~esr/intercal/"
        }
    },
    {
        "id":      5,
        "name":    "Unlambda",
        "details": {
            "active": false,
            "url":    null
        }
    }
]
~~~

## Performance

Good performance was a requirement for rl_json, because it is used to handle
large volumes of data flowing to and from various JSON based REST apis.  It's
generally the fastest option for working with JSON values in Tcl from the
options I've tried, with the next closest being yajltcl.  These benchmarks
................................................................................
    old_json_parse |  241.595
     rl_json_parse |    5.540
       rl_json_get |    4.950
           yajltcl |    8.800
rl_json_get_native |    0.800
```

### Validating

If the requirement is to validate a JSON value, the [json valid] command is a
light-weight version of the parsing engine that skips allocating values from
the document and only returns whether the parsing succeeded or failed, and
optionally a description of the failure.  It takes about a third of the time
to validate a document as parsing it, so the performance win is substantial.
On a relatively modern CPU validation takes about 11 cycles per byte, or around
200MB of JSON per second on a 2.3 GHz Intel i7.

### Generating

This benchmark compares the relative performance of various ways of
dynamically generating a JSON document.  Although all the methods produce the
same string, only the "template" and "template_dict" variants handle nulls in
the general case - the others manually test for null only for the one field
that is known to be null, so the performance of these variants would be worse
................................................................................
     rl_json_new |   10.240
        template |    4.520
         yajltcl |    7.700
   template_dict |    2.500
    yajltcl_dict |    7.530
```

Deprecations
------------

Version 0.10.0 deprecates various subcommands and features, which will be removed in a near future version:

* [json get_type *json_val* ?*key* ...?]  - Removed
    * lassign [json get_type *json_val* ?*key* ...?] val type  ->  set val [json get *json_val* ?*key* ...?]; set type [json type *json_val* ?*key* ...?]
* [json parse *json_val*]  - A deprecated synonym for [json get *json_val*].
* [json fmt *type* *value*]  - A deprecated synonym for [json new *type* *value*], which is itself deprecated, see below.
* [json new *type* *value*]  - Use direct subcommands of [json]:
    * [json new string *value*] -> [json string *value*]
    * [json new number *value*] -> [json number *value*]
    * [json new boolean *value*] -> [json boolean *value*]
    * [json new true] -> true
    * [json new false] -> false
    * [json new null] -> null
    * [json new json *value*] -> *value*
    * [json new object ...] -> [json object ...]   (but consider [json template])
    * [json new array ...] -> [json array ...]   (but consider [json template])
* modifiers at the end of a path  - Modifiers like [json get *json_val* foo ?type] are deprecated.  Replacements are:
    * ?type  - use [json type *json_val* ?*key* ...?]
    * ?length - use [json length *json_val* ?*key* ...?]
    * ?size - use [json length *json_val* ?*key* ...?]
    * ?keys - use [json keys *json_val* ?*key* ...?]

Under the Hood
--------------

Older versions used the yajl c library to parse the JSON string and properly
quote generated strings when serializing JSON values, but currently a custom
built parser and string quoter is used, removing the libyajl dependency.  JSON
values are parsed to an internal format using Tcl_Objs and stored as the

Changes to jni/rl_json/aclocal.m4.

112
113
114
115
116
117
118
119






























































120
121
122
AC_DEFUN([TEAX_CONFIG_LINK_LINE], [
    AS_IF([test ${TCL_LIB_VERSIONS_OK} = nodots], [
	eval "$1=\"-L[]CygPath($2) -l$3${TCL_TRIM_DOTS}\""
    ], [
	eval "$1=\"-L[]CygPath($2) -l$3${PACKAGE_VERSION}\""
    ])
    AC_SUBST($1)])































































dnl Local Variables:
dnl mode: autoconf
dnl End:








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



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
AC_DEFUN([TEAX_CONFIG_LINK_LINE], [
    AS_IF([test ${TCL_LIB_VERSIONS_OK} = nodots], [
	eval "$1=\"-L[]CygPath($2) -l$3${TCL_TRIM_DOTS}\""
    ], [
	eval "$1=\"-L[]CygPath($2) -l$3${PACKAGE_VERSION}\""
    ])
    AC_SUBST($1)])

#
# Add here whatever m4 macros you want to define for your package
#

AC_DEFUN([ENABLE_ENSEMBLE], [
	#trap 'echo "val: (${enable_ensemble+set}), ensemble_ok: ($ensemble_ok), ensemble: ($ENSEMBLE)"' DEBUG
	AC_MSG_CHECKING([whether to provide the json command as an ensemble])
	AC_ARG_ENABLE(ensemble,
		AC_HELP_STRING([--enable-ensemble], [Provide the json command using a proper ensemble, otherwise handle the subcommand dispatch internally (default: no)]),
		[ensemble_ok=$enableval], [ensemble_ok=no])

	if test "$ensemble_ok" = "yes" -o "${ENSEMBLE}" = 1; then
		ENSEMBLE=1
		AC_MSG_RESULT([yes])
	else
		ENSEMBLE=0
		AC_MSG_RESULT([no])
	fi

	AC_DEFINE_UNQUOTED([ENSEMBLE], [$ENSEMBLE], [Ensemble enabled?])
	#trap '' DEBUG
])


AC_DEFUN([ENABLE_DEDUP], [
	#trap 'echo "val: (${enable_dedup+set}), dedup_ok: ($dedup_ok), DEDUP: ($DEDUP)"' DEBUG
	AC_MSG_CHECKING([whether to use a string deduplication mechanism for short strings])
	AC_ARG_ENABLE(dedup,
		AC_HELP_STRING([--enable-dedup], [Parsing JSON involves allocating a lot of small string Tcl_Objs, many of which are duplicates.  This mechanism helps reduce that duplication (default: yes)]),
		[dedup_ok=$enableval], [dedup_ok=yes])

	if test "$dedup_ok" = "yes" -o "${DEDUP}" = 1; then
		DEDUP=1
		AC_MSG_RESULT([yes])
	else
		DEDUP=0
		AC_MSG_RESULT([no])
	fi

	AC_DEFINE_UNQUOTED([DEDUP], [$DEDUP], [Dedup enabled?])
	#trap '' DEBUG
])


AC_DEFUN([TIP445], [
	AC_MSG_CHECKING([whether we need to polyfill TIP 445])
	saved_CFLAGS="$CFLAGS"
	CFLAGS="$CFLAGS $TCL_INCLUDE_SPEC"
	AC_TRY_COMPILE([#include <tcl.h>], [Tcl_ObjIntRep ir;],
	    have_tcl_objintrep=yes, have_tcl_objintrep=no)
	CFLAGS="$saved_CFLAGS"

	if test "$have_tcl_objintrep" = yes; then
		AC_DEFINE(TIP445_SHIM, 0, [Do we need to polyfill TIP 445?])
		AC_MSG_RESULT([no])
	else
		AC_DEFINE(TIP445_SHIM, 1, [Do we need to polyfill TIP 445?])
		AC_MSG_RESULT([yes])
	fi
])


dnl Local Variables:
dnl mode: autoconf
dnl End:

Added jni/rl_json/bench/as_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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json

namespace import rl_json::json

proc main {} {
bench as_json-1.1 {[json boolean] vs implicit} -setup { #<<<
} -compare {
	explicit {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [json boolean true]
		}
		set doc
	}

	implicit_literal {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 true
		}
		set doc
	}

	implicit_var {
		set doc {[]}
		set v	true
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 $v
		}
		set doc
	}

	implicit_parsed {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [string trim " true"]
		}
		set doc
	}
} -cleanup {
	unset -nocomplain doc i v
} -result {[true,true,true,true,true,true,true,true,true,true]}
#>>>
bench as_json-2.1 {[json number] vs implicit} -setup { #<<<
} -compare {
	explicit {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [json number $i]
		}
		set doc
	}

	implicit_var {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 $i
		}
		set doc
	}

	implicit_parsed {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 " $i"
		}
		set doc
	}
} -cleanup {
	unset -nocomplain doc i
} -result {[0,1,2,3,4,5,6,7,8,9]}
#>>>
bench as_json-2.2 {[json number] vs implicit} -setup { #<<<
} -compare {
	explicit {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [json number 1e$i]
		}
		set doc
	}

	implicit_var {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 1e$i
		}
		set doc
	}
} -cleanup {
	unset -nocomplain doc i
} -match glob -result *
# -result {[1e0,1e1,1e2,1e3,1e4,1e5,1e6,1e7,1e8,1e9]}
# -result {[1.0,10.0,100.0,1000.0,10000.0,100000.0,1000000.0,10000000.0,100000000.0,1000000000.0]}
#>>>
bench as_json-3.2 {[json string] vs implicit} -setup { #<<<
} -compare {
	explicit {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [json string false$i]
		}
		set doc
	}

	implicit_var {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 false$i
		}
		set doc
	}
} -cleanup {
	unset -nocomplain doc i
} -result {["false0","false1","false2","false3","false4","false5","false6","false7","false8","false9"]}

}

main
# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/bench/bench-0.1.tm.

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
...
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
...
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
...
247
248
249
250
251
252
253
254


255
256
257
258


259
260
261
262
263
264
265
...
311
312
313
314
315
316
317





318
319
320
321
322
323
324
325
326
327
328

329

330
331
332
333
334
335
336
...
346
347
348
349
350
351
352
353
354
355

















356
357
358
359
360
361
362
363
364
		close $h
	}
}

#>>>
proc _run_if_set script { #<<<
	if {$script eq ""} return
	uplevel 2 $script
}

#>>>
proc _verify_res {variant retcodes expected match_mode got options} { #<<<
	if {[dict get $options -code] ni $retcodes} {
		bench::output error "Error: $got"
		throw [list BENCH BAD_CODE $variant $retcodes [dict get $options -code]] \
................................................................................
	} val [math::statistics::basic-stats $times] {
		dict set res $stat $val
	}
	dict set res median [math::statistics::median $times]
	dict set res harmonic_mean [/ [llength $times] [+ {*}[lmap time $times {
		/ 1.0 $time
	}]]]

}

#>>>
proc bench {name desc args} { #<<<
	variable match
	variable run
	variable skipped
	variable output






	array set opts {
		-setup			{}
		-compare		{}
		-cleanup		{}
		-batch			100
		-match			exact
		-returnCodes	{ok return}





	}
	array set opts $args
	set badargs [lindex [_intersect3 [array names opts] {
		-setup -compare -cleanup -batch -match -result -returnCodes
	}] 0]

	if {[llength $badargs] > 0} {
		error "Unrecognised arguments: [join $badargs {, }]"
	}

	if {![string match $match $name]} {
................................................................................
			continue	{list 4}
			default		{set e}
		}
	}]

	set make_script {
		{batch script} {
			format {set __bench_i %d; while {[incr __bench_i -1] > 0} %s} \
				[list $batch] [list $script]
		}
	}

	# Measure the instrumentation overhead to compensate for it
	set start		[clock microseconds]	;# Prime [clock microseconds], start var
	set times	{}
	set script	[apply $make_script $opts(-batch) list]
	for {set i 0} {$i < 1000} {incr i} {
		set start [clock microseconds]
		uplevel 1 $script
		lappend times [- [clock microseconds] $start]
	}
	set overhead	[::tcl::mathfunc::min {*}[lmap e $times {expr {$e / double($opts(-batch))}}]]
	#apply $output debug [format {Overhead: %.3f usec} $overhead]


	set variant_stats {}

	_run_if_set $opts(-setup)
	try {
		dict for {variant script} $opts(-compare) {
			set times	{}
			set it		0
			set begin	[clock microseconds]

			if {[info exists opts(-result)]} {
				set start	[clock microseconds]
				catch {uplevel 1 $script} r o
				lappend times	[- [clock microseconds] $start]
				incr it
				_verify_res $variant $normalized_codes $opts(-result) $opts(-match) $r $o
			}


































			set bscript	[apply $make_script $opts(-batch) $script]




			while {[llength $times] < 10 || [- [clock microseconds] $begin] < 500000} {

































				set start [clock microseconds]
				uplevel 1 $bscript

				lappend times [expr {
					([clock microseconds] - $start) / double($opts(-batch)) - $overhead

				}]






			}

			dict set variant_stats $variant [_make_stats $times]




		}

		lappend run $name $desc $variant_stats
	} finally {
		_run_if_set $opts(-cleanup)
	}
}; namespace export bench
................................................................................
				if {![dict exists $stats $variant]} {
					#string cat --
					set _ --
				} else {
					set val		[dict get $stats $variant $pick]
					if {![info exists baseline]} {
						set baseline	$val
						format %.3f $val


					} elseif {$baseline == 0} {
						format x%s inf
					} else {
						format x%.3f [/ $val $baseline]


					}
				}
			}]
		}]

		# Determine the column widths
		set colsize	{}
................................................................................
			upvar 1 i i args args
			set from	$i
			incr i $count
			lrange $args $from [+ $from $count -1]
		} [namespace current] \
	]






	set i	0
	while {$i < [llength $args]} {
		lassign [apply $consume_args 1] next

		switch -- $next {
			-match {
				lassign [apply $consume_args 1] match
			}

			-relative {
				lassign [apply $consume_args 2] label rel_fn

				dict set relative $label [_readfile $rel_fn]

			}

			-save {
				lassign [apply $consume_args 1] save_fn
			}

			-display {
................................................................................
					"Invalid argument: \"$next\""
			}
		}
	}

	set stats	{}
	foreach f [glob -nocomplain -type f -dir $dir -tails *.bench] {
		uplevel 1 [list source [file join $dir $f]]
	}


















	if {[info exists save_fn]} {
		_writefile $save_fn $run
	}

	foreach {name desc variant_stats} $run {
		set relative_stats	{}
		foreach {label relinfo} $relative {
			foreach {relname reldesc relstats} $relinfo {
				if {$relname eq $name} {







|







 







>









>
>
>
>
>




|


>
>
>
>
>



|







 







|



<
<
<
<
<
<
<
<
<
<
<
<
<






|
|
|
<

<
<
<
<



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

|
>

<
>

>
>
>
>
>
>


|
>
>
>
>







 







|
>
>



|
>
>







 







>
>
>
>
>











>
|
>







 







|


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

|







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
...
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
...
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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260

261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
...
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
...
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
...
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
		close $h
	}
}

#>>>
proc _run_if_set script { #<<<
	if {$script eq ""} return
	uplevel 2 [list if 1 $script]
}

#>>>
proc _verify_res {variant retcodes expected match_mode got options} { #<<<
	if {[dict get $options -code] ni $retcodes} {
		bench::output error "Error: $got"
		throw [list BENCH BAD_CODE $variant $retcodes [dict get $options -code]] \
................................................................................
	} val [math::statistics::basic-stats $times] {
		dict set res $stat $val
	}
	dict set res median [math::statistics::median $times]
	dict set res harmonic_mean [/ [llength $times] [+ {*}[lmap time $times {
		/ 1.0 $time
	}]]]
	dict set res cv [expr {[dict get $res population_stddev] / [dict get $res arithmetic_mean]}]
}

#>>>
proc bench {name desc args} { #<<<
	variable match
	variable run
	variable skipped
	variable output

	# -target_cv		- Run until the coefficient of variation is below this, up to -max_time
	# -max_time 		- Maximum number of seconds to keep running while the cv is converging
	# -min_time			- Keep accumulating samples for at least this many seconds
	# -batch			- The number of samples to take in a tight loop and average to count as a single sample.  "auto" guesses a reasonable value to make a batch take at least 1000 usec.
	# -window			- Consider at most the previous -window measurements for target_cv and the results
	array set opts {
		-setup			{}
		-compare		{}
		-cleanup		{}
		-batch			auto
		-match			exact
		-returnCodes	{ok return}
		-target_cv		{0.0015}
		-min_time		0.0
		-max_time		4.0
		-min_it			30
		-window			30
	}
	array set opts $args
	set badargs [lindex [_intersect3 [array names opts] {
		-setup -compare -cleanup -batch -match -result -returnCodes -target_cv -min_time -max_time -min_it -window
	}] 0]

	if {[llength $badargs] > 0} {
		error "Unrecognised arguments: [join $badargs {, }]"
	}

	if {![string match $match $name]} {
................................................................................
			continue	{list 4}
			default		{set e}
		}
	}]

	set make_script {
		{batch script} {
			format {set __bench_i %d; while {[incr __bench_i -1] >= 0} %s} \
				[list $batch] [list $script]
		}
	}














	set variant_stats {}

	_run_if_set $opts(-setup)
	try {
		dict for {variant script} $opts(-compare) {
			set hint	[lindex [time {
				catch {uplevel 1 $script} r o
			}] 0]

			if {[info exists opts(-result)]} {




				_verify_res $variant $normalized_codes $opts(-result) $opts(-match) $r $o
			}

			set single_empty {
				uplevel 1 [list if 1 {}]
			}
			set single_ex_s	{
				uplevel 1 [list if 1 $script]
			}
			if 1 $single_empty	;# throw the first away
			if 1 $single_ex_s	;# throw the first away

			set single_overhead	[lindex [time $single_empty 1000] 0]
			#puts stderr "single overhead: $single_overhead"

			# Verify the first result against -result (if given), and estimate an appropriate batchsize to target a batch time of 1 ms to reduce quantization noise <<<
			set est_it	[expr {
				max(1, int(round(
					100.0/$hint
				)))
			}]
			#puts stderr "hint: $hint, est_it: $est_it"
			set extime	[lindex [time $single_ex_s $est_it] 0]
			set extime_comp	[expr {$extime - $single_overhead}]
			#puts stderr "extime: $extime, extime comp: $extime_comp"
			if {$opts(-batch) eq "auto"} {
				set batch	[expr {int(round(max(1, 1000.0/$extime_comp)))}]
				#puts stderr "Guessed batch size of $batch based on sample execution time $extime_comp usec"
			} else {
				set batch	$opts(-batch)
			}
			#>>>

			# Measure the instrumentation overhead to compensate for it <<<
			set times	{}
			set start	[clock microseconds]	;# Prime [clock microseconds], start var
			set bscript	[apply $make_script $batch {}]
			uplevel 1 [list if 1 $script]
			for {set i 0} {$i < int(100000 / ($batch*0.15))} {incr i} {
				set start [clock microseconds]
				uplevel 1 [list if 1 $bscript]
				lappend times [- [clock microseconds] $start]
			}
			set overhead	[::tcl::mathfunc::min {*}[lmap e $times {expr {$e / double($batch)}}]]
			#apply $output debug [format {Overhead: %.3f usec, mean: %.3f for batch %d} $overhead [expr {double([+ {*}$times]) / ([llength $times]*$batch)}] $batch]
			# Measure the instrumentation overhead to compensate for it >>>

			set cv {data { # Calculate the coefficient of variation of $data <<<
				lassign [::math::statistics::basic-stats $data] \
					arithmetic_mean min max number_of_data sample_stddev sample_var population_stddev population_var

				expr {
					$population_stddev / double($arithmetic_mean)
				}
			}}
			#>>>

			set begin	[clock microseconds]	;# Don't count the first run time or the overhead measurement into the total elapsed time
			set it		0
			set times	{}
			set means	{}
			set cvmeans	{}
			set cvtimes	{}
			set elapsed	0
			set bscript	[apply $make_script $batch $script]
			#puts stderr "bscript $variant: $bscript"
			# Run at least:
			# - -min_it times
			# - for half a second
			# - until the coefficient of variability of the means has fallen below -target_cv, or a max of -max_time seconds
			while {
				[llength $times] < $opts(-min_it) ||
				$elapsed < $opts(-min_time) ||
				($elapsed < $opts(-max_time) && $cvmeans > $opts(-target_cv))
			} {
				set start [clock microseconds]
				uplevel 1 [list if 1 $bscript]
				set batchtime	[- [clock microseconds] $start]
				lappend times [expr {

					$batchtime / double($batch) - $overhead
				}]
				set elapsed		[expr {([clock microseconds] - $begin)/1e6}]
				set cvtimes		[lrange $times end-[+ 1 $opts(-window)] end]	;# Consider the last $opts(-window) data in estimating the variation
				lappend means	[expr {[+ {*}$cvtimes]/[llength $cvtimes]}]
				set _cv			[apply $cv $cvtimes]
				set cvmeans		[apply $cv [lrange $means end-[+ 1 $opts(-window)] end]]
				#puts stderr "Got time for $variant batch($batch), batchtime $batchtime usec: [format %.4f [lindex $times end]], elapsed: [format %.3f $elapsed] sec[if {[info exists cvmeans]} {format {, cvmeans: %.3f} $cvmeans}][if {[info exists _cv]} {format {, cv: %.3f} $_cv}], mean: [format %.5f [lindex $means end]]"
			}

			dict set variant_stats $variant [_make_stats $cvtimes]
			dict set variant_stats $variant cvmeans		$cvmeans
			dict set variant_stats $variant cv			[apply $cv $cvtimes]
			dict set variant_stats $variant runtime		$elapsed
			dict set variant_stats $variant it			[llength $cvtimes]
		}

		lappend run $name $desc $variant_stats
	} finally {
		_run_if_set $opts(-cleanup)
	}
}; namespace export bench
................................................................................
				if {![dict exists $stats $variant]} {
					#string cat --
					set _ --
				} else {
					set val		[dict get $stats $variant $pick]
					if {![info exists baseline]} {
						set baseline	$val
						format {%.3f%s} $val [expr {
							[dict exists $stats $variant cv] ? [format { cv:%.1f%%} [expr {100*[dict get $stats $variant cv]}]] : ""
						}]
					} elseif {$baseline == 0} {
						format x%s inf
					} else {
						format {x%.3f%s} [/ $val $baseline] [expr {
							[dict exists $stats $variant cv] ? [format { cv:%.1f%%} [expr {100*[dict get $stats $variant cv]}]] : ""
						}]
					}
				}
			}]
		}]

		# Determine the column widths
		set colsize	{}
................................................................................
			upvar 1 i i args args
			set from	$i
			incr i $count
			lrange $args $from [+ $from $count -1]
		} [namespace current] \
	]

	# Automatically save and compare with the previous run
	set args [list {*}{
		-relative last last
	} {*}$args]

	set i	0
	while {$i < [llength $args]} {
		lassign [apply $consume_args 1] next

		switch -- $next {
			-match {
				lassign [apply $consume_args 1] match
			}

			-relative {
				lassign [apply $consume_args 2] label rel_fn
				if {[file readable $rel_fn]} {
					dict set relative $label [_readfile $rel_fn]
				}
			}

			-save {
				lassign [apply $consume_args 1] save_fn
			}

			-display {
................................................................................
					"Invalid argument: \"$next\""
			}
		}
	}

	set stats	{}
	foreach f [glob -nocomplain -type f -dir $dir -tails *.bench] {
		uplevel 1 [list if 1 [list source [file join $dir $f]]]
	}

	set save {{save_fn run} {
		set save_data	$run
		if {[file readable $save_fn]} {
			# If the save file already exists, merge this run's data with it
			# rather than replacing it (keeps old tests that weren't executed
			# in this run)
			set newkeys	[lmap {relname - -} $save_data {set relname}]
			set old		[_readfile $save_fn]
			foreach {relname reldesc relstats} $old {
				if {$relname in $newkeys} continue
				lappend save_data $relname $reldesc $relstats
			}
		}
		_writefile $save_fn $save_data
	}}

	apply $save last $run	;# Always save as "last", even if explicitly saving as something else too
	if {[info exists save_fn]} {
		apply $save $save_fn $run
	}

	foreach {name desc variant_stats} $run {
		set relative_stats	{}
		foreach {label relinfo} $relative {
			foreach {relname reldesc relstats} $relinfo {
				if {$relname eq $name} {

Changes to jni/rl_json/bench/new.bench.

5
6
7
8
9
10
11

12
13
14
15
16
17
18
..
56
57
58
59
60
61
62



















63
64
65
66
67
68
69
...
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
...
164
165
166
167
168
169
170
171


172

package require rl_json
package require yajltcl
package require json_old

namespace import rl_json::json


bench new-1.1 {Various ways of dynamically assembling a JSON doc} -setup { #<<<
	array set a {
		x		"str\"foo\nbar"
		y		123
		on		yes
		off		0
		subdoc	{{"inner": "~S:bar"}}
................................................................................
				[expr {[info exists a(not_defined)] ? [list s $a(not_defined)] : [list null]}] \
				[list s "~S:not a subst"] \
				[list o inner [list s $bar]] \
				[list o inner2 [list s $bar]] \
			] \
		]
	}




















	template {
		json template {
			{
				"foo": "~S:bar",
				"baz": [
					"~S:a(x)",
................................................................................

			y get
		} finally {
			y delete
		}
	}

	template_dict {
		json template {
			{
				"foo": "~S:bar",
				"baz": [
					"~S:a(x)",
					"~N:a(y)",
					123.4,
					"~B:a(on)",
................................................................................
			y delete
		}
	}
} -cleanup {
	unset -nocomplain a d
} -result {{"foo":"Bar","baz":["str\"foo\nbar",123,123.4,true,false,null,"~S:not a subst",{"inner":"Bar"},{"inner2":"Bar"}]}}
#>>>



# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4







>







 







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







 







|
|







 







|
>
>

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
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
...
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
...
184
185
186
187
188
189
190
191
192
193
194

package require rl_json
package require yajltcl
package require json_old

namespace import rl_json::json

proc main {} {
bench new-1.1 {Various ways of dynamically assembling a JSON doc} -setup { #<<<
	array set a {
		x		"str\"foo\nbar"
		y		123
		on		yes
		off		0
		subdoc	{{"inner": "~S:bar"}}
................................................................................
				[expr {[info exists a(not_defined)] ? [list s $a(not_defined)] : [list null]}] \
				[list s "~S:not a subst"] \
				[list o inner [list s $bar]] \
				[list o inner2 [list s $bar]] \
			] \
		]
	}

	template_string {
		json template_string {
			{
				"foo": "~S:bar",
				"baz": [
					"~S:a(x)",
					"~N:a(y)",
					123.4,
					"~B:a(on)",
					"~B:a(off)",
					"~S:a(not_defined)",
					"~L:~S:not a subst",
					"~T:a(subdoc)",
					"~T:a(subdoc2)"
				]
			}
		}
	}

	template {
		json template {
			{
				"foo": "~S:bar",
				"baz": [
					"~S:a(x)",
................................................................................

			y get
		} finally {
			y delete
		}
	}

	template_string_dict {
		json template_string {
			{
				"foo": "~S:bar",
				"baz": [
					"~S:a(x)",
					"~N:a(y)",
					123.4,
					"~B:a(on)",
................................................................................
			y delete
		}
	}
} -cleanup {
	unset -nocomplain a d
} -result {{"foo":"Bar","baz":["str\"foo\nbar",123,123.4,true,false,null,"~S:not a subst",{"inner":"Bar"},{"inner2":"Bar"}]}}
#>>>
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/bench/normalize.bench.

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
..
19
20
21
22
23
24
25
26


27
if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json
package require yajltcl

namespace import rl_json::json


bench normalize-1.1 {Normalize a JSON doc} -setup { #<<<
	set json {
		{
			"foo": "bar",
			"baz": ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	}
................................................................................
	ours {
		json normalize [string trim $json]
	}
} -cleanup {
	unset -nocomplain json
} -result {{"foo":"bar","baz":["str",123,123.4,true,false,null,{"inner":"obj"}]}}
#>>>



# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4






|



>







 







|
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
..
20
21
22
23
24
25
26
27
28
29
30
if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json
#package require yajltcl

namespace import rl_json::json

proc main {} {
bench normalize-1.1 {Normalize a JSON doc} -setup { #<<<
	set json {
		{
			"foo": "bar",
			"baz": ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	}
................................................................................
	ours {
		json normalize [string trim $json]
	}
} -cleanup {
	unset -nocomplain json
} -result {{"foo":"bar","baz":["str",123,123.4,true,false,null,{"inner":"obj"}]}}
#>>>
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/bench/parse.bench.

16
17
18
19
20
21
22

23
24
25
26
27
28
29
..
60
61
62
63
64
65
66








67
68
69
70
71
72
73
..
98
99
100
101
102
103
104
105
106
107
108




109
110
111
112
113
114
115


116
		read $h
	} finally {
		close $h
	}
}
#>>>


bench parse-1.1 {Parse a small JSON doc and extract a field} -setup { #<<<
	set json {
		{
			"foo": "bar",
			"baz": ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	}
................................................................................
bench parse-2.1 {Parse a few MB of json} -batch 3 -setup { #<<<
	set json [readfile [file join [file dirname [file normalize [info script]]] items1.json]]
} -compare {
	just_parse {
		json normalize $json
		list 83000 5434
	}








	ours {
		set c	0
		set nrpics	0
		set p	[string trim $json]
		json foreach hit [json extract $p hits hits] {
			if {[json exists $hit _source shopstatus]} {
				json get $hit _source shopstatus
................................................................................
}
if {[file readable [file join [file dirname [file normalize [info script]]] sample.json]]} {
bench parse-3.1 {Parse a large json doc with deep nesting and many UTF-8 chars} -batch 3 -setup { #<<<
	# Sample from the json-test-suite project: https://code.google.com/p/json-test-suite/downloads/detail?name=sample.zip
	set json [readfile [file join [file dirname [file normalize [info script]]] sample.json]]
} -compare {
	ours {
		json get [string trim $json] ?keys
	}
	yajltcl {
		dict keys [yajl::json2dict [string trim $json]]




	}
} -cleanup {
	unset -nocomplain json
} -result {a key z}
#>>>
}



# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4







>







 







>
>
>
>
>
>
>
>







 







|


|
>
>
>
>



|


|
>
>

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
..
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
...
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
		read $h
	} finally {
		close $h
	}
}
#>>>

proc main {} {
bench parse-1.1 {Parse a small JSON doc and extract a field} -setup { #<<<
	set json {
		{
			"foo": "bar",
			"baz": ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	}
................................................................................
bench parse-2.1 {Parse a few MB of json} -batch 3 -setup { #<<<
	set json [readfile [file join [file dirname [file normalize [info script]]] items1.json]]
} -compare {
	just_parse {
		json normalize $json
		list 83000 5434
	}
	valid {
		json valid $json
		list 83000 5434
	}
	valid_no_comments {
		json valid -extensions {} $json
		list 83000 5434
	}
	ours {
		set c	0
		set nrpics	0
		set p	[string trim $json]
		json foreach hit [json extract $p hits hits] {
			if {[json exists $hit _source shopstatus]} {
				json get $hit _source shopstatus
................................................................................
}
if {[file readable [file join [file dirname [file normalize [info script]]] sample.json]]} {
bench parse-3.1 {Parse a large json doc with deep nesting and many UTF-8 chars} -batch 3 -setup { #<<<
	# Sample from the json-test-suite project: https://code.google.com/p/json-test-suite/downloads/detail?name=sample.zip
	set json [readfile [file join [file dirname [file normalize [info script]]] sample.json]]
} -compare {
	ours {
		json length [string trim $json]
	}
	yajltcl {
		dict size [yajl::json2dict [string trim $json]]
	}
	valid {
		json valid $json
		return -level 0 3
	}
} -cleanup {
	unset -nocomplain json
} -result 3
#>>>
}
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Added jni/rl_json/bench/piecewise_template.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
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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json

namespace import rl_json::json

proc main {} {
bench piecewise_template-1.1 {Templated document creation in multiple steps} -setup { #<<<
	set tmpl {
		{
			"foo": "~S:foo",
			"bar": "~S:a(bar)",
			"baz": "~N:baz",
			"recurse": "~J:last"
		}
	}
	set foo	Foo
	array set a {
		foo		X
		bar		Bar
	}
} -compare {
	serialize {
		unset -nocomplain last
		for {set i 0} {$i < 6} {incr i} {
			set last	[json template_string $tmpl]
		}
		set last
	}
	direct {
		unset -nocomplain last
		for {set i 0} {$i < 6} {incr i} {
			set last	[json template $tmpl]
		}
		set last
	}
} -cleanup {
	unset -nocomplain tmpl a foo i last
} -result [json normalize {
	{
		"foo": "Foo",
		"bar": "Bar",
		"baz": null,
		"recurse": {
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": {
				"foo": "Foo",
				"bar": "Bar",
				"baz": null,
				"recurse": {
					"foo": "Foo",
					"bar": "Bar",
					"baz": null,
					"recurse": {
						"foo": "Foo",
						"bar": "Bar",
						"baz": null,
						"recurse": {
							"foo": "Foo",
							"bar": "Bar",
							"baz": null,
							"recurse": null
						}
					}
				}
			}
		}
	}
}]
#>>>
bench piecewise_template-1.2 {Templated document creation in a loop} -setup { #<<<
	set tmpl {
		{
			"foo": "~S:foo",
			"bar": "~S:a(bar)",
			"baz": "~N:baz",
			"recurse": "~J:last"
		}
	}
	set foo	Foo
	array set a {
		foo		X
		bar		Bar
	}
} -compare {
	serialize {
		set res {[]}
		for {set i 0} {$i < 20} {incr i} {
			json set res end+1 [json template_string $tmpl]
		}
		set res
	}
	direct {
		set res {[]}
		for {set i 0} {$i < 20} {incr i} {
			json set res end+1 [json template $tmpl]
		}
		set res
	}
} -cleanup {
	unset -nocomplain tmpl a foo i last res
} -result [json normalize {
	[
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		}
	]
}]
#>>>
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/bench/run.tcl.

1
2



3
4
5
6
7
8
9
..
17
18
19
20
21
22
23

24
25



26







































































































































































27



28
29
30





31
32



33
#!/usr/bin/env cfkit8.6
# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4




if {[file system [info script]] eq "native"} {
	package require platform

	foreach platform [platform::patterns [platform::identify]] {
		set tm_path		[file join $env(HOME) .tbuild repo tm $platform]
		set pkg_path	[file join $env(HOME) .tbuild repo pkg $platform]
................................................................................
}

set here	[file dirname [file normalize [info script]]]
set parent	[file dirname $here]
tcl::tm::path add $here
lappend auto_path $parent


package require bench




try {







































































































































































	bench::run_benchmarks $here {*}$argv



} trap {BENCH INVALID_ARG} {errmsg options} {
	puts stderr $errmsg
	exit 1





}




# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4


>
>
>







 







>


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

1
2
3
4
5
6
7
8
9
10
11
12
..
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
209
210
211
212
213
214
215
216
217
218
#!/usr/bin/env cfkit8.6
# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

set big	[string repeat a [expr {int(1e8)}]]	;# Allocate 100MB to pre-expand the zippy pool
unset big

if {[file system [info script]] eq "native"} {
	package require platform

	foreach platform [platform::patterns [platform::identify]] {
		set tm_path		[file join $env(HOME) .tbuild repo tm $platform]
		set pkg_path	[file join $env(HOME) .tbuild repo pkg $platform]
................................................................................
}

set here	[file dirname [file normalize [info script]]]
set parent	[file dirname $here]
tcl::tm::path add $here
lappend auto_path $parent

package require platform
package require bench

proc with_chan {var create use} {
	upvar 1 $var h
	set h	[uplevel 1 [list if 1 $create]]
	try {
		uplevel 1 [list if 1 $use]
	} on return {r o} - on break {r o} - on continue {r o} {
		dict incr o -level 1
		return -options $o $r
	} finally {
		if {[info exists h] && $h in [chan names]} {
			catch {close $h}
		}
	}
}

proc readtext fn { with_chan h {open $fn r} {read $h} }


proc benchmark_mode script {
	set restore_state_actions	{}

	with_chan root {open |[list sudo [info nameofexecutable]] rb+} {
		chan configure $root -encoding binary -translation binary
		proc sudo args {
			upvar 1 root root
			puts $root [encoding convertto utf-8 [string map [list %script% [list $args]] {
				catch %script% r o
				set resp [encoding convertto utf-8 [list $r $o]]
				puts -nonewline [string length $resp]\n$resp
				flush stdout
			}]]
			flush $root
			set bytes	[gets $root]
			if {$bytes eq ""} {
				if {[eof $root]} {
					puts stderr "Root child died"
					close $root
					unset root
					return
				}
			}
			if {![string is integer -strict $bytes]} {
				error "Root child sync error"
			}
			lassign [encoding convertfrom utf-8 [read $root $bytes]] r o
			return -options $o $r
		}
		sudo eval {
			#chan configure stdin -buffering none -encoding utf-8
			chan configure stdout -buffering none -encoding binary -translation binary

			proc with_chan {var create use} {
				upvar 1 $var h
				set h	[uplevel 1 [list if 1 $create]]
				try {
					uplevel 1 [list if 1 $use]
				} on return {r o} - on break {r o} - on continue {r o} {
					dict incr o -level 1
					return -options $o $r
				} finally {
					if {[info exists h] && $h in [chan names]} {
						close $h
					}
				}
			}

			proc readtext fn          { with_chan h {open $fn r} {read $h} }
			proc writetext {fn value} { with_chan h {open $fn w} {puts -nonewline $h $value} }

			proc set_turbo state {
				if {$state} {
					set mode "turbo enable\nquit"
				} else {
					set mode "turbo disable\nquit"
				}
				#with_chan h {open |[list i7z_rw_registers 2>@ stderr] w} {
				#	chan configure $h -buffering none -encoding binary -translation binary -blocking 1
				#	puts $h $mode
				#}
				set res	[exec echo $mode | i7z_rw_registers]
				if {[regexp {Turbo is now (Enabled|Disabled)} $res - newstate]} {
					set newstate
				} else {
					set res
				}
			}

			proc get_turbo {} {
				expr {
					![exec rdmsr 0x1a0 --bitfield 38:38]
				}
			}
		}

		try {
			switch -glob -- [platform::generic] {
				linux-* {
					# Disable turbo boost <<<
					#lappend restore_state_actions	[list sudo set_turbo 1]
					lappend restore_state_actions	[list sudo set_turbo [sudo get_turbo]]
					sudo set_turbo off
					# Disable turbo boost >>>

					# Disable frequency scaling <<<
					foreach governor [glob -nocomplain -type f /sys/devices/system/cpu/cpu*/cpufreq/scaling_governor] {
						lappend restore_state_actions [list sudo writetext $governor [string trim [readtext $governor]]]
						#lappend restore_state_actions [list sudo writetext $governor powersave]
						sudo writetext $governor performance
					}
					# Disable frequency scaling >>>

					# Set highest scheduling priority
					lappend restore_state_actions	[list sudo exec renice --priority [exec nice] [pid]]
					sudo exec renice --priority -20 [pid]


					# Disable hyperthreading (effectively by disabling sibling cores, preventing the kernel from scheduling tasks for them)
					set siblings	{}
					foreach core [glob -nocomplain -type d -directory /sys/devices/system/cpu -tails cpu*] {
						if {![regexp {^cpu[0-9]+$} $core]} continue
						if {[file readable /sys/devices/system/cpu/$core/online]} {
							lappend restore_state_actions [list sudo writetext /sys/devices/system/cpu/$core/online [string trim [readtext /sys/devices/system/cpu/$core/online]]]
							#lappend restore_state_actions [list sudo writetext /sys/devices/system/cpu/$core/online 1]
						}
						set sibs	[readtext /sys/devices/system/cpu/$core/topology/thread_siblings_list]
						dict lappend siblings $sibs $core
					}
					dict for {group cores} $siblings {
						set keep	[lmap core $cores {
							if {[file readable /sys/devices/system/cpu/$core/online]} continue
							set core
						}]
						if {$keep eq {}} {
							set keep	[list [lindex $cores 0]]
						}
						foreach core $cores {
							if {$core in $keep} continue
							sudo writetext /sys/devices/system/cpu/$core/online 0
						}
					}
				}

				default {
					puts stderr "Don't know the magic to set [platform::generic] up for repeatable benchmarking"
				}
			}

			uplevel 1 [list if 1 $script]
		} finally {
			foreach action [lreverse $restore_state_actions] {
				#puts stderr "Running restore action:\t$action"
				set errors 0
				try $action on error {errmsg options} {
					puts stderr "Error processing restore action \"$action\": [dict get $options -errorinfo]"
					set errors	1
				}
				if {$errors} {
					throw exit 2
				}
			}
		}
		close $root write
		read $root
	}
}

proc main {} {
	try {
		set here	[file dirname [file normalize [info script]]]
		benchmark_mode {
			puts "[string repeat - 80]\nStarting benchmarks\n"
			bench::run_benchmarks $here {*}$::argv
		}
	} on ok {} {
		exit 0
	} trap {BENCH INVALID_ARG} {errmsg options} {
		puts stderr $errmsg
		exit 1
	} trap exit code {
		exit $code
	} on error {errmsg options} {
		puts stderr "Unhandled error from benchmark_mode: [dict get $options -errorinfo]"
		exit 2
	}
}

main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/bench/template.bench.

3
4
5
6
7
8
9

10
11
12
13
14
15
16
..
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
	namespace import bench::*
}

package require rl_json

namespace import rl_json::json


bench template-1.1 {Basic templated document creation} -setup { #<<<
	set tmpl {
		{
			"foo": "~S:foo",
			"bar": "~S:a(bar)",
			"baz": "~N:baz"
		}
................................................................................
	set foo	Foo
	array set a {
		foo		X
		bar		Bar
	}
} -compare {
	dict {
		json template $tmpl {
			foo		Foo
			a(bar)	Bar
		}
	}

	dict_lit {
		json template {
			{
				"foo": "~S:foo",
				"bar": "~S:a(bar)",
				"baz": "~N:baz"
			}
		} {
			foo		Foo
			a(bar)	Bar
		}
	}

	variables {
























		json template $tmpl
	}
} -cleanup {
	unset -nocomplain tmpl a foo
} -result [json normalize {
	{
		"foo": "Foo",
		"bar": "Bar",
		"baz": null
	}
}]
#>>>










































































































































































# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4







>







 







|






|












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












>
>
>
>
>
>
>

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

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
	namespace import bench::*
}

package require rl_json

namespace import rl_json::json

proc main {} {
bench template-1.1 {Basic templated document creation} -setup { #<<<
	set tmpl {
		{
			"foo": "~S:foo",
			"bar": "~S:a(bar)",
			"baz": "~N:baz"
		}
................................................................................
	set foo	Foo
	array set a {
		foo		X
		bar		Bar
	}
} -compare {
	dict {
		json template_string $tmpl {
			foo		Foo
			a(bar)	Bar
		}
	}

	dict_lit {
		json template_string {
			{
				"foo": "~S:foo",
				"bar": "~S:a(bar)",
				"baz": "~N:baz"
			}
		} {
			foo		Foo
			a(bar)	Bar
		}
	}

	variables {
		json template_string $tmpl
	}

	dict_direct {
		json template $tmpl {
			foo		Foo
			a(bar)	Bar
		}
	}

	dict_lit_direct {
		json template {
			{
				"foo": "~S:foo",
				"bar": "~S:a(bar)",
				"baz": "~N:baz"
			}
		} {
			foo		Foo
			a(bar)	Bar
		}
	}

	variables_direct {
		json template $tmpl
	}
} -cleanup {
	unset -nocomplain tmpl a foo
} -result [json normalize {
	{
		"foo": "Foo",
		"bar": "Bar",
		"baz": null
	}
}]
#>>>
bench template-2.1 {Test templated doc creation, including numbers} -setup { #<<<
	set foo		1
	set bar		42.5
	set baz		1e6
	set quux	0x42
	set octal	077
	set space	" 42"

	set d {
		foo		1
		bar		42.5
		baz		1e6
		quux	0x42
		octal	077
		space	" 42"
	}
} -compare {
	template_string {
		json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		}
	}

	template_string_dict {
		json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		} $d
	}

	template {
		json template {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		}
	}

	template_dict {
		json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		} $d
	}
} -cleanup {
	unset -nocomplain foo bar baz d
} -result [json normalize {
	{
		"foo":		1,
		"bar":		42.5,
		//"baz":		1e6,
		"quux":		66,
		"octal":	63,
		"space":	42
	}
}]
#>>>
bench template-3.1 {Test templated doc creation, including numbers, json set on result} -setup { #<<<
	set foo		1
	set bar		42.5
	set baz		1e6
	set quux	0x42
	set octal	077
	set space	" 42"

	set d {
		foo		1
		bar		42.5
		baz		1e6
		quux	0x42
		octal	077
		space	" 42"
	}
} -compare {
	template_string {
		set j	[json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		}]
		json set j new null
	}

	template_string_dict {
		set j	[json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		} $d]
		json set j new null
	}

	template {
		set j [json template {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		}]
		json set j new null
	}

	template_dict {
		set j [json template {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		} $d]
		json set j new null
	}
} -cleanup {
	unset -nocomplain foo bar baz d
} -result [json normalize {
	{
		"foo":		1,
		"bar":		42.5,
		//"baz":		1e6,
		"quux":		66,
		"octal":	63,
		"space":	42,
		"new":		null
	}
}]
#>>>
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/configure.

1
2
3
4
5
6
7
8
9
10
...
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
...
749
750
751
752
753
754
755


756
757
758
759
760
761
762
....
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
....
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396







1397
1398
1399
1400
1401
1402
1403
....
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
....
7600
7601
7602
7603
7604
7605
7606




























































7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
....
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
....
7735
7736
7737
7738
7739
7740
7741
7742
7743
7744
7745
7746
7747
7748
7749
.....
11834
11835
11836
11837
11838
11839
11840





































































11841
11842
11843
11844
11845
11846
11847
.....
12723
12724
12725
12726
12727
12728
12729
12730
12731
12732
12733
12734
12735
12736
12737
.....
12773
12774
12775
12776
12777
12778
12779
12780
12781
12782
12783
12784
12785
12786
12787
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.63 for rl_json 0.9.13.
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization.  ##
................................................................................
MFLAGS=
MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}

# Identity of this package.
PACKAGE_NAME='rl_json'
PACKAGE_TARNAME='rl_json'
PACKAGE_VERSION='0.9.13'
PACKAGE_STRING='rl_json 0.9.13'
PACKAGE_BUGREPORT=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
................................................................................
PACKAGE_NAME
PATH_SEPARATOR
SHELL'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_tcl


with_tclinclude
enable_threads
enable_shared
enable_64bit
enable_64bit_vis
enable_rpath
enable_wince
................................................................................
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures rl_json 0.9.13 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
................................................................................

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of rl_json 0.9.13:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]







  --enable-threads        build with threads
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (default: off)
  --enable-64bit-vis      enable 64bit Sparc VIS support (default: off)
  --disable-rpath         disable rpath support (default: on)
  --enable-wince          enable Win/CE support (where applicable)
  --enable-symbols        build with debugging symbols (default: off)
................................................................................
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
rl_json configure 0.9.13
generated by GNU Autoconf 2.63

Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
fi
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by rl_json $as_me 0.9.13, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
................................................................................

	# Let the user call this, because if it triggers, they will
	# need a compat/strtod.c that is correct.  Users can also
	# use Tcl_GetDouble(FromObj) instead.
	#TEA_BUGGY_STRTOD
    fi






























































#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------


    vars="parser.c rl_json.c rl_jsonStubInit.c"
    for i in $vars; do
	case $i in
	    \$*)
		# allow $-var names
		PKG_SOURCES="$PKG_SOURCES $i"
		PKG_OBJECTS="$PKG_OBJECTS $i"
		;;
................................................................................
		;;
	esac
    done




    vars="generic/rl_jsonDecls.h"
    for i in $vars; do
	# check for existence, be strict because it is installed
	if test ! -f "${srcdir}/$i" ; then
	    { { $as_echo "$as_me:$LINENO: error: could not find header file '${srcdir}/$i'" >&5
$as_echo "$as_me: error: could not find header file '${srcdir}/$i'" >&2;}
   { (exit 1); exit 1; }; }
	fi
................................................................................
# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
#
# A few miscellaneous platform-specific items:
# TEA_ADD_* any platform specific compiler/build info here.
#--------------------------------------------------------------------

#CLEANFILES="$CLEANFILES pkgIndex.tcl"
if test "${TEA_PLATFORM}" = "windows" ; then
    # Ensure no empty if clauses
    :
    #TEA_ADD_SOURCES([win/winFile.c])
    #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
else
    # Ensure no empty else clauses
................................................................................
	else
	    { $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	fi
    fi








































































#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols option.
#--------------------------------------------------------------------



................................................................................

exec 6>&1

# Save the log message, to keep $[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by rl_json $as_me 0.9.13, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@
................................................................................
$config_files

Report bugs to <bug-autoconf@gnu.org>."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
rl_json config.status 0.9.13
configured by $0, generated by GNU Autoconf 2.63,
  with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2008 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."



|







 







|
|







 







>
>







 







|







 







|







>
>
>
>
>
>
>







 







|













|







 







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












|







 







|







 







|







 







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







 







|







 







|







1
2
3
4
5
6
7
8
9
10
...
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
...
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
....
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
....
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
....
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
....
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
7629
7630
7631
7632
7633
7634
7635
7636
7637
7638
7639
7640
7641
7642
7643
7644
7645
7646
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
7687
7688
7689
7690
7691
7692
7693
7694
7695
....
7718
7719
7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
7730
7731
7732
....
7804
7805
7806
7807
7808
7809
7810
7811
7812
7813
7814
7815
7816
7817
7818
.....
11903
11904
11905
11906
11907
11908
11909
11910
11911
11912
11913
11914
11915
11916
11917
11918
11919
11920
11921
11922
11923
11924
11925
11926
11927
11928
11929
11930
11931
11932
11933
11934
11935
11936
11937
11938
11939
11940
11941
11942
11943
11944
11945
11946
11947
11948
11949
11950
11951
11952
11953
11954
11955
11956
11957
11958
11959
11960
11961
11962
11963
11964
11965
11966
11967
11968
11969
11970
11971
11972
11973
11974
11975
11976
11977
11978
11979
11980
11981
11982
11983
11984
11985
.....
12861
12862
12863
12864
12865
12866
12867
12868
12869
12870
12871
12872
12873
12874
12875
.....
12911
12912
12913
12914
12915
12916
12917
12918
12919
12920
12921
12922
12923
12924
12925
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.63 for rl_json 0.11.0.
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization.  ##
................................................................................
MFLAGS=
MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}

# Identity of this package.
PACKAGE_NAME='rl_json'
PACKAGE_TARNAME='rl_json'
PACKAGE_VERSION='0.11.0'
PACKAGE_STRING='rl_json 0.11.0'
PACKAGE_BUGREPORT=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
................................................................................
PACKAGE_NAME
PATH_SEPARATOR
SHELL'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_tcl
enable_ensemble
enable_dedup
with_tclinclude
enable_threads
enable_shared
enable_64bit
enable_64bit_vis
enable_rpath
enable_wince
................................................................................
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures rl_json 0.11.0 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
................................................................................

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of rl_json 0.11.0:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-ensemble       Provide the json command using a proper ensemble,
                          otherwise handle the subcommand dispatch internally
                          (default: no)
  --enable-dedup          Parsing JSON involves allocating a lot of small
                          string Tcl_Objs, many of which are duplicates. This
                          mechanism helps reduce that duplication (default:
                          yes)
  --enable-threads        build with threads
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (default: off)
  --enable-64bit-vis      enable 64bit Sparc VIS support (default: off)
  --disable-rpath         disable rpath support (default: on)
  --enable-wince          enable Win/CE support (where applicable)
  --enable-symbols        build with debugging symbols (default: off)
................................................................................
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
rl_json configure 0.11.0
generated by GNU Autoconf 2.63

Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
fi
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by rl_json $as_me 0.11.0, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
................................................................................

	# Let the user call this, because if it triggers, they will
	# need a compat/strtod.c that is correct.  Users can also
	# use Tcl_GetDouble(FromObj) instead.
	#TEA_BUGGY_STRTOD
    fi


# Check for feature toggles

	#trap 'echo "val: (${enable_ensemble+set}), ensemble_ok: ($ensemble_ok), ensemble: ($ENSEMBLE)"' DEBUG
	{ $as_echo "$as_me:$LINENO: checking whether to provide the json command as an ensemble" >&5
$as_echo_n "checking whether to provide the json command as an ensemble... " >&6; }
	# Check whether --enable-ensemble was given.
if test "${enable_ensemble+set}" = set; then
  enableval=$enable_ensemble; ensemble_ok=$enableval
else
  ensemble_ok=no
fi


	if test "$ensemble_ok" = "yes" -o "${ENSEMBLE}" = 1; then
		ENSEMBLE=1
		{ $as_echo "$as_me:$LINENO: result: yes" >&5
$as_echo "yes" >&6; }
	else
		ENSEMBLE=0
		{ $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	fi


cat >>confdefs.h <<_ACEOF
#define ENSEMBLE $ENSEMBLE
_ACEOF

	#trap '' DEBUG


	#trap 'echo "val: (${enable_dedup+set}), dedup_ok: ($dedup_ok), DEDUP: ($DEDUP)"' DEBUG
	{ $as_echo "$as_me:$LINENO: checking whether to use a string deduplication mechanism for short strings" >&5
$as_echo_n "checking whether to use a string deduplication mechanism for short strings... " >&6; }
	# Check whether --enable-dedup was given.
if test "${enable_dedup+set}" = set; then
  enableval=$enable_dedup; dedup_ok=$enableval
else
  dedup_ok=yes
fi


	if test "$dedup_ok" = "yes" -o "${DEDUP}" = 1; then
		DEDUP=1
		{ $as_echo "$as_me:$LINENO: result: yes" >&5
$as_echo "yes" >&6; }
	else
		DEDUP=0
		{ $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	fi


cat >>confdefs.h <<_ACEOF
#define DEDUP $DEDUP
_ACEOF

	#trap '' DEBUG


#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------


    vars="parser.c rl_json.c json_types.c dedup.c api.c rl_jsonStubInit.c"
    for i in $vars; do
	case $i in
	    \$*)
		# allow $-var names
		PKG_SOURCES="$PKG_SOURCES $i"
		PKG_OBJECTS="$PKG_OBJECTS $i"
		;;
................................................................................
		;;
	esac
    done




    vars="generic/rl_jsonDecls.h generic/rl_json.h"
    for i in $vars; do
	# check for existence, be strict because it is installed
	if test ! -f "${srcdir}/$i" ; then
	    { { $as_echo "$as_me:$LINENO: error: could not find header file '${srcdir}/$i'" >&5
$as_echo "$as_me: error: could not find header file '${srcdir}/$i'" >&2;}
   { (exit 1); exit 1; }; }
	fi
................................................................................
# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
#
# A few miscellaneous platform-specific items:
# TEA_ADD_* any platform specific compiler/build info here.
#--------------------------------------------------------------------

#CLEANFILES="$CLEANFILES pkgIndex.tcl doc/json.html"
if test "${TEA_PLATFORM}" = "windows" ; then
    # Ensure no empty if clauses
    :
    #TEA_ADD_SOURCES([win/winFile.c])
    #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
else
    # Ensure no empty else clauses
................................................................................
	else
	    { $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	fi
    fi



# Check for required polyfill

	{ $as_echo "$as_me:$LINENO: checking whether we need to polyfill TIP 445" >&5
$as_echo_n "checking whether we need to polyfill TIP 445... " >&6; }
	saved_CFLAGS="$CFLAGS"
	CFLAGS="$CFLAGS $TCL_INCLUDE_SPEC"
	cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <tcl.h>
int
main ()
{
Tcl_ObjIntRep ir;
  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (ac_try="$ac_compile"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
  (eval "$ac_compile") 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest.$ac_objext; then
  have_tcl_objintrep=yes
else
  $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	have_tcl_objintrep=no
fi

rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	CFLAGS="$saved_CFLAGS"

	if test "$have_tcl_objintrep" = yes; then

cat >>confdefs.h <<\_ACEOF
#define TIP445_SHIM 0
_ACEOF

		{ $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	else

cat >>confdefs.h <<\_ACEOF
#define TIP445_SHIM 1
_ACEOF

		{ $as_echo "$as_me:$LINENO: result: yes" >&5
$as_echo "yes" >&6; }
	fi


#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols option.
#--------------------------------------------------------------------



................................................................................

exec 6>&1

# Save the log message, to keep $[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by rl_json $as_me 0.11.0, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@
................................................................................
$config_files

Report bugs to <bug-autoconf@gnu.org>."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
rl_json config.status 0.11.0
configured by $0, generated by GNU Autoconf 2.63,
  with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2008 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

Changes to jni/rl_json/configure.ac.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
..
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
..
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
...
138
139
140
141
142
143
144



145
146
147
148
149
150
151
#!/bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.

#-----------------------------------------------------------------------
# Sample configure.in for Tcl Extensions.  The only places you should
# need to modify this file are marked by the string __CHANGE__
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# __CHANGE__
# Set your package name and version numbers here.
#
................................................................................
# set as provided.  These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
# This will also define a special symbol for Windows (BUILD_<PACKAGE_NAME>
# so that we create the export library with the dll.
#-----------------------------------------------------------------------

AC_PREREQ(2.61)
AC_INIT([rl_json], [0.9.13])

#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------

................................................................................
# Standard compiler checks.
# This sets up CC by using the CC env var, or looks for gcc otherwise.
# This also calls AC_PROG_CC and a few others to create the basic setup
# necessary to compile executables.
#-----------------------------------------------------------------------

TEA_SETUP_COMPILER





#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

TEA_ADD_SOURCES([parser.c rl_json.c rl_jsonStubInit.c])
TEA_ADD_HEADERS([generic/rl_jsonDecls.h])
TEA_ADD_INCLUDES([])
TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
TEA_ADD_STUB_SOURCES([rl_jsonStubLib.c])
TEA_ADD_TCL_SOURCES([])

#--------------------------------------------------------------------
................................................................................
# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
#
# A few miscellaneous platform-specific items:
# TEA_ADD_* any platform specific compiler/build info here.
#--------------------------------------------------------------------

#CLEANFILES="$CLEANFILES pkgIndex.tcl"
if test "${TEA_PLATFORM}" = "windows" ; then
    # Ensure no empty if clauses
    :
    #TEA_ADD_SOURCES([win/winFile.c])
    #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
else
    # Ensure no empty else clauses
................................................................................
#--------------------------------------------------------------------
# This macro figures out what flags to use with the compiler/linker
# when building shared/static debug/optimized objects.  This information
# can be taken from the tclConfig.sh file, but this figures it all out.
#--------------------------------------------------------------------

TEA_CONFIG_CFLAGS




#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols option.
#--------------------------------------------------------------------

TEA_ENABLE_SYMBOLS







|







 







|







 







>
>
>
>











|
|







 







|







 







>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
..
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
..
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
...
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
#!/bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.

#-----------------------------------------------------------------------
# Sample configure.ac for Tcl Extensions.  The only places you should
# need to modify this file are marked by the string __CHANGE__
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# __CHANGE__
# Set your package name and version numbers here.
#
................................................................................
# set as provided.  These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
# This will also define a special symbol for Windows (BUILD_<PACKAGE_NAME>
# so that we create the export library with the dll.
#-----------------------------------------------------------------------

AC_PREREQ(2.61)
AC_INIT([rl_json], [0.11.0])

#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------

................................................................................
# Standard compiler checks.
# This sets up CC by using the CC env var, or looks for gcc otherwise.
# This also calls AC_PROG_CC and a few others to create the basic setup
# necessary to compile executables.
#-----------------------------------------------------------------------

TEA_SETUP_COMPILER

# Check for feature toggles
ENABLE_ENSEMBLE
ENABLE_DEDUP

#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

TEA_ADD_SOURCES([parser.c rl_json.c json_types.c dedup.c api.c rl_jsonStubInit.c])
TEA_ADD_HEADERS([generic/rl_jsonDecls.h generic/rl_json.h])
TEA_ADD_INCLUDES([])
TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
TEA_ADD_STUB_SOURCES([rl_jsonStubLib.c])
TEA_ADD_TCL_SOURCES([])

#--------------------------------------------------------------------
................................................................................
# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
#
# A few miscellaneous platform-specific items:
# TEA_ADD_* any platform specific compiler/build info here.
#--------------------------------------------------------------------

#CLEANFILES="$CLEANFILES pkgIndex.tcl doc/json.html"
if test "${TEA_PLATFORM}" = "windows" ; then
    # Ensure no empty if clauses
    :
    #TEA_ADD_SOURCES([win/winFile.c])
    #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
else
    # Ensure no empty else clauses
................................................................................
#--------------------------------------------------------------------
# This macro figures out what flags to use with the compiler/linker
# when building shared/static debug/optimized objects.  This information
# can be taken from the tclConfig.sh file, but this figures it all out.
#--------------------------------------------------------------------

TEA_CONFIG_CFLAGS

# Check for required polyfill
TIP445

#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols option.
#--------------------------------------------------------------------

TEA_ENABLE_SYMBOLS

Changes to jni/rl_json/doc/json.n.

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
...
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
'\"
'\" Copyright (c) 2015 Ruby Lane
'\"
'\" See the file "LICENSE" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH json n 0.9.13 rl_json "RubyLane/JSON Package Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
json \- Parse and manipulate JSON documents 
.SH SYNOPSIS
.nf
\fBpackage require rl_json\fR ?\fB0.9.13\fR? 

\fBjson exists \fIjsonValue\fR ?\fIkey ...\fR ?\fImodifier\fR??
\fBjson extract \fIjsonValue\fR ?\fIkey ...\fR ?\fImodifier\fR??



\fBjson foreach \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR
\fBjson get \fIjsonValue\fR ?\fIkey ...\fR ?\fImodifier\fR??
\fBjson get_typed \fIjsonValue\fR ?\fIkey ...\fR ?\fImodifier\fR??
\fBjson lmap \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR
\fBjson new \fItype value\fR








\fBjson normalize \fIjsonValue\fR
\fBjson pretty \fIjsonValue\fR
\fBjson set \fIjsonVariableName\fR ?\fIkey ...\fR? \fIvalue\fR
\fBjson template \fIjsonValue\fR ?\fIdictionary\fR?
\fBjson unset \fIjsonVariableName\fR ?\fIkey ...\fR?
\fBjson isnull \fIjsonValue\fR \fIkey ...\fR?
\fBjson type \fIjsonValue\fR \fIkey ...\fR?




.fi
.BE
.SH DESCRIPTION
.PP
This package adds a command \fBjson\fR to the interpreter, and defines a new
Tcl_Obj type to store the parsed JSON document.  The \fBjson\fR command
directly manipulates values whose string representation is valid JSON, in a
similar way to how the \fBdict\fR command directly manipulates values whose
string representation is a valid dictionary.  It is similar to \fBdict\fR in
performance.
.TP
\fBjson get \fIjsonValue\fR ?\fIkey ...\fR ?\fImodifier\fR??
.
Extract the value of a portion of the \fIjsonValue\fR, returns the closest
native Tcl type (other than JSON) for the extracted portion. The \fIkey ...\fR
arguments are a path, as described in \fBPATHS\fR below.
'\" TODO: describe what happens with a null
.TP
\fBjson get_typed \fIjsonValue\fR ?\fIkey ...\fR ?\fImodifier\fR??
.
Extract the value of a portion of the \fIjsonValue\fR, returning a two element
list: the first element is the value that would be returned by \fBjson get\fR
and the second element is the JSON type of the extracted portion.  The
\fIkey ...\fR arguments are a path, as described in \fBPATHS\fR below.
.TP
\fBjson extract \fIjsonValue\fR ?\fIkey ...\fR?
.
Extract the value of a portion of the \fIjsonValue\fR, returns the JSON
fragment. The \fIkey ...\fR arguments are a path, as described in \fBPATHS\fR
below.
.TP
\fBjson exists \fIjsonValue\fR ?\fIkey ...\fR ?\fImodifier\fR??
.
Tests whether the supplied key path (see \fBPATHS\fR below) and modifier
resolve to something that exists in \fIjsonValue\fR (i.e., that it can be
used with \fBjson get\fR without error).  Returns false if the value named
by the path \fIkey ...\fR is null.
.TP
\fBjson set \fIjsonVariableName\fR ?\fIkey ...\fR? \fIvalue\fR
.
Updates the JSON value stored in the variable \fIjsonVariableName\fR,
replacing the value referenced by \fIkey ...\fR (a path as described in
\fBPATHS\fR below) with the JSON value \fIvalue\fR.



















































.TP
\fBjson unset \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Updates the JSON value stored in the variable \fIjsonVariableName\fR, removing
the value referenced by \fIkey ...\fR, a path as described in \fBPATHS\fR
below.
.TP
\fBjson normalize \fIjsonValue\fR
.
Return a
.QW normalized
version of the input \fIjsonValue\fR, i.e., with all optional whitespace
trimmed.



.TP
\fBjson template \fIjsonValue\fR ?\fIdictionary\fR?
.
Return a JSON value by interpolating the values from \fIdictionary\fR into the
template, or from variables in the current scope if \fIdictionary\fR is not
supplied, in the manner described in the section \fBTEMPLATES\fR.
.TP
\fBjson new \fItype value\fR
.
Return a JSON fragment of type \fItype\fR and value \fIvalue\fR.























.TP
\fBjson foreach \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.
Evaluate \fIscript\fR in a loop in a similar way to the \fBforeach\fR command.
In each iteration, the values stored in the iterator variables in each
\fIvarList\fR are the JSON fragments from \fIjsonValue\fR. This command
supports iterating over JSON arrays and JSON objects.  In the JSON object
case, the corresponding \fIvarList\fR must be a two element list, with the
first specifiying the variable to hold the key and the second the value.  In
the JSON array case, the rules are the same as the \fBforeach\fR command.
.TP
\fBjson lmap \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.
Updates the JSON value stored in the variable \fIjsonVariableName\fR,
replacing the value referenced by \fIkey ...\fR (a path as described in
\fBPATHS\fR below) with the JSON value \fIvalue\fR.
As for \fBjson foreach\fR, except that it is collecting; the result from each
evaluation of \fIscript\fR is added to a Tcl list and returned as the result
of the \fBjson lmap\fR command.  If the \fIscript\fR results in a TCL_CONTINUE
code (e.g., the script does \fBcontinue\fR), that iteration is skipped and no
element is added to the result list.  If it results in TCL_BREAK (e.g., the
script does \fBbreak\fR) the iterations are stopped and the results
accumulated so far are returned.
















.TP
\fBjson isnull \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Return a boolean indicating whether the named JSON value is null.
.TP
\fBjson type \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Return the type of the named JSON value, one of "object", "array", "string", "number", "boolean" or "null".

.TP
\fBjson pretty \fIjsonValue\fR

.
Returns a pretty-printed string representation of \fIjsonValue\fR.  Useful for debugging or inspecting the structure of JSON data.
.SH PATHS
.PP
Several of the commands (e.g., \fBjson get\fR, \fBjson exists\fR, \fBjson
set\fR and \fBjson unset\fR) accept a path specification that names some
subset of the supplied \fIjsonValue\fR.  The rules are similar to the
equivalent concept in the \fBdict\fR command, except that the paths used by
\fBjson\fR allow indexing into JSON arrays by the integer key (or a string
matching the regex
.QW "^end(-[0-9]+)?$" ).
.PP
Some of the commands also accept an optional modifier at the end of the path,
which is defined to be one of the following:
.TP
\fB?type\fR

.
Returns the type of the named fragment.

.TP
\fB?length\fR

.
When the path refers to an array, this returns the length of the array.  When
the path refers to a string, this returns the number of characters in the
string.  All other types throw an error.




.TP
\fB?size\fR

.
Valid only for objects, returns the number of keys defined in the object.


.TP
\fB?keys\fR

.







Valid only for objects, returns a list of the keys in the object.
.PP

A literal value that would match one of the above modifiers can be used as the
last element in the path by doubling the \fB?\fR. For example:
.PP

.CS
 \fBjson get\fR {

     {
         "foo": {
             "?size": "quite big"
         }







     }
 } foo ??size

.CE

























.PP
Returns "quite big"







.SH TEMPLATES
.PP
The command \fBjson template\fR generates JSON documents by interpolating
values into a template from a supplied dictionary or variables in the current
call frame, a flexible mechanism for generating complex documents.  The
templates are valid JSON documents containing string values which match the
regex
................................................................................
.CE
.PP
Incrementally append an element to an array (similar to \fBdict lappend\fR):
.PP
.CS
 set doc {{"foo":[]}}
 for {set i 0} {$i < 4} {incr i} {
     json set doc foo end+1 [json new string "elem: $i"]
 }
 # $doc is {"foo":["elem 0","elem 1","elem 2","elem 3"]}
.CE
.PP
Similar to the above, but prepend the elements instead:
.PP
.CS
 set doc {{"foo":[]}}
 for {set i 0} {$i < 4} {incr i} {
     json set doc foo -1 [json new string "elem: $i"]
 }
 # $doc is {"foo":["elem 3","elem 2","elem 1","elem 0"]}
.CE
.PP
Trim an element out of an array:
.PP
.CS






|




|


|

|
|
>
>
>

<
<

<
>
>
>
>
>
>
>
>


<

<
|
|
>
>
>
>











|






<
<
<
<
<
<
<






|

|
|
|
|





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





<
<
<
<
<
<
<
<
>
>
>







|

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













<
<
<







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







|
>

<
>

<
|
|
|
<
<
<
<
<
<
<
<
<

<
>

<
>

<
>

<
<
<
>
>
>
>

<
>

<
>
>

<
>

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

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

<
>
>
>
>
>
>
>







 







|









|







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
209
210
211
212
213
214

215
216

217
218
219









220

221
222

223
224

225
226



227
228
229
230
231

232
233

234
235
236

237
238
239
240
241
242
243
244
245
246

247
248
249

250
251
252
253
254

255
256
257
258
259
260
261
262
263
264

265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
300
301
302
303
304
305
306
...
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
'\"
'\" Copyright (c) 2015 Ruby Lane
'\"
'\" See the file "LICENSE" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH json n 0.11.0 rl_json "RubyLane/JSON Package Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
json \- Parse, manipulate and produce JSON documents 
.SH SYNOPSIS
.nf
\fBpackage require rl_json\fR ?\fB0.11.0\fR? 

\fBjson get \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson extract \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson exists \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson set \fIjsonVariableName\fR ?\fIkey ...\fR? \fIvalue\fR
\fBjson unset \fIjsonVariableName\fR ?\fIkey ...\fR?
\fBjson foreach \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR


\fBjson lmap \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR

\fBjson amap \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR
\fBjson omap \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR
\fBjson string \fIvalue\fR
\fBjson number \fIvalue\fR
\fBjson boolean \fIvalue\fR
\fBjson object \fI?key value ?key value ...??\fR
\fBjson array \fIelem ...\fR
\fBjson bool \fIvalue\fR
\fBjson normalize \fIjsonValue\fR
\fBjson pretty \fIjsonValue\fR

\fBjson template \fIjsonValue\fR ?\fIdictionary\fR?

\fBjson isnull \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson type \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson length \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson keys \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson decode \fIbytes\fR ?\fIencoding\fR?
\fBjson valid ?\fB-extensions\fR \fIextensionlist\fR? ?\fB-details\fR \fIdetailsvar\fR? \fIjsonValue\fR
.fi
.BE
.SH DESCRIPTION
.PP
This package adds a command \fBjson\fR to the interpreter, and defines a new
Tcl_Obj type to store the parsed JSON document.  The \fBjson\fR command
directly manipulates values whose string representation is valid JSON, in a
similar way to how the \fBdict\fR command directly manipulates values whose
string representation is a valid dictionary.  It is similar to \fBdict\fR in
performance.
.TP
\fBjson get \fIjsonValue\fR ?\fIkey ...\fR?
.
Extract the value of a portion of the \fIjsonValue\fR, returns the closest
native Tcl type (other than JSON) for the extracted portion. The \fIkey ...\fR
arguments are a path, as described in \fBPATHS\fR below.
'\" TODO: describe what happens with a null
.TP







\fBjson extract \fIjsonValue\fR ?\fIkey ...\fR?
.
Extract the value of a portion of the \fIjsonValue\fR, returns the JSON
fragment. The \fIkey ...\fR arguments are a path, as described in \fBPATHS\fR
below.
.TP
\fBjson exists \fIjsonValue\fR ?\fIkey ...\fR?
.
Tests whether the supplied key path (see \fBPATHS\fR below) resolves to
something that exists in \fIjsonValue\fR (i.e., that it can be used with
\fBjson get\fR without error) and is not null.  Returns false if the value
named by the path \fIkey ...\fR is null.
.TP
\fBjson set \fIjsonVariableName\fR ?\fIkey ...\fR? \fIvalue\fR
.
Updates the JSON value stored in the variable \fIjsonVariableName\fR,
replacing the value referenced by \fIkey ...\fR (a path as described in
\fBPATHS\fR below) with the JSON value \fIvalue\fR.  If \fIvalue\fR is
a valid JSON as given by the JSON grammar, it is added as that JSON type,
otherwise it is converted to a JSON string.  Thus the following are equivalent
(modulo efficiency):

.CS
 json set doc foo [json string baz]
 json set doc bar [json number 123]
 json set doc baz [json boolean true]

 #------------------------------------------
 json set doc foo baz
 json set doc bar 123
 json set doc baz true
.CE

Watch out for unintended behaviour if the value might look like a boolean or
number but not meet the JSON grammar for those types, in which case the value
is converted to a JSON string:

.CS
 json set doc foo [json boolean yes]
 # Key "foo" contains the JSON boolean value "true"

 json set doc foo yes
 # Key "foo" contains the JSON string value "yes"
.CE

Constructing the values using [\fBjson \fItype\fR] forces the conversion to
the specified JSON type, or throws an exception if that can't be done.
Which is more efficent will depend on the situation:

.CS
 set doc {[]}
 for {set i 0} {$i < 100} {incr i} {
 	json set doc end+1 [json boolean true]	;# 1
 	json set doc end+1 true				;# 2
 }
 # 2 will be faster since "true" will be stored as a literal, and converted
 # to a JSON boolean.  Each loop iteration will just append another reference
 # to this static value to the array, whereas 1 will call [json boolean] each
 # iteration.
 
 set doc {[]}
 for {set i 0} {$i < 100} {incr i} {
 	json set doc end+1 [json string false$i]	;# 1
 	json set doc end+1 false$i				;# 2
 }
 # 1 will be faster since [json string] knows what the type is and directly
 # creates the new element as that type.  2 Needs to parse the string to
 # determine the type.
.CE
.TP
\fBjson unset \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Updates the JSON value stored in the variable \fIjsonVariableName\fR, removing
the value referenced by \fIkey ...\fR, a path as described in \fBPATHS\fR








below.  If the path names a entry in an object then that key is removed from the
object.  If the path names an element in an array, that element is removed
and all later elements are moved up.
.TP
\fBjson template \fIjsonValue\fR ?\fIdictionary\fR?
.
Return a JSON value by interpolating the values from \fIdictionary\fR into the
template, or from variables in the current scope if \fIdictionary\fR is not
supplied, in the manner described in the section \fBTEMPLATES\fR.
.TP
\fBjson string \fIvalue\fR
.
Return a JSON string with the value \fIvalue\fR.
.TP
\fBjson number \fIvalue\fR
.
Return a JSON number with the value \fIvalue\fR.
.TP
\fBjson boolean \fIvalue\fR
.
Return a JSON boolean with the value \fIvalue\fR.  Any of the forms accepted by
Tcl_GetBooleanFromObj are accepted and normalized.
.TP
\fBjson object \fI?key value ?key value ...??\fR -or- \fBjson object \fIpacked_value\fR
.
Return a JSON object with the each of the keys and values given.  \fIvalue\fR is a list
of two elements, the first being the type {string, number, boolean, null, object, array, json},
and the second being the value.  The alternate syntax \fBjson object \fIpacked_value\fR
takes the list of keys and values as a single arg instead of a list of args, but is
otherwise the same.
.TP
\fBjson array \fI?elem ...?\fR
.
Return a JSON array containing each of the elements given.  \fIelem\fR is a list
of two elements, the first being the type {string, number, boolean, null, object, array, json},
and the second being the value.
.TP
\fBjson foreach \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.
Evaluate \fIscript\fR in a loop in a similar way to the \fBforeach\fR command.
In each iteration, the values stored in the iterator variables in each
\fIvarList\fR are the JSON fragments from \fIjsonValue\fR. This command
supports iterating over JSON arrays and JSON objects.  In the JSON object
case, the corresponding \fIvarList\fR must be a two element list, with the
first specifiying the variable to hold the key and the second the value.  In
the JSON array case, the rules are the same as the \fBforeach\fR command.
.TP
\fBjson lmap \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.



As for \fBjson foreach\fR, except that it is collecting; the result from each
evaluation of \fIscript\fR is added to a Tcl list and returned as the result
of the \fBjson lmap\fR command.  If the \fIscript\fR results in a TCL_CONTINUE
code (e.g., the script does \fBcontinue\fR), that iteration is skipped and no
element is added to the result list.  If it results in TCL_BREAK (e.g., the
script does \fBbreak\fR) the iterations are stopped and the results
accumulated so far are returned.
.TP
\fBjson amap \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.
As for \fBjson lmap\fR, but the result is a JSON array rather than a list.  If
the result of each iteration is a JSON value it is added to the array as-is,
otherwise it is converted to a JSON string.
.TP
\fBjson omap \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.
As for \fBjson lmap\fR, but the result is a JSON object rather than a list.
The result of each iteration must be a dictionary (or a list of 2n elements,
including n = 0).  Tcl_ObjType snooping is done to ensure that the iteration
over the result is efficient for both dict and list cases.
Each entry in the dictionary will be added to the result object.  If the value
for each key in the iteration result is a JSON value it is added to the array
as-is, otherwise it is converted to a JSON string.
.TP
\fBjson isnull \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Return a boolean indicating whether the named JSON value is null.
.TP
\fBjson type \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Return the type of the named JSON value, one of "object", "array", "string",
"number", "boolean" or "null".
.TP

\fBjson length \fIjsonVariableName\fR ?\fIkey ...\fR?
.

Return the length of the of the named JSON array, number of entries in the
named JSON object, or number of characters in the named JSON string.  Other
value types aren't supported.









.TP

\fBjson keys \fIjsonVariableName\fR ?\fIkey ...\fR?
.

Return the keys in the of the named JSON object, found by following the path of \fIkey\fRs.
.TP

\fBjson normalize \fIjsonValue\fR
.



Return a
.QW normalized
version of the input \fIjsonValue\fR, i.e., with all optional whitespace
trimmed.
.TP

\fBjson pretty \fIjsonValue\fR
.

Returns a pretty-printed string representation of \fIjsonValue\fR.  Useful for
debugging or inspecting the structure of JSON data.
.TP

\fBjson decode \fIbytes\fR ?\fIencoding\fR?
.
Rl_json operates on characters, as returned from Tcl's Tcl_GetStringFromObj,
not raw bytes, so considerations of encoding are strictly outside of its scope
(other than ignoring a byte order mark if the string starts with one).  The
JSON RFC lays out some behaviour for conforming implementations regarding
character encoding, and ensuring that an application using rl_json meets that
standard would be up to the application.  Some aspects are not straightforward,
so rl_json provides this utility subcommand that takes binary data in \fIbytes\fR
and returns a character string according to the RFC specified behaviour.  If

the optional \fIencoding\fR argument is given, that encoding will be used to
interpret \fIbytes\fR.  The supported encodings are those specified in the RFC:
utf-8, utf-16le, utf-16be, utf-32le, utf-32be.  If the string starts with a BOM

(byte order mark (U+FFFE)), and no encoding is given, it will be determined
from the encoding of the BOM.  All the encodings listed are supported, even if
Tcl lacks support for the utf-16 and utf-32 encodings natively.  However,
without native support the conversion will be slow.


This might look something like this in an application:

.CS
 proc readjson file {
 	set h [open $file rb]	;# Note that the file is opened in binary mode - no encoding
 	try {
 		json decode [read $h]
 	} finally {
 		close $h
 	}

 }
.CE
.TP
\fBjson valid\fR ?\fB-extensions\fR \fIextensionlist\fR? ?\fB-details\fR \fIdetails\fR? \fIjsonValue\fR
.
Validate \fBjsonValue\fR against the JSON grammar, returning true of it
conforms and false otherwise.  A list of extensions to accept can be supplied
with \fB-extensions\fR, with only one currently supported extension:
\fBcomments\fR, which accepts JSON documents containing \fB// foo\fR and \fB/*
foo */\fR style comments anywhere whitespace would be valid.  To reject
documents containing comments, set \fIextensionlist\fR to {}.

Validation using this subcommand is about 3 times faster than parsing and
catching a parsing exception, and it allows strict validation against the RFC
without comments.

If validation fails and \fB-details\fR \fIdetailsvar\fR is supplied, the variable
\fIdetailsvar\fR is set to a dictionary containing the keys:
.RS 10
.IP \fBerrmsg\fR 10
A reason for the failure.
.IP \fBdoc\fR 10
The document that failed validation
.IP \fBchar_ofs\fR 10
The character offset into \fBdoc\fR that caused validation to fail.
.RE
.SH PATHS
.PP

Several of the commands (e.g., \fBjson get\fR, \fBjson exists\fR, \fBjson
set\fR and \fBjson unset\fR) accept a path specification that names some
subset of the supplied \fIjsonValue\fR.  The rules are similar to the
equivalent concept in the \fBdict\fR command, except that the paths used by
\fBjson\fR allow indexing into JSON arrays by the integer key (or a string
matching the regex
.QW "^end(-[0-9]+)?$" ).
.SH TEMPLATES
.PP
The command \fBjson template\fR generates JSON documents by interpolating
values into a template from a supplied dictionary or variables in the current
call frame, a flexible mechanism for generating complex documents.  The
templates are valid JSON documents containing string values which match the
regex
................................................................................
.CE
.PP
Incrementally append an element to an array (similar to \fBdict lappend\fR):
.PP
.CS
 set doc {{"foo":[]}}
 for {set i 0} {$i < 4} {incr i} {
     json set doc foo end+1 [json string "elem: $i"]
 }
 # $doc is {"foo":["elem 0","elem 1","elem 2","elem 3"]}
.CE
.PP
Similar to the above, but prepend the elements instead:
.PP
.CS
 set doc {{"foo":[]}}
 for {set i 0} {$i < 4} {incr i} {
     json set doc foo -1 [json string "elem: $i"]
 }
 # $doc is {"foo":["elem 3","elem 2","elem 1","elem 0"]}
.CE
.PP
Trim an element out of an array:
.PP
.CS

Added jni/rl_json/fetch_test_cases.tcl.















































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#!/usr/bin/env tclsh

# Doesn't work.  It should, but github is serving the binary .json files as utf-8, which breaks all the carefully
# crafted encoding tests

# Dependencies:
#	rl_json:		https://github.com/RubyLane/rl_json
#	parse_args: 	https://github.com/RubyLane/parse_args
#	rl_http:		https://github.com/RubyLane/rl_http
#	urlencode:		copied to support/
#	uri:			tcllib
#	Thread:			https://core.tcl-lang.org/thread
#	tls:			https://core.tcl-lang.org/tcltls/index

set here	[file dirname [file normalize [info script]]]

tcl::tm::path add [file join $here support]
lappend auto_path $here

package require rl_json		;# yeah...
package require rl_http
package require parse_args
package require urlencode

interp alias {} json {} ::rl_json::json
interp alias {} parse_args {} ::parse_args::parse_args

proc http {method url args} { #<<<
	parse_args $args {
		-log				{-default {{lvl msg} {}}}
		-if_modified_since	{-# {seconds since 1970-01-01 00:00:00 UTC}}
	}

	set headers	{}

	if {[info exists if_modified_since]} {
		lappend headers If-Modified-Since [clock format $if_modified_since -format {%a, %d %b %Y %H:%M:%S GMT} -gmt 1]
		#puts "If-Modified-Since: [lindex $headers end]"
	}

	while {[incr tries] <= 3} {
		try {
			apply $log notice "Fetching $method $url"
			rl_http instvar h $method $url -headers $headers
		} on error {errmsg options} {
			throw [list HTTP RL_HTTP {*}[dict get $options -errorcode]] $errmsg
		}

		switch -glob -- [$h code] {
			2*               {
			#puts "Headers:\n\t[join [lmap {k v} [$h headers] {format {%s: %s} $k $v}] \n\t]"
				return [$h body]
			}
			304		         {throw [list HTTP CODE [$h code]] "Not modified"}
			301 - 302 - 307  {set url [lindex [dict get [$h headers] location] 0]}
			403 {
				if {[dict exists [$h headers] x-ratelimit-limit]} { # Rate limiting <<<
					set limit		[lindex [dict get [$h headers] x-ratelimit-limit] 0]
					set remaining	[lindex [dict get [$h headers] x-ratelimit-remaining] 0]
					set reset		[lindex [dict get [$h headers] x-ratelimit-reset] 0]
					throw [list HTTP RATELIMIT $reset $limit $remaining] "Rate limited until [clock format $reset]"
					#>>>
				}

				throw [list HTTP CODE [$h code]] [$h body]
			}
			503 {
				apply $log warning "Got 503 error, waiting and trying again"
				after 2000
			}
			default {
				throw [list HTTP CODE [$h code]] "Error fetching $method $url: [$h code]\n[$h body]"
			}
		}
	}

	throw [list HTTP TOO_MANY_TRIES [expr {$tries-1}]] "Ran out of patience fetching $method $endoint after $tries failures"
}

#>>>

namespace eval ::github {
	namespace export *
	namespace ensemble create -prefixes no

	proc endpoint args { #<<<
		parse_args $args {
			-owner		{-required}
			-repo		{-required}
			args		{-name path_parts}
		}

		string cat \
			https://api.github.com/repos/ \
			[urlencode rfc_urlencode -part path -- $owner] \
			/ \
			[urlencode rfc_urlencode -part path -- $repo] \
			/contents/ \
			[join [lmap e $path_parts {urlencode rfc_urlencode -part path -- $e}] /]
	}

	#>>>

	proc api {method args} { #<<<
		set endpoint	[github endpoint {*}$args]

		http $method $endpoint
	}

	#>>>
}

proc writetext {fn data} { #<<<
	set h	[open $fn w]
	try {
		puts -nonewline $h $data
	} finally {
		close $h
	}
}

#>>>
proc writebin {fn data} { #<<<
	set h	[open $fn wb]
	try {
		puts -nonewline $h $data
	} finally {
		close $h
	}
}

#>>>

proc fetch_file {dest file} { #<<<
	set fn	[file join $dest [json get $file name]]
	if {[file exists $fn]} {
		set mtime	[file mtime $fn]
		try {
			puts -nonewline "Fetching [json get $file name] -if_modified_since $mtime"
			http GET [json get $file download_url] -if_modified_since $mtime
		} on ok contents {
			puts " [string length $contents] bytes"
			writebin [file join $dest [json get $file name]] $contents
		} trap {HTTP CODE 304} {} {
			puts " not modified"
			return
		} on error {errmsg options} {
			puts " Error: $errmsg"
		}
	} else {
		try {
			puts -nonewline "Fetching [json get $file name]"
			http GET [json get $file download_url]
		} on ok contents {
			puts " [string length $contents] bytes"
			writebin [file join $dest [json get $file name]] $contents
		} on error {errmsg options} {
			puts " Error: $errmsg"
		}
	}
}

#>>>

set dest	[file join $here tests JSONTestSuite test_parsing]
file mkdir $dest

set listing	[github api GET -owner nst -repo JSONTestSuite test_parsing]
#puts [json pretty $listing]
json foreach file $listing {
	fetch_file $dest $file
}

set dest	[file join $here tests JSONTestSuite test_transform]
file mkdir $dest

set listing	[github api GET -owner nst -repo JSONTestSuite test_transform]
#puts [json pretty $listing]
json foreach file $listing {
	fetch_file $dest $file
}

# vim: foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Added jni/rl_json/generic/api.c.













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
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
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
#include "rl_jsonInt.h"
#include "parser.h"

Tcl_Obj* JSON_NewJSONObj(Tcl_Interp* interp, Tcl_Obj* from) //{{{
{
	return as_json(interp, from);
}

//}}}
int JSON_NewJStringObj(Tcl_Interp* interp, Tcl_Obj* string, Tcl_Obj** new) //{{{
{
	replace_tclobj(new, JSON_NewJvalObj(JSON_STRING, string));

	return TCL_OK;
}

//}}}
int JSON_NewJNumberObj(Tcl_Interp* interp, Tcl_Obj* number, Tcl_Obj** new) //{{{
{
	Tcl_Obj*			forced = NULL;
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	TEST_OK(force_json_number(interp, l, number, &forced));
	replace_tclobj(new, JSON_NewJvalObj(JSON_NUMBER, forced));
	release_tclobj(&forced);

	return TCL_OK;
}

//}}}
int JSON_NewJBooleanObj(Tcl_Interp* interp, Tcl_Obj* boolean, Tcl_Obj** new) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	int					bool;

	TEST_OK(Tcl_GetBooleanFromObj(interp, boolean, &bool));
	replace_tclobj(new, bool ? l->json_true : l->json_false);

	return TCL_OK;
}

//}}}
int JSON_NewJNullObj(Tcl_Interp* interp, Tcl_Obj* *new) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	replace_tclobj(new, l->json_null);

    return TCL_OK;
}

//}}}
int JSON_NewJObjectObj(Tcl_Interp* interp, Tcl_Obj** new) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	replace_tclobj(new, JSON_NewJvalObj(JSON_OBJECT, l->tcl_empty_dict));

	return TCL_OK;
}

//}}}
int JSON_NewJArrayObj(Tcl_Interp* interp, int objc, Tcl_Obj* objv[], Tcl_Obj** new) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	if (objc == 0) {
		replace_tclobj(new, JSON_NewJvalObj(JSON_OBJECT, l->tcl_empty_list));
	} else {
		int		i;

		for (i=0; i<objc; i++) TEST_OK(JSON_ForceJSON(interp, objv[i]));

		replace_tclobj(new, JSON_NewJvalObj(JSON_OBJECT, Tcl_NewListObj(objc, objv)));
	}

	return TCL_OK;
}

//}}}
int JSON_NewTemplateObj(Tcl_Interp* interp, enum json_types type, Tcl_Obj* key, Tcl_Obj** new) //{{{
{
	if (!type_is_dynamic(type)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Requested type is not a valid template type: %s", type_names_int[type]));
		return TCL_ERROR;
	}

	replace_tclobj(new, JSON_NewJvalObj(type, key));

	return TCL_OK;	
}

//}}}
int JSON_ForceJSON(Tcl_Interp* interp, Tcl_Obj* obj) // Force a conversion to a JSON objtype, or throw an exception {{{
{
	Tcl_ObjIntRep*	ir;
	enum json_types	type;

	TEST_OK(JSON_GetIntrepFromObj(interp, obj, &type, &ir));

	return TCL_OK;
}

//}}}

enum json_types JSON_GetJSONType(Tcl_Obj* obj) //{{{
{
	Tcl_ObjIntRep*	ir = NULL;
	enum json_types	t;

	for (t=JSON_OBJECT; t<JSON_TYPE_MAX && ir==NULL; t++)
		ir = Tcl_FetchIntRep(obj, g_objtype_for_type[t]);

	return (ir == NULL) ? JSON_UNDEF : t-1;
}

//}}}
int JSON_GetObjFromJStringObj(Tcl_Interp* interp, Tcl_Obj* jstringObj, Tcl_Obj** stringObj) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, jstringObj, &type, &val));

	if (type_is_dynamic(type)) {
		replace_tclobj(stringObj, Tcl_ObjPrintf("%s%s", get_dyn_prefix(type), Tcl_GetString(val)));
		return TCL_OK;
	} else if (type == JSON_STRING) {
		replace_tclobj(stringObj, val);
		return TCL_OK;
	} else {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Asked for string from json string but supplied json %s", get_type_name(type)));
		return TCL_ERROR;
	}
}

//}}}
int JSON_GetObjFromJNumberObj(Tcl_Interp* interp, Tcl_Obj* jnumberObj, Tcl_Obj** numberObj) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, jnumberObj, &type, &val));

	if (type != JSON_NUMBER) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Asked for number from json number but supplied json %s", get_type_name(type)));
		return TCL_ERROR;
	}

	replace_tclobj(numberObj, val);

	return TCL_OK;
}

//}}}
int JSON_GetObjFromJBooleanObj(Tcl_Interp* interp, Tcl_Obj* jbooleanObj, Tcl_Obj** booleanObj) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, jbooleanObj, &type, &val));

	if (type != JSON_BOOL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Asked for boolean from json boolean but supplied json %s", get_type_name(type)));
		return TCL_ERROR;
	}

	replace_tclobj(booleanObj, val);

	return TCL_OK;
}

//}}}
int JSON_JArrayObjAppendElement(Tcl_Interp* interp, Tcl_Obj* arrayObj, Tcl_Obj* elem) //{{{
{
	enum json_types	type;
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		val = NULL;

	if (Tcl_IsShared(arrayObj)) {
		// Tcl_Panic?
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("JSON_JArrayObjAppendElement called with shared object"));
		return TCL_ERROR;
	}

	TEST_OK(JSON_GetIntrepFromObj(interp, arrayObj, &type, &ir));

	if (type != JSON_ARRAY) // Turn it into one by creating a new array with a single element containing the old value
		TEST_OK(JSON_SetIntRep(arrayObj, JSON_ARRAY, Tcl_NewListObj(1, &val)));

	val = get_unshared_val(ir);

	TEST_OK(Tcl_ListObjAppendElement(interp, val, as_json(interp, elem)));

	release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);
	Tcl_InvalidateStringRep(arrayObj);

	return TCL_OK;
}

//}}}
int JSON_JArrayObjAppendList(Tcl_Interp* interp, Tcl_Obj* arrayObj, Tcl_Obj* elems /* a JArrayObj or ListObj */ ) //{{{
{
	enum json_types	type, elems_type;
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		val = NULL;
	Tcl_Obj*		elems_val = NULL;
	int				retval = TCL_OK;

	if (Tcl_IsShared(arrayObj)) {
		// Tcl_Panic?
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("JSON_JArrayObjAppendElement called with shared object"));
		return TCL_ERROR;
	}

	TEST_OK(JSON_GetIntrepFromObj(interp, arrayObj, &type, &ir));

	if (type != JSON_ARRAY) // Turn it into one by creating a new array with a single element containing the old value
		TEST_OK(JSON_SetIntRep(arrayObj, JSON_ARRAY, Tcl_NewListObj(1, &val)));

	val = get_unshared_val(ir);

	if (JSON_GetJvalFromObj(interp, elems, &elems_type, &elems_val) == TCL_OK) {
		switch (elems_type) {
			case JSON_ARRAY:	// Given a JSON array, append its elements
				TEST_OK(Tcl_ListObjAppendList(interp, val, elems_val));
				break;

			case JSON_OBJECT:	// Given a JSON object, append its keys as strings and values as whatever they were
				{
					Tcl_DictSearch search;
					Tcl_Obj*		k = NULL;
					Tcl_Obj*		kjstring = NULL;
					Tcl_Obj*		v = NULL;
					int				done;

					TEST_OK(Tcl_DictObjFirst(interp, elems_val, &search, &k, &v, &done));
					for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
						TEST_OK_BREAK(retval, JSON_NewJStringObj(interp, k, &kjstring));
						TEST_OK_BREAK(retval, Tcl_ListObjAppendElement(interp, val, kjstring));
						TEST_OK_BREAK(retval, Tcl_ListObjAppendElement(interp, val, v));
					}
					release_tclobj(&kjstring);
					Tcl_DictObjDone(&search);
				}
				break;

			default:			// elems is JSON, but not a sensible type for this call
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Could not append elements - not a JSON array, JSON object or list: %s", get_type_name(elems_type)));
				return TCL_ERROR;
		}
	} else {
		TEST_OK(Tcl_ListObjAppendList(interp, val, elems));
	}

	return retval;
}

//}}}
int JSON_SetJArrayObj(Tcl_Interp* interp, Tcl_Obj* obj, const int objc, Tcl_Obj* objv[]) //{{{
{
	enum json_types	type;
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		val = NULL;
	int				i, retval = TCL_OK;
	Tcl_Obj**		jov = NULL;
	Tcl_Obj*		newlist = NULL;

	if (Tcl_IsShared(obj)) {
		// Tcl_Panic?
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("JSON_SetJArrayObj called with shared object"));
		return TCL_ERROR;
	}

	jov = ckalloc(sizeof(Tcl_Obj*) * objc);
	for (i=0; i<objc; i++)
		Tcl_IncrRefCount(jov[i] = as_json(interp, objv[i]));

	// Possibly silly optimization: if obj is already a JSON array, call Tcl_SetListObj on its intrep list.
	// All this saves is freeing the old intrep list and creating a fresh one, at the cost of some other overhead
	if (JSON_IsJSON(obj, &type, &ir)) {
		val = get_unshared_val(ir);
		Tcl_SetListObj(val, objc, jov);
	} else {
		replace_tclobj(&newlist, Tcl_NewListObj(objc, jov));
		retval = JSON_SetIntRep(obj, JSON_ARRAY, newlist);
	}

	release_tclobj(&newlist);

	if (jov) {
		for (i=0; i<objc; i++) release_tclobj(&jov[i]);
		ckfree(jov);
		jov = NULL;
	}

	return retval;
}

//}}}
int JSON_JArrayObjGetElements(Tcl_Interp* interp, Tcl_Obj* arrayObj, int* objc, Tcl_Obj*** objv) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, arrayObj, &type, &val));
	if (type != JSON_ARRAY) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Expecting a JSON array, but got a JSON %s", get_type_name(type)));
		return TCL_ERROR;
	}
	TEST_OK(Tcl_ListObjGetElements(interp, val, objc, objv));

	return TCL_OK;
}

//}}}
int JSON_JArrayObjIndex(Tcl_Interp* interp, Tcl_Obj* arrayObj, int index, Tcl_Obj** elem) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, arrayObj, &type, &val));
	if (type != JSON_ARRAY) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Expecting a JSON array, but got a JSON %s", get_type_name(type)));
		return TCL_ERROR;
	}
	TEST_OK(Tcl_ListObjIndex(interp, val, index, elem));

	return TCL_OK;
}

//}}}
int JSON_JArrayObjReplace(Tcl_Interp* interp, Tcl_Obj* arrayObj, int first, int count, int objc, Tcl_Obj* objv[]) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;
	Tcl_Obj**		jov = NULL;
	int				i, retval=TCL_OK;

	TEST_OK(JSON_GetJvalFromObj(interp, arrayObj, &type, &val));
	if (type != JSON_ARRAY) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Expecting a JSON array, but got a JSON %s", get_type_name(type)));
		return TCL_ERROR;
	}

	jov = ckalloc(sizeof(Tcl_Obj*) * objc);
	for (i=0; i<objc; i++)
		Tcl_IncrRefCount(jov[i] = as_json(interp, objv[i]));

	retval = Tcl_ListObjReplace(interp, val, first, count, objc, jov);

	if (jov) {
		for (i=0; i<objc; i++) release_tclobj(&jov[i]);
		ckfree(jov);
		jov = NULL;
	}

	return retval;
}

//}}}
// TODO: JObject interface, similar to DictObj

int JSON_Get(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** res) //{{{
{
	int			retval = TCL_OK;
	Tcl_Obj*	jval = NULL;
	Tcl_Obj*	astcl = NULL;

	retval = JSON_Extract(interp, obj, path, &jval);

	if (retval == TCL_OK)
		retval = convert_to_tcl(interp, jval, &astcl);

	if (retval == TCL_OK)
		replace_tclobj(res, astcl);

	release_tclobj(&astcl);
	release_tclobj(&jval);

	return retval;
}

//}}}
int JSON_Extract(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** res) //{{{
{
	Tcl_Obj*	target = NULL;
	int			retval=TCL_OK;
	Tcl_Obj**	pathv = NULL;
	int			pathc;

	TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv));

	if (pathc > 0) {
		TEST_OK(resolve_path(interp, obj, pathv, pathc, &target, 0, 0));
	} else {
		TEST_OK(JSON_ForceJSON(interp, obj));
		replace_tclobj(&target, obj);
	}

	if (retval == TCL_OK)
		replace_tclobj(res, target);

	release_tclobj(&target);

	return retval;
}

//}}}
int JSON_Exists(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* exists) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	Tcl_Obj*			target = NULL;
	Tcl_Obj**			pathv = NULL;
	int					pathc;

	TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv));

	if (pathc > 0) {
		TEST_OK(resolve_path(interp, obj, pathv, pathc, &target, 1, 0));
		release_tclobj(&target);
		// resolve_path sets the interp result in exists mode
		*exists = (Tcl_GetObjResult(interp) == l->json_true);
		Tcl_ResetResult(interp);
	} else {
		enum json_types	type = JSON_GetJSONType(obj);
		*exists = (type != JSON_UNDEF && type != JSON_NULL);
	}

	return TCL_OK;
}

//}}}
int JSON_Set(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path, Tcl_Obj* replacement) //{{{
{
	int				i, pathc;
	enum json_types	type, newtype;
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		val = NULL;
	Tcl_Obj*		step;
	Tcl_Obj*		src;
	Tcl_Obj*		target;
	Tcl_Obj*		newval;
	Tcl_Obj*		rep = NULL;
	Tcl_Obj**		pathv = NULL;

	src = Tcl_ObjGetVar2(interp, obj, NULL, 0);
	if (src == NULL) {
		src = Tcl_ObjSetVar2(interp, obj, NULL, JSON_NewJvalObj(JSON_OBJECT, Tcl_NewDictObj()), TCL_LEAVE_ERR_MSG);
	}

	if (Tcl_IsShared(src)) {
		src = Tcl_ObjSetVar2(interp, obj, NULL, Tcl_DuplicateObj(src), TCL_LEAVE_ERR_MSG);
		if (src == NULL)
			return TCL_ERROR;
	}

	/*
	fprintf(stderr, "JSON_Set, obj: \"%s\", src: \"%s\"\n",
			Tcl_GetString(obj), Tcl_GetString(src));
			*/
	target = src;

	TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
	val = get_unshared_val(ir);

	TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv));

	// Walk the path as far as it exists in src
	//fprintf(stderr, "set, initial type %s\n", type_names[type]);
	for (i=0; i<pathc; i++) {
		step = pathv[i];
		//fprintf(stderr, "looking at step %s, cx type: %s\n", Tcl_GetString(step), type_names_int[type]);

		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				TEST_OK(Tcl_DictObjGet(interp, val, step, &target));
				if (target == NULL) {
					//fprintf(stderr, "Path element %d: \"%s\" doesn't exist creating a new key for it and storing a null\n",
					//		i, Tcl_GetString(step));
					target = JSON_NewJvalObj(JSON_NULL, NULL);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
					i++;
					goto followed_path;
				}
				if (Tcl_IsShared(target)) {
					//fprintf(stderr, "Path element %d: \"%s\" exists but the TclObj is shared (%d), replacing it with an unshared duplicate\n",
					//		i, Tcl_GetString(step), target->refCount);
					target = Tcl_DuplicateObj(target);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
				}
				break;
				//}}}
			case JSON_ARRAY: //{{{
				{
					int			ac, index_str_len, ok=1;
					long		index;
					const char*	index_str;
					char*		end;
					Tcl_Obj**	av;

					TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
					//fprintf(stderr, "descending into array of length %d\n", ac);

					if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
						// Index isn't an integer, check for end(+/-int)?
						index_str = Tcl_GetStringFromObj(step, &index_str_len);
						if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
							ok = 0;

						if (ok) {
							index = ac-1;
							if (index_str_len >= 4) {
								if (index_str[3] != '-' && index_str[3] != '+') {
									ok = 0;
								} else {
									// errno is magically thread-safe on POSIX
									// systems (it's thread-local)
									errno = 0;
									index += strtol(index_str+3, &end, 10);
									if (errno != 0 || *end != 0)
										ok = 0;
								}
							}
						}

						if (!ok)
							THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

						//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
					} else {
						//fprintf(stderr, "Explicit index: %ld\n", index);
					}

					if (index < 0) {
						// Prepend element to the array
						target = JSON_NewJvalObj(JSON_NULL, NULL);
						TEST_OK(Tcl_ListObjReplace(interp, val, -1, 0, 1, &target));

						i++;
						goto followed_path;
					} else if (index >= ac) {
						int			new_i;
						for (new_i=ac; new_i<index; new_i++) {
							TEST_OK(Tcl_ListObjAppendElement(interp, val,
										JSON_NewJvalObj(JSON_NULL, NULL)));
						}
						target = JSON_NewJvalObj(JSON_NULL, NULL);
						TEST_OK(Tcl_ListObjAppendElement(interp, val, target));

						i++;
						goto followed_path;
					} else {
						target = av[index];
						if (Tcl_IsShared(target)) {
							target = Tcl_DuplicateObj(target);
							TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 1, &target));
						}
						//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
					}
				}
				break;
				//}}}
			case JSON_STRING:
			case JSON_NUMBER:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
				THROW_ERROR("Attempt to index into atomic type ", get_type_name(type), " at path key \"", Tcl_GetString(step), "\"");
				/*
				i++;
				goto followed_path;
				*/
			default:
				THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
		}

		TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
		val = get_unshared_val(ir);
	}

	goto set_val;

followed_path:
	TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
	val = get_unshared_val(ir);

	// target points at the (first) object to replace.  It and its internalRep
	// are unshared

	// If any path elements remain then they need to be created as object
	// keys
	//fprintf(stderr, "After walking path, %d elements remain to be created\n", pathc-i);
	for (; i<pathc; i++) {
		//fprintf(stderr, "create walk %d: %s, cx type: %s\n", i, Tcl_GetString(pathv[i]), type_names_int[type]);
		if (type != JSON_OBJECT) {
			//fprintf(stderr, "Type isn't JSON_OBJECT: %s, replacing with a JSON_OBJECT\n", type_names_int[type]);
			if (val != NULL)
				Tcl_DecrRefCount(val);
			val = Tcl_NewDictObj();
			TEST_OK(JSON_SetIntRep(target, JSON_OBJECT, val));
		}

		target = JSON_NewJvalObj(JSON_OBJECT, Tcl_NewDictObj());
		//fprintf(stderr, "Adding key \"%s\"\n", Tcl_GetString(pathv[i]));
		TEST_OK(Tcl_DictObjPut(interp, val, pathv[i], target));
		TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
		//fprintf(stderr, "Newly added key \"%s\" is of type %s\n", Tcl_GetString(pathv[i]), type_names_int[type]);
		// This was just created - it can't be shared
	}

set_val:
	//fprintf(stderr, "Reached end of path, calling JSON_SetIntRep for replacement value %s (%s), target is %s\n",
	//		type_names_int[newtype], Tcl_GetString(replacement), type_names_int[type]);
	rep = as_json(interp, replacement);

	TEST_OK(JSON_GetJvalFromObj(interp, rep, &newtype, &newval));
	TEST_OK(JSON_SetIntRep(target, newtype, newval));

	Tcl_InvalidateStringRep(src);

	if (interp)
		Tcl_SetObjResult(interp, src);

	return TCL_OK;
}

//}}}
int JSON_Unset(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path) //{{{
{
	enum json_types	type;
	int				i;
	Tcl_Obj*		val;
	Tcl_Obj*		step;
	Tcl_Obj*		src;
	Tcl_Obj*		target;
	int				pathc;
	Tcl_Obj**		pathv = NULL;

	src = Tcl_ObjGetVar2(interp, obj, NULL, TCL_LEAVE_ERR_MSG);
	if (src == NULL)
		return TCL_ERROR;

	TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv));

	if (pathc == 0) {
		Tcl_SetObjResult(interp, src);
		return TCL_OK;	// Do Nothing Gracefully
	}

	if (Tcl_IsShared(src)) {
		src = Tcl_ObjSetVar2(interp, obj, NULL, Tcl_DuplicateObj(src), TCL_LEAVE_ERR_MSG);
		if (src == NULL)
			return TCL_ERROR;
	}

	/*
	fprintf(stderr, "JSON_Set, obj: \"%s\", src: \"%s\"\n",
			Tcl_GetString(obj), Tcl_GetString(src));
			*/
	target = src;

	{
		Tcl_ObjIntRep*	ir = NULL;
		TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
		val = get_unshared_val(ir);
	}

	// Walk the path as far as it exists in src
	//fprintf(stderr, "set, initial type %s\n", type_names[type]);
	for (i=0; i<pathc-1; i++) {
		step = pathv[i];
		//fprintf(stderr, "looking at step %s, cx type: %s\n", Tcl_GetString(step), type_names_int[type]);

		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				TEST_OK(Tcl_DictObjGet(interp, val, step, &target));
				if (target == NULL) {
					goto bad_path;
				}
				if (Tcl_IsShared(target)) {
					//fprintf(stderr, "Path element %d: \"%s\" exists but the TclObj is shared (%d), replacing it with an unshared duplicate\n",
					//		i, Tcl_GetString(step), target->refCount);
					target = Tcl_DuplicateObj(target);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
				}
				break;
				//}}}
			case JSON_ARRAY: //{{{
				{
					int			ac, index_str_len, ok=1;
					long		index;
					const char*	index_str;
					char*		end;
					Tcl_Obj**	av;

					TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
					//fprintf(stderr, "descending into array of length %d\n", ac);

					if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
						// Index isn't an integer, check for end(+/-int)?
						index_str = Tcl_GetStringFromObj(step, &index_str_len);
						if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
							ok = 0;

						if (ok) {
							index = ac-1;
							if (index_str_len >= 4) {
								if (index_str[3] != '-' && index_str[3] != '+') {
									ok = 0;
								} else {
									// errno is magically thread-safe on POSIX
									// systems (it's thread-local)
									errno = 0;
									index += strtol(index_str+3, &end, 10);
									if (errno != 0 || *end != 0)
										ok = 0;
								}
							}
						}

						if (!ok)
							THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

						//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
					} else {
						//fprintf(stderr, "Explicit index: %ld\n", index);
					}

					if (index < 0) {
						goto bad_path;
					} else if (index >= ac) {
						goto bad_path;
					} else {
						target = av[index];
						if (Tcl_IsShared(target)) {
							target = Tcl_DuplicateObj(target);
							TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 1, &target));
						}
						//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
					}
				}
				break;
				//}}}
			case JSON_STRING:
			case JSON_NUMBER:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
				THROW_ERROR("Attempt to index into atomic type ", get_type_name(type), " at path key \"", Tcl_GetString(step), "\"");
				/*
				i++;
				goto bad_path;
				*/
			default:
				THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
		}

		{
			Tcl_ObjIntRep*	ir = NULL;
			TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
			val = get_unshared_val(ir);
		}
		//fprintf(stderr, "Walked on to new type %s\n", type_names[type]);
	}

	//fprintf(stderr, "Reached end of path, calling JSON_SetIntRep for replacement value %s (%s), target is %s\n",
	//		type_names_int[newtype], Tcl_GetString(replacement), type_names_int[type]);

	step = pathv[i];	// This names the key / element to unset
	//fprintf(stderr, "To replace: path step %d: \"%s\"\n", i, Tcl_GetString(step));
	switch (type) {
		case JSON_UNDEF: //{{{
			THROW_ERROR("Found JSON_UNDEF type jval following path");
			//}}}
		case JSON_OBJECT: //{{{
			TEST_OK(Tcl_DictObjRemove(interp, val, step));
			break;
			//}}}
		case JSON_ARRAY: //{{{
			{
				int			ac, index_str_len, ok=1;
				long		index;
				const char*	index_str;
				char*		end;
				Tcl_Obj**	av;

				TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
				//fprintf(stderr, "descending into array of length %d\n", ac);

				if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
					// Index isn't an integer, check for end(+/-int)?
					index_str = Tcl_GetStringFromObj(step, &index_str_len);
					if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
						ok = 0;

					if (ok) {
						index = ac-1;
						if (index_str_len >= 4) {
							if (index_str[3] != '-' && index_str[3] != '+') {
								ok = 0;
							} else {
								// errno is magically thread-safe on POSIX
								// systems (it's thread-local)
								errno = 0;
								index += strtol(index_str+3, &end, 10);
								if (errno != 0 || *end != 0)
									ok = 0;
							}
						}
					}

					if (!ok)
						THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

					//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
				} else {
					//fprintf(stderr, "Explicit index: %ld\n", index);
				}
				//fprintf(stderr, "Removing array index %d of %d\n", index, ac);

				if (index < 0) {
					break;
				} else if (index >= ac) {
					break;
				} else {
					TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 0, NULL));
					//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
				}
			}
			break;
			//}}}
		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
		case JSON_NULL:
		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			{
				Tcl_Obj* bad_path = NULL;

				Tcl_IncrRefCount(bad_path = Tcl_NewListObj(i+1, pathv));
				Tcl_SetErrorCode(interp, "RL", "JSON", "BAD_PATH", Tcl_GetString(bad_path), NULL);
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Attempt to index into atomic type %s at path \"%s\"", get_type_name(type), Tcl_GetString(bad_path)));
				Tcl_DecrRefCount(bad_path); bad_path = NULL;
				return TCL_ERROR;
			}
		default:
			THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
	}

	Tcl_InvalidateStringRep(src);

	if (interp)
		Tcl_SetObjResult(interp, src);

	return TCL_OK;

bad_path:
	{
		Tcl_Obj* bad_path = NULL;

		Tcl_IncrRefCount(bad_path = Tcl_NewListObj(i+1, pathv));
		Tcl_SetErrorCode(interp, "RL", "JSON", "BAD_PATH", Tcl_GetString(bad_path), NULL);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Path element \"%s\" doesn't exist", Tcl_GetString(bad_path)));
		Tcl_DecrRefCount(bad_path); bad_path = NULL;
		return TCL_ERROR;
	}
}

//}}}
int JSON_Normalize(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** normalized) //{{{
{
	int				retval = TCL_OK;
	Tcl_Obj*		json = NULL;
	enum json_types	type;

	type = JSON_GetJSONType(obj);

	if (type != JSON_UNDEF && !Tcl_HasStringRep(obj))
		return TCL_OK;		// Nothing to do - already parsed as json and have no string rep

	if (Tcl_IsShared(obj)) {
		replace_tclobj(&json, Tcl_DuplicateObj(obj));
	} else {
		replace_tclobj(&json, obj);
	}

	retval = JSON_ForceJSON(interp, json);
	Tcl_InvalidateStringRep(json);			// Defer string rep generation to our caller

	if (retval == TCL_OK)
		replace_tclobj(normalized, json);

	release_tclobj(&json);

	return retval;
}

//}}}
int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, Tcl_Obj** prettyString) //{{{
{
	int					retval = TCL_OK;
	Tcl_DString			ds;
	Tcl_Obj*			pad = NULL;
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	if (indent == NULL)
		replace_tclobj(&indent, get_string(l, "    ", 4));

	replace_tclobj(&pad, l->tcl_empty);
	Tcl_DStringInit(&ds);
	retval = json_pretty(interp, obj, indent, pad, &ds);

	if (retval == TCL_OK)
		replace_tclobj(prettyString, Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));

	Tcl_DStringFree(&ds);
	release_tclobj(&pad);
	release_tclobj(&indent);

	return retval;
}

//}}}
int JSON_Template(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* dict, Tcl_Obj** res) //{{{
{
	//struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	Tcl_Obj*			actions = NULL;
	int					retcode = TCL_OK;
	Tcl_ObjIntRep*		ir;
	enum json_types		type;

	TEST_OK(JSON_GetIntrepFromObj(interp, template, &type, &ir));

	replace_tclobj(&actions, ir->twoPtrValue.ptr2);
	if (actions == NULL) {
		TEST_OK(build_template_actions(interp, template, &actions));
		replace_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2, actions);
	}

	retcode = apply_template_actions(interp, template, actions, dict, res);
	release_tclobj(&actions);

	return retcode;
}

//}}}
int JSON_IsNULL(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* isnull) //{{{
{
	int			retval = TCL_OK;
	Tcl_Obj*	jval = NULL;

	retval = JSON_Extract(interp, obj, path, &jval);

	if (retval == TCL_OK)
		*isnull = (JSON_NULL == JSON_GetJSONType(jval));

	release_tclobj(&jval);

	return retval;
}

//}}}
int JSON_Type(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, enum json_types* type) //{{{
{
	int			retval = TCL_OK;
	Tcl_Obj*	jval = NULL;

	retval = JSON_Extract(interp, obj, path, &jval);

	if (retval == TCL_OK)
		*type = JSON_GetJSONType(jval);

	release_tclobj(&jval);

	return retval;
}

//}}}
int JSON_Length(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* length) //{{{
{
	enum json_types	type;
	int				retval = TCL_OK;
	Tcl_Obj*		val = NULL;
	Tcl_Obj*		target = NULL;

	TEST_OK_LABEL(finally, retval, JSON_Extract(interp, obj, path, &target));

	TEST_OK_LABEL(finally, retval, JSON_GetJvalFromObj(interp, target, &type, &val));

	switch (type) {
		case JSON_ARRAY:  retval = Tcl_ListObjLength(interp, val, length); break;
		case JSON_OBJECT: retval = Tcl_DictObjSize(interp, val, length);   break;

		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:   *length = Tcl_GetCharLength(val) + 3; break;	// dynamic types have a 3 character prefix
		case JSON_STRING:        *length = Tcl_GetCharLength(val);     break;

		default:
			Tcl_SetObjResult(interp, Tcl_ObjPrintf("Named JSON value type isn't supported: %s", get_type_name(type)));
			retval = TCL_ERROR;
	}

finally:
	release_tclobj(&target);

	return retval;
}

//}}}
int JSON_Keys(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** keyslist) //{{{
{
	enum json_types		type;
	int					retval = TCL_OK;
	Tcl_Obj*			val = NULL;
	Tcl_Obj*			target = NULL;

	TEST_OK_LABEL(finally, retval, JSON_Extract(interp, obj, path, &target));
	TEST_OK_LABEL(finally, retval, JSON_GetJvalFromObj(interp, target, &type, &val));

	if (type != JSON_OBJECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Named JSON value type isn't supported: %s", get_type_name(type)));
		retval = TCL_ERROR;
	} else {
		Tcl_Obj*		res = NULL;
		Tcl_Obj*		k = NULL;
		Tcl_Obj*		v = NULL;
		Tcl_DictSearch	search;
		int				done;

		replace_tclobj(&res, Tcl_NewListObj(0, NULL));

		TEST_OK_LABEL(finally, retval, Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));
		for (; !done; Tcl_DictObjNext(&search, &k, &v, &done))
			TEST_OK_BREAK(retval, Tcl_ListObjAppendElement(interp, res, k));
		Tcl_DictObjDone(&search);

		if (retval == TCL_OK)
			replace_tclobj(keyslist, res);

		release_tclobj(&res);
	}

finally:
	release_tclobj(&target);

	return retval;
}

//}}}
int JSON_Decode(Tcl_Interp* interp, Tcl_Obj* bytes, Tcl_Obj* encoding, Tcl_Obj** decodedstring) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	Tcl_Obj*			ov[4];
	int					i, retval;

	ov[0] = l->apply;
	ov[1] = l->decode_bytes;
	ov[2] = bytes;
	ov[3] = encoding;

	for (i=0; i<4 && ov[i]; i++) if (ov[i]) Tcl_IncrRefCount(ov[i]);
	retval = Tcl_EvalObjv(interp, i, ov, TCL_EVAL_GLOBAL);
	for (i=0; i<4 && ov[i]; i++) release_tclobj(&ov[i]);

	if (retval == TCL_OK) {
		replace_tclobj(decodedstring, Tcl_GetObjResult(interp));
		Tcl_ResetResult(interp);
	}

	return retval;
}

//}}}
int JSON_Foreach(Tcl_Interp* interp, Tcl_Obj* iterators, int* body, enum collecting_mode collect, Tcl_Obj** res, ClientData cdata)
{
	THROW_ERROR("Not implemented yet");
}
int JSON_Valid(Tcl_Interp* interp, Tcl_Obj* json, int* valid, enum extensions extensions, struct parse_error* details)
{
	struct interp_cx*		l = NULL;
	const unsigned char*	err_at = NULL;
	const char*				errmsg = "Illegal character";
	size_t					char_adj = 0;		// Offset addjustment to account for multibyte UTF-8 sequences
	const unsigned char*	doc;
	enum json_types			type;
	const unsigned char*	p;
	const unsigned char*	e;
	const unsigned char*	val_start;
	int						len;
	struct parse_context	cx[CX_STACK_SIZE];

	if (interp)
		l = Tcl_GetAssocData(interp, "rl_json", NULL);

#if 1
	// Snoop on the intrep for clues on optimized conversions {{{
	{
		if (
			l && (
				(l->typeInt    && Tcl_FetchIntRep(json, l->typeInt)    != NULL) ||
				(l->typeDouble && Tcl_FetchIntRep(json, l->typeDouble) != NULL) ||
				(l->typeBignum && Tcl_FetchIntRep(json, l->typeBignum) != NULL)
			)
		) {
			*valid = 1;
			return TCL_OK;
		}
	}
	// Snoop on the intrep for clues on optimized conversions }}}
#endif

	cx[0].prev = NULL;
	cx[0].last = cx;
	cx[0].hold_key = NULL;
	cx[0].container = JSON_UNDEF;
	cx[0].val = NULL;
	cx[0].char_ofs = 0;
	cx[0].closed = 0;
	cx[0].l = l;
	cx[0].mode = VALIDATE;

	p = doc = (const unsigned char*)Tcl_GetStringFromObj(json, &len);
	e = p + len;

	// Skip BOM
	if (
		len >= 3 &&
		p[0] == 0xef &&
		p[1] == 0xbb &&
		p[2] == 0xbf
	) {
		p += 3;
	}	

	// Skip leading whitespace and comments
	if (skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0) goto whitespace_err;

	if (unlikely(p >= e)) {
		err_at = p;
		errmsg = "No JSON value found";
		goto whitespace_err;
	}

	while (p < e) {
		if (cx[0].last->container == JSON_OBJECT) { // Read the key if in object mode {{{
			const unsigned char*	key_start = p;
			size_t					key_start_char_adj = char_adj;

			if (value_type(l, doc, p, e, &char_adj, &p, &type, NULL, details) != TCL_OK) goto invalid;

			switch (type) {
				case JSON_DYN_STRING:
				case JSON_DYN_NUMBER:
				case JSON_DYN_BOOL:
				case JSON_DYN_JSON:
				case JSON_DYN_TEMPLATE:
				case JSON_DYN_LITERAL:
				case JSON_STRING:
					break;

				default:
					parse_error(details, "Object key is not a string", doc, (key_start-doc) - key_start_char_adj);
					goto invalid;
			}

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

			if (unlikely(*p != ':')) {
				parse_error(details, "Expecting : after object key", doc, (p-doc) - char_adj);
				goto invalid;
			}
			p++;

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		}
		//}}}

		val_start = p;
		if (value_type(l, doc, p, e, &char_adj, &p, &type, NULL, details) != TCL_OK) goto invalid;

		switch (type) {
			case JSON_OBJECT:
				push_parse_context(cx, JSON_OBJECT, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_ARRAY:
				push_parse_context(cx, JSON_ARRAY, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
			case JSON_STRING:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_NUMBER:
				if (unlikely(cx->last->container != JSON_OBJECT && cx->last->container != JSON_ARRAY))
					cx->last->container = type;	// Record our type (at the document top-level)
				break;

			default:
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Unexpected json value type: %d", type));
				goto err;
		}

after_value:	// Yeah, goto.  But the alternative abusing loops was worse
		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		if (p >= e) break;

		if (unlikely(cx[0].last->closed)) {
			parse_error(details, "Trailing garbage after value", doc, (p-doc) - char_adj);
			goto invalid;
		}

		switch (cx[0].last->container) { // Handle eof and end-of-context or comma for array and object {{{
			case JSON_OBJECT:
				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					parse_error(details, "Expecting } or ,", doc, (p-doc) - char_adj);
					goto invalid;
				}

				p++;
				break;

			case JSON_ARRAY:
				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					parse_error(details, "Expecting ] or ,", doc, (p-doc) - char_adj);
					goto invalid;
				}

				p++;
				break;

			default:
				if (unlikely(p < e)) {
					parse_error(details, "Trailing garbage after value", doc, (p - doc) - char_adj);
					goto invalid;
				}
		}

		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		//}}}
	}

	if (unlikely(cx != cx[0].last || !cx[0].closed)) { // Unterminated object or array context {{{
		switch (cx[0].last->container) {
			case JSON_OBJECT:
				parse_error(details, "Unterminated object", doc, cx[0].last->char_ofs);
				goto invalid;

			case JSON_ARRAY:
				parse_error(details, "Unterminated array", doc, cx[0].last->char_ofs);
				goto invalid;

			default:	// Suppress compiler warning
				break;
		}
	}
	//}}}

	*valid = 1;
	return TCL_OK;

whitespace_err:
	parse_error(details, errmsg, doc, (err_at - doc) - char_adj);

invalid:
	free_cx(cx);

	// This was a parse error, which is a successful outcome for us
	*valid = 0;
	return TCL_OK;

err:
	free_cx(cx);
	return TCL_ERROR;
}

/* Local Variables: */
/* tab-width: 4 */
/* c-basic-offset: 4 */
/* End: */
// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4

Added jni/rl_json/generic/dedup.c.































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#if DEDUP

#if FFS == ffsll
#define _GNU_SOURCE		// For glibc extension ffsll
#endif

#include "rl_jsonInt.h"

static int first_free(FREEMAP_TYPE* freemap) //{{{
{
	int	i=0, bit, res;
	FFS_TMP_STORAGE;

	while ((bit = FFS(freemap[i])) == 0) i++;
	res = i * (sizeof(FREEMAP_TYPE)*8) + (bit-1);
	return res;
}

//}}}
static void mark_used(FREEMAP_TYPE* freemap, int idx) //{{{
{
	int	i = idx / (sizeof(FREEMAP_TYPE)*8);
	int bit = idx - (i * (sizeof(FREEMAP_TYPE)*8));
	freemap[i] &= ~(1LL << bit);
}

//}}}
static void mark_free(FREEMAP_TYPE* freemap, int idx) //{{{
{
	int	i = idx / (sizeof(FREEMAP_TYPE)*8);
	int bit = idx - (i * (sizeof(FREEMAP_TYPE)*8));
	freemap[i] |= 1LL << bit;
}

//}}}
void free_cache(struct interp_cx* l) //{{{
{
	Tcl_HashEntry*		he;
	Tcl_HashSearch		search;
	struct kc_entry*	e;

	he = Tcl_FirstHashEntry(&l->kc, &search);
	while (he) {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(he);

		//if (idx >= KC_ENTRIES) Tcl_Panic("age_cache: idx (%ld) is out of bounds, KC_ENTRIES: %d", idx, KC_ENTRIES);
		//printf("age_cache: kc_count: %d", l->kc_count);
		e = &l->kc_entries[idx];

		Tcl_DeleteHashEntry(he);
		Tcl_DecrRefCount(e->val);
		Tcl_DecrRefCount(e->val);	// Two references - one for the cache table and one on loan to callers' interim processing
		mark_free(l->freemap, idx);
		e->val = NULL;
		he = Tcl_NextHashEntry(&search);
	}
	l->kc_count = 0;
}

//}}}
static void age_cache(struct interp_cx* l) //{{{
{
	Tcl_HashEntry*		he;
	Tcl_HashSearch		search;
	struct kc_entry*	e;

	he = Tcl_FirstHashEntry(&l->kc, &search);
	while (he) {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(he);

		//if (idx >= KC_ENTRIES) Tcl_Panic("age_cache: idx (%ld) is out of bounds, KC_ENTRIES: %d", idx, KC_ENTRIES);
		//printf("age_cache: kc_count: %d", l->kc_count);
		e = &l->kc_entries[idx];

		if (e->hits < 1) {
			Tcl_DeleteHashEntry(he);
			Tcl_DecrRefCount(e->val);
			Tcl_DecrRefCount(e->val);	// Two references - one for the cache table and one on loan to callers' interim processing
			mark_free(l->freemap, idx);
			e->val = NULL;
		} else {
			e->hits >>= 1;
		}
		he = Tcl_NextHashEntry(&search);
	}
	l->kc_count = 0;
}

//}}}
Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, int length) //{{{
{
	char				buf[STRING_DEDUP_MAX + 1];
	const char			*keyname;
	int					is_new;
	struct kc_entry*	kce;
	Tcl_Obj*			out;
	Tcl_HashEntry*		entry = NULL;

	if (l == NULL)
		return Tcl_NewStringObj(bytes, length);

	if (length == 0) {
		return l->tcl_empty;
	} else if (length < 0) {
		length = strlen(bytes);
	}

	if (length > STRING_DEDUP_MAX)
		return Tcl_NewStringObj(bytes, length);

	if (likely(bytes[length] == 0)) {
		keyname = bytes;
	} else {
		memcpy(buf, bytes, length);
		buf[length] = 0;
		keyname = buf;
	}
	entry = Tcl_CreateHashEntry(&l->kc, keyname, &is_new);

	if (is_new) {
		ptrdiff_t	idx = first_free(l->freemap);

		if (unlikely(idx >= KC_ENTRIES)) {
			// Cache overflow
			Tcl_DeleteHashEntry(entry);
			age_cache(l);
			return Tcl_NewStringObj(bytes, length);
		}

		kce = &l->kc_entries[idx];
		kce->hits = 0;
		out = kce->val = Tcl_NewStringObj(bytes, length);
		Tcl_IncrRefCount(out);	// Two references - one for the cache table and one on loan to callers' interim processing.
		Tcl_IncrRefCount(out);	// Without this, values not referenced elsewhere could reach callers with refCount 1, allowing
								// the value to be mutated in place and corrupt the state of the cache (hash key not matching obj value)

		mark_used(l->freemap, idx);

		Tcl_SetHashValue(entry, (void*)idx);
		l->kc_count++;

		if (unlikely(l->kc_count > (int)(KC_ENTRIES/2.5))) {
			kce->hits++; // Prevent the just-created entry from being pruned
			age_cache(l);
		}
	} else {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(entry);

		kce = &l->kc_entries[idx];
		out = kce->val;
		if (kce->hits < 255) kce->hits++;
	}

	return out;
}

//}}}

#endif

Added jni/rl_json/generic/dedup.h.

































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#ifndef _DEDUP_H
#define _DEDUP_H

#if DEDUP
#define STRING_DEDUP_MAX	16

void free_cache(struct interp_cx* l);
Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, int length);
#	define get_string(l, bytes, length)	new_stringobj_dedup(l, bytes, length)
#else
#	define free_cache(l)	// nop
#	define get_string(l, bytes, length) Tcl_NewStringObj(bytes, length)
#endif


#endif

Added jni/rl_json/generic/json_types.c.



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
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
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
#include "rl_jsonInt.h"
#include "parser.h"

static void free_internal_rep(Tcl_Obj* obj, Tcl_ObjType* objtype);
static void dup_internal_rep(Tcl_Obj* src, Tcl_Obj* dest, Tcl_ObjType* objtype);
static void update_string_rep(Tcl_Obj* obj, Tcl_ObjType* objtype);
static int set_from_any(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_ObjType** objtype, enum json_types* type);

extern Tcl_ObjType json_object;
extern Tcl_ObjType json_array;
extern Tcl_ObjType json_string;
extern Tcl_ObjType json_number;
extern Tcl_ObjType json_bool;
extern Tcl_ObjType json_null;
extern Tcl_ObjType json_dyn_string;
extern Tcl_ObjType json_dyn_number;
extern Tcl_ObjType json_dyn_bool;
extern Tcl_ObjType json_dyn_json;
extern Tcl_ObjType json_dyn_template;
extern Tcl_ObjType json_dyn_literal;

static void free_internal_rep_object(Tcl_Obj* obj)                { free_internal_rep(obj, &json_object);      }
static void dup_internal_rep_object(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_object); }
static void update_string_rep_object(Tcl_Obj* obj)                { update_string_rep(obj, &json_object);      }

static void free_internal_rep_array(Tcl_Obj* obj)                { free_internal_rep(obj, &json_array);      }
static void dup_internal_rep_array(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_array); }
static void update_string_rep_array(Tcl_Obj* obj)                { update_string_rep(obj, &json_array);      }

static void free_internal_rep_string(Tcl_Obj* obj)                { free_internal_rep(obj, &json_string);      }
static void dup_internal_rep_string(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_string); }
static void update_string_rep_string(Tcl_Obj* obj);

static void free_internal_rep_number(Tcl_Obj* obj)                { free_internal_rep(obj, &json_number);      }
static void dup_internal_rep_number(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_number); }
static void update_string_rep_number(Tcl_Obj* obj);

static void free_internal_rep_bool(Tcl_Obj* obj)                { free_internal_rep(obj, &json_bool);      }
static void dup_internal_rep_bool(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_bool); }
static void update_string_rep_bool(Tcl_Obj* obj);

static void free_internal_rep_null(Tcl_Obj* obj)                { free_internal_rep(obj, &json_null);      }
static void dup_internal_rep_null(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_null); }
static void update_string_rep_null(Tcl_Obj* obj);

static void free_internal_rep_dyn_string(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_string);      }
static void dup_internal_rep_dyn_string(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_string); }
static void update_string_rep_dyn_string(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_string);      }

static void free_internal_rep_dyn_number(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_number);      }
static void dup_internal_rep_dyn_number(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_number); }
static void update_string_rep_dyn_number(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_number);      }

static void free_internal_rep_dyn_bool(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_bool);      }
static void dup_internal_rep_dyn_bool(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_bool); }
static void update_string_rep_dyn_bool(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_bool);      }

static void free_internal_rep_dyn_json(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_json);      }
static void dup_internal_rep_dyn_json(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_json); }
static void update_string_rep_dyn_json(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_json);      }

static void free_internal_rep_dyn_template(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_template);      }
static void dup_internal_rep_dyn_template(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_template); }
static void update_string_rep_dyn_template(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_template);      }

static void free_internal_rep_dyn_literal(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_literal);      }
static void dup_internal_rep_dyn_literal(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_literal); }
static void update_string_rep_dyn_literal(Tcl_Obj* obj);

Tcl_ObjType json_object = {
	"JSON_object",
	free_internal_rep_object,
	dup_internal_rep_object,
	update_string_rep_object,
	NULL
};
Tcl_ObjType json_array = {
	"JSON_array",
	free_internal_rep_array,
	dup_internal_rep_array,
	update_string_rep_array,
	NULL
};
Tcl_ObjType json_string = {
	"JSON_string",
	free_internal_rep_string,
	dup_internal_rep_string,
	update_string_rep_string,
	NULL
};
Tcl_ObjType json_number = {
	"JSON_number",
	free_internal_rep_number,
	dup_internal_rep_number,
	update_string_rep_number,
	NULL
};
Tcl_ObjType json_bool = {
	"JSON_bool",
	free_internal_rep_bool,
	dup_internal_rep_bool,
	update_string_rep_bool,
	NULL
};
Tcl_ObjType json_null = {
	"JSON_null",
	free_internal_rep_null,
	dup_internal_rep_null,
	update_string_rep_null,
	NULL
};
Tcl_ObjType json_dyn_string = {
	"JSON_dyn_string",
	free_internal_rep_dyn_string,
	dup_internal_rep_dyn_string,
	update_string_rep_dyn_string,
	NULL
};
Tcl_ObjType json_dyn_number = {
	"JSON_dyn_number",
	free_internal_rep_dyn_number,
	dup_internal_rep_dyn_number,
	update_string_rep_dyn_number,
	NULL
};
Tcl_ObjType json_dyn_bool = {
	"JSON_dyn_bool",
	free_internal_rep_dyn_bool,
	dup_internal_rep_dyn_bool,
	update_string_rep_dyn_bool,
	NULL
};
Tcl_ObjType json_dyn_json = {
	"JSON_dyn_json",
	free_internal_rep_dyn_json,
	dup_internal_rep_dyn_json,
	update_string_rep_dyn_json,
	NULL
};
Tcl_ObjType json_dyn_template = {
	"JSON_dyn_template",
	free_internal_rep_dyn_template,
	dup_internal_rep_dyn_template,
	update_string_rep_dyn_template,
	NULL
};
Tcl_ObjType json_dyn_literal = {
	"JSON_dyn_literal",
	free_internal_rep_dyn_literal,
	dup_internal_rep_dyn_literal,
	update_string_rep_dyn_literal,
	NULL
};

Tcl_ObjType* g_objtype_for_type[JSON_TYPE_MAX];


int JSON_IsJSON(Tcl_Obj* obj, enum json_types* type, Tcl_ObjIntRep** ir) //{{{
{
	enum json_types		t;
	Tcl_ObjIntRep*		_ir = NULL;

	for (t=JSON_OBJECT; t<JSON_TYPE_MAX && _ir==NULL; t++)
		_ir = Tcl_FetchIntRep(obj, g_objtype_for_type[t]);
	t--;

	if (_ir == NULL)
		return 0;

	*ir = _ir;
	*type = t;
	return 1;
}

//}}}
int JSON_GetIntrepFromObj(Tcl_Interp* interp, Tcl_Obj* obj, enum json_types* type, Tcl_ObjIntRep** ir) //{{{
{
	enum json_types		t;
	Tcl_ObjIntRep*		_ir = NULL;
	Tcl_ObjType*		objtype = NULL;

	if (!JSON_IsJSON(obj, &t, &_ir)) {
		TEST_OK(set_from_any(interp, obj, &objtype, &t));
		_ir = Tcl_FetchIntRep(obj, objtype);
		if (_ir == NULL) Tcl_Panic("Could not retrieve the intrep we just created");
	}

	*type = t;
	*ir = _ir;

	return TCL_OK;
}

//}}}
int JSON_GetJvalFromObj(Tcl_Interp* interp, Tcl_Obj* obj, enum json_types* type, Tcl_Obj** val) //{{{
{
	Tcl_ObjIntRep*		ir = NULL;

	TEST_OK(JSON_GetIntrepFromObj(interp, obj, type, &ir));

	*val = ir->twoPtrValue.ptr1;

	return TCL_OK;
}

//}}}
int JSON_SetIntRep(Tcl_Obj* target, enum json_types type, Tcl_Obj* replacement) //{{{
{
	Tcl_ObjIntRep		intrep;
	Tcl_ObjType*		objtype = NULL;

	if (Tcl_IsShared(target))
		Tcl_Panic("Called JSON_SetIntRep on a shared object");

	objtype = g_objtype_for_type[type];

	Tcl_FreeIntRep(target);

	intrep.twoPtrValue.ptr1 = replacement;		// ptr1 is the Tcl_Obj holding the Tcl structure for this value
	if (replacement) Tcl_IncrRefCount((Tcl_Obj*)intrep.twoPtrValue.ptr1);

	intrep.twoPtrValue.ptr2 = NULL;				// ptr2 holds the template actions, if any have been generated for this value

	Tcl_StoreIntRep(target, objtype, &intrep);

	Tcl_InvalidateStringRep(target);

	return TCL_OK;
}

//}}}
#ifdef TCL_MEM_DEBUG
Tcl_Obj* JSON_DbNewJvalObj(enum json_types type, Tcl_Obj* val, const char* file, int line)
#else
Tcl_Obj* JSON_NewJvalObj(enum json_types type, Tcl_Obj* val)
#endif
{ //{{{
#ifdef TCL_MEM_DEBUG
	Tcl_Obj*	res = Tcl_DbNewObj(file, line);
#else
	Tcl_Obj*	res = Tcl_NewObj();
#endif

	/*
	switch (type) {
		case JSON_OBJECT:
		case JSON_ARRAY:
		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
		case JSON_NULL:

		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			break;

		default:
			Tcl_Panic("JSON_NewJvalObj, unhandled type: %d", type);
	}
	*/

	if (JSON_SetIntRep(res, type, val) != TCL_OK)
		Tcl_Panic("Couldn't set JSON intrep");

	return res;
}

//}}}

static void free_internal_rep(Tcl_Obj* obj, Tcl_ObjType* objtype) //{{{
{
	Tcl_ObjIntRep*		ir = NULL;

	ir = Tcl_FetchIntRep(obj, objtype);
	if (ir != NULL) {
		release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr1);
		release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);

#if 0
		//Tcl_Obj* ir_obj = ir->twoPtrValue.ptr1;
		Tcl_Obj* actions = ir->twoPtrValue.ptr2;
		if (ir->twoPtrValue.ptr1) {
			/*
			fprintf(stderr, "%s Releasing ptr1 %p, refcount %d, which is %s\n",
					objtype->name, ir->twoPtrValue.ptr1, ir_obj == NULL ? -42 : ir_obj->refCount,
					ir_obj->typePtr ? ir_obj->typePtr->name : "pure string"
				   );
				   */
			Tcl_DecrRefCount((Tcl_Obj*)ir->twoPtrValue.ptr1); ir->twoPtrValue.ptr1 = NULL;}
		if (ir->twoPtrValue.ptr2 && actions->refCount > 0) {
			/*
			fprintf(stderr, "%s Releasing ptr2 %p, refcount %d, which is %s\n",
					objtype->name, ir->twoPtrValue.ptr2, actions == NULL ? -42 : actions->refCount,
					actions->typePtr ? actions->typePtr->name : "pure string"
				   );
				   */
			Tcl_DecrRefCount((Tcl_Obj*)ir->twoPtrValue.ptr2); ir->twoPtrValue.ptr2 = NULL;}
#endif
	}
}

//}}}
static void dup_internal_rep(Tcl_Obj* src, Tcl_Obj* dest, Tcl_ObjType* objtype) //{{{
{
	Tcl_ObjIntRep*		srcir = NULL;
	Tcl_ObjIntRep		destir;

	srcir = Tcl_FetchIntRep(src, objtype);
	if (srcir == NULL)
		Tcl_Panic("dup_internal_rep asked to duplicate for type, but that type wasn't available on the src object");

	if (src == srcir->twoPtrValue.ptr1) {
		int			len;
		const char*	str = Tcl_GetStringFromObj((Tcl_Obj*)srcir->twoPtrValue.ptr1, &len);
		// Don't know how this happens yet, but it's bad news - we get into an endless recursion of duplicateobj calls until the stack blows up

		// Panic and go via the string rep
		Tcl_IncrRefCount((Tcl_Obj*)(destir.twoPtrValue.ptr1 = Tcl_NewStringObj(str, len)));
	} else {
		destir.twoPtrValue.ptr1 = srcir->twoPtrValue.ptr1;
	}

	destir.twoPtrValue.ptr2 = srcir->twoPtrValue.ptr2;
	if (destir.twoPtrValue.ptr1) Tcl_IncrRefCount((Tcl_Obj*)destir.twoPtrValue.ptr1);
	if (destir.twoPtrValue.ptr2) Tcl_IncrRefCount((Tcl_Obj*)destir.twoPtrValue.ptr2);

	Tcl_StoreIntRep(dest, objtype, &destir);
}

//}}}
static void update_string_rep(Tcl_Obj* obj, Tcl_ObjType* objtype) //{{{
{
	Tcl_ObjIntRep*				ir = Tcl_FetchIntRep(obj, objtype);
	struct serialize_context	scx;
	Tcl_DString					ds;

	if (ir == NULL)
		Tcl_Panic("dup_internal_rep asked to duplicate for type, but that type wasn't available on the src object");

	Tcl_DStringInit(&ds);

	scx.ds = &ds;
	scx.serialize_mode = SERIALIZE_NORMAL;
	scx.fromdict = NULL;
	scx.l = NULL;
	scx.allow_null = 1;

	serialize(NULL, &scx, obj);

	obj->length = Tcl_DStringLength(&ds);
	obj->bytes = ckalloc(obj->length + 1);
	memcpy(obj->bytes, Tcl_DStringValue(&ds), obj->length);
	obj->bytes[obj->length] = 0;

	Tcl_DStringFree(&ds);	scx.ds = NULL;
}

//}}}
static void update_string_rep_string(Tcl_Obj* obj) //{{{
{
	update_string_rep(obj, &json_string);
	/*
	Tcl_ObjIntRep*	ir = Tcl_FetchIntRep(obj, &json_string);
	const char*		str;
	int				len;

	str = Tcl_GetStringFromObj((Tcl_Obj*)ir->twoPtrValue.ptr1, &len);
	obj->bytes = ckalloc(len+3);
	obj->bytes[0] = '"';
	memcpy(obj->bytes+1, str, len);
	obj->bytes[len+1] = '"';
	obj->bytes[len+2] = 0;
	obj->length = len+2;
	*/
}

//}}}
static void update_string_rep_number(Tcl_Obj* obj) //{{{
{
	Tcl_ObjIntRep*	ir = Tcl_FetchIntRep(obj, &json_number);
	const char*		str;
	int				len;

	if (ir->twoPtrValue.ptr1 == obj)
		Tcl_Panic("Turtles all the way down!");

	str = Tcl_GetStringFromObj((Tcl_Obj*)ir->twoPtrValue.ptr1, &len);
	obj->bytes = ckalloc(len+1);
	memcpy(obj->bytes, str, len+1);
	obj->length = len;
}

//}}}
static void update_string_rep_bool(Tcl_Obj* obj) //{{{
{
	Tcl_ObjIntRep*	ir = Tcl_FetchIntRep(obj, &json_bool);
	int				boolval;

	if (Tcl_GetBooleanFromObj(NULL, (Tcl_Obj*)ir->twoPtrValue.ptr1, &boolval) != TCL_OK)
		Tcl_Panic("json_bool's intrep tclobj is not a boolean");

	if (boolval) {
		obj->bytes = ckalloc(5);
		memcpy(obj->bytes, "true", 5);
		obj->length = 4;
	} else {
		obj->bytes = ckalloc(6);
		memcpy(obj->bytes, "false", 6);
		obj->length = 5;
	}
}

//}}}
static void update_string_rep_null(Tcl_Obj* obj) //{{{
{
	obj->bytes = ckalloc(5);
	memcpy(obj->bytes, "null", 5);
	obj->length = 4;
}

//}}}
static void update_string_rep_dyn_literal(Tcl_Obj* obj) //{{{
{
	update_string_rep(obj, &json_dyn_literal);
	/*
	Tcl_ObjIntRep*	ir = Tcl_FetchIntRep(obj, &json_dyn_literal);
	const char*		str;
	int				len;

	str = Tcl_GetStringFromObj((Tcl_Obj*)ir->twoPtrValue.ptr1, &len);
	obj->bytes = ckalloc(len+6);
	obj->bytes[0] = '"';
	obj->bytes[1] = '~';
	obj->bytes[2] = 'L';
	obj->bytes[3] = ':';
	memcpy(obj->bytes+4, str, len);
	obj->bytes[len+4] = '"';
	obj->bytes[len+5] = 0;
	obj->length = len+5;
	*/
}

//}}}
static int set_from_any(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_ObjType** objtype, enum json_types* out_type) //{{{
{
	struct interp_cx*		l = NULL;
	const unsigned char*	err_at = NULL;
	const char*				errmsg = "Illegal character";
	size_t					char_adj = 0;		// Offset addjustment to account for multibyte UTF-8 sequences
	const unsigned char*	doc;
	enum json_types			type;
	Tcl_Obj*				val = NULL;
	const unsigned char*	p;
	const unsigned char*	e;
	const unsigned char*	val_start;
	int						len;
	struct parse_context	cx[CX_STACK_SIZE];
	enum extensions			extensions = EXT_COMMENTS;
	struct parse_error		details = {};

	if (interp)
		l = Tcl_GetAssocData(interp, "rl_json", NULL);

#if 1
	// Snoop on the intrep for clues on optimized conversions {{{
	{
		if (
			l && (
				(l->typeInt    && Tcl_FetchIntRep(obj, l->typeInt)    != NULL) ||
				(l->typeDouble && Tcl_FetchIntRep(obj, l->typeDouble) != NULL) ||
				(l->typeBignum && Tcl_FetchIntRep(obj, l->typeBignum) != NULL)
			)
		) {
			Tcl_ObjIntRep			ir = {.twoPtrValue = {}};

			// Must dup because obj will soon be us, creating a circular ref
			replace_tclobj((Tcl_Obj**)&ir.twoPtrValue.ptr1, Tcl_DuplicateObj(obj));
			release_tclobj((Tcl_Obj**)&ir.twoPtrValue.ptr2);

			*out_type = JSON_NUMBER;
			*objtype = g_objtype_for_type[JSON_NUMBER];

			Tcl_StoreIntRep(obj, *objtype, &ir);
			return TCL_OK;
		}
	}
	// Snoop on the intrep for clues on optimized conversions }}}
#endif

	cx[0].prev = NULL;
	cx[0].last = cx;
	cx[0].hold_key = NULL;
	cx[0].container = JSON_UNDEF;
	cx[0].val = NULL;
	cx[0].char_ofs = 0;
	cx[0].closed = 0;
	cx[0].l = l;
	cx[0].mode = PARSE;

	p = doc = (const unsigned char*)Tcl_GetStringFromObj(obj, &len);
	e = p + len;

	// Skip BOM
	if (
		len >= 3 &&
		p[0] == 0xef &&
		p[1] == 0xbb &&
		p[2] == 0xbf
	) {
		p += 3;
	}	

	// Skip leading whitespace and comments
	if (skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0) goto whitespace_err;

	while (p < e) {
		if (cx[0].last->container == JSON_OBJECT) { // Read the key if in object mode {{{
			const unsigned char*	key_start = p;
			size_t					key_start_char_adj = char_adj;

			if (value_type(l, doc, p, e, &char_adj, &p, &type, &val, &details) != TCL_OK) goto err;

			switch (type) {
				case JSON_DYN_STRING:
				case JSON_DYN_NUMBER:
				case JSON_DYN_BOOL:
				case JSON_DYN_JSON:
				case JSON_DYN_TEMPLATE:
				case JSON_DYN_LITERAL:
					/* Add back the template format prefix, since we can't store the type
					 * in the dict key.  The template generation code reparses it later.
					 */
					{
						Tcl_Obj*	new = Tcl_ObjPrintf("~%c:%s", key_start[2], Tcl_GetString(val));
						replace_tclobj(&val, new);
						// Can do this because val's ref is on loan from new_stringobj_dedup
						//val = Tcl_ObjPrintf("~%c:%s", key_start[2], Tcl_GetString(val));
					}
					// Falls through
				case JSON_STRING:
					replace_tclobj(&cx[0].last->hold_key, val);
					break;

				default:
					parse_error(&details, "Object key is not a string", doc, (key_start-doc) - key_start_char_adj);
					goto err;
			}

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

			if (unlikely(*p != ':')) {
				parse_error(&details, "Expecting : after object key", doc, (p-doc) - char_adj);
				goto err;
			}
			p++;

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		}
		//}}}

		val_start = p;
		if (value_type(l, doc, p, e, &char_adj, &p, &type, &val, &details) != TCL_OK) goto err;

		switch (type) {
			case JSON_OBJECT:
				push_parse_context(cx, JSON_OBJECT, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_ARRAY:
				push_parse_context(cx, JSON_ARRAY, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
			case JSON_STRING:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_NUMBER:
				append_to_cx(cx->last, JSON_NewJvalObj(type, val));
				if (unlikely(cx->last->container != JSON_OBJECT && cx->last->container != JSON_ARRAY))
					cx->last->container = type;	// Record our type (at the document top-level)
				break;

			default:
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Unexpected json value type: %d", type));
				goto err;
		}

after_value:	// Yeah, goto.  But the alternative abusing loops was worse
		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		if (p >= e) break;

		if (unlikely(cx[0].last->closed)) {
			parse_error(&details, "Trailing garbage after value", doc, (p-doc) - char_adj);
			goto err;
		}

		switch (cx[0].last->container) { // Handle eof and end-of-context or comma for array and object {{{
			case JSON_OBJECT:
				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					parse_error(&details, "Expecting } or ,", doc, (p-doc) - char_adj);
					goto err;
				}

				p++;
				break;

			case JSON_ARRAY:
				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					parse_error(&details, "Expecting ] or ,", doc, (p-doc) - char_adj);
					goto err;
				}

				p++;
				break;

			default:
				if (unlikely(p < e)) {
					parse_error(&details, "Trailing garbage after value", doc, (p - doc) - char_adj);
					goto err;
				}
		}

		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		//}}}
	}

	if (unlikely(cx != cx[0].last || !cx[0].closed)) { // Unterminated object or array context {{{
		switch (cx[0].last->container) {
			case JSON_OBJECT:
				parse_error(&details, "Unterminated object", doc, cx[0].last->char_ofs);
				goto err;

			case JSON_ARRAY:
				parse_error(&details, "Unterminated array", doc, cx[0].last->char_ofs);
				goto err;

			default:	// Suppress compiler warning
				break;
		}
	}
	//}}}

	if (unlikely(cx[0].val == NULL)) {
		err_at = doc;
		errmsg = "No JSON value found";
		goto whitespace_err;
	}

	//Tcl_FreeIntRep(obj);

	{
		Tcl_ObjType*	top_objtype = g_objtype_for_type[cx[0].container];
		Tcl_ObjIntRep*	top_ir = Tcl_FetchIntRep(cx[0].val, top_objtype);
		Tcl_ObjIntRep	ir = {.twoPtrValue = {}};

		if (unlikely(top_ir == NULL))
			Tcl_Panic("Can't get intrep for the top container");

		// We're transferring the ref from cx[0].val to our intrep
		replace_tclobj((Tcl_Obj**)&ir.twoPtrValue.ptr1, top_ir->twoPtrValue.ptr1);
		release_tclobj((Tcl_Obj**)&ir.twoPtrValue.ptr2);
		release_tclobj(&cx[0].val);

		Tcl_StoreIntRep(obj, top_objtype, &ir);
		*objtype = top_objtype;
		*out_type = cx[0].container;
	}

	release_tclobj(&val);
	return TCL_OK;

whitespace_err:
	parse_error(&details, errmsg, doc, (err_at - doc) - char_adj);

err:
	if (details.errmsg)
		throw_parse_error(interp, &details);

	release_tclobj(&val);
	free_cx(cx);
	return TCL_ERROR;
}

//}}}
int type_is_dynamic(const enum json_types type) //{{{
{
	switch (type) {
		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			return 1;
		default:
			return 0;
	}
}

//}}}
Tcl_Obj* get_unshared_val(Tcl_ObjIntRep* ir) //{{{
{
	if (ir->twoPtrValue.ptr1 != NULL && Tcl_IsShared((Tcl_Obj*)ir->twoPtrValue.ptr1)) {
		replace_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr1, Tcl_DuplicateObj(ir->twoPtrValue.ptr1));
	}

	if (ir->twoPtrValue.ptr2) {
		// The caller wants val unshared, which implies that they intend to
		// change it, which would invalidate our cached template actions, so
		// release those if we have them
		release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);
	}

	return ir->twoPtrValue.ptr1;
}

//}}}

int init_types(Tcl_Interp* interp) //{{{
{
	// We don't define set_from_any callbacks for our types, so they must not be Tcl_RegisterObjType'ed

	g_objtype_for_type[JSON_UNDEF]			= NULL;
	g_objtype_for_type[JSON_OBJECT]			= &json_object;
	g_objtype_for_type[JSON_ARRAY]			= &json_array;
	g_objtype_for_type[JSON_STRING]			= &json_string;
	g_objtype_for_type[JSON_NUMBER]			= &json_number;
	g_objtype_for_type[JSON_BOOL]			= &json_bool;
	g_objtype_for_type[JSON_NULL]			= &json_null;
	g_objtype_for_type[JSON_DYN_STRING]		= &json_dyn_string;
	g_objtype_for_type[JSON_DYN_NUMBER]		= &json_dyn_number;
	g_objtype_for_type[JSON_DYN_BOOL]		= &json_dyn_bool;
	g_objtype_for_type[JSON_DYN_JSON]		= &json_dyn_json;
	g_objtype_for_type[JSON_DYN_TEMPLATE]	= &json_dyn_template;
	g_objtype_for_type[JSON_DYN_LITERAL]	= &json_dyn_literal;

	return TCL_OK;
}

//}}}

/* Local Variables: */
/* tab-width: 4 */
/* c-basic-offset: 4 */
/* End: */
// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4

Changes to jni/rl_json/generic/parser.c.

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
..
47
48
49
50
51
52
53



54
55
56
57
58
59
60
61
62
63
..
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
...
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
...
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
...
190
191
192
193
194
195
196






















197
198
199
200

201
202


203
204
205
206
207
208
209
210
211
212
213
214

215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
...
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
...
359
360
361
362
363
364
365
366

367
368
369
370
371
372
373
...
377
378
379
380
381
382
383
384

385
386
387
388
389
390
391
392

393
394
395
396
397
398
399
400

401
402
403
404
405
406
407
408
409
410















411
412
413
414
415
416
417
...
425
426
427
428
429
430
431
432

433
434
435

436
437
438
439


440
441
442
443
444
445
446
447
448
449
450
451
452
453
#include "rl_json.h"







void _parse_error(Tcl_Interp* interp, const char* errmsg, const unsigned char* doc, size_t char_ofs) //{{{
{
	const char*	char_ofs_str = Tcl_GetString(Tcl_NewIntObj(char_ofs));














	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error parsing JSON value: %s at offset %s", errmsg, char_ofs_str));
	Tcl_SetErrorCode(interp, "RL", "JSON", "PARSE", errmsg, doc, char_ofs_str, NULL);
}

//}}}
struct parse_context* push_parse_context(struct parse_context* cx, const int container, const size_t char_ofs) //{{{
{
	struct parse_context*	last = cx->last;
	struct parse_context*	new;
	Tcl_Obj*				ival;

	if (last->container == JSON_UNDEF) {
		new = last;
	} else if (likely((ptrdiff_t)last >= (ptrdiff_t)cx && (ptrdiff_t)last < (ptrdiff_t)(cx + CX_STACK_SIZE - 1))) {
		// Space remains on the cx array stack
		new = cx->last+1;
	} else {
		new = (struct parse_context*)malloc(sizeof(*new));
	}

	ival = JSON_NewJvalObj(container, container == JSON_OBJECT  ?  Tcl_NewDictObj()  :  Tcl_NewListObj(0, NULL));
	Tcl_IncrRefCount(ival);

	new->prev = last;

	new->val = ival;







	new->hold_key = NULL;
	new->char_ofs = char_ofs;
	new->container = container;
	new->closed = 0;




	cx->last = new;

	return new;
}

//}}}
................................................................................
	cx->last->closed = 1;

	if (unlikely((ptrdiff_t)cx == (ptrdiff_t)last)) {
		return cx->last;
	}

	if (likely(last->val != NULL)) {



		append_to_cx(last->prev, last->val);
		Tcl_DecrRefCount(last->val);
		last->val = NULL;
	}

	if (likely((ptrdiff_t)last >= (ptrdiff_t)cx && (ptrdiff_t)last < (ptrdiff_t)(cx + CX_STACK_SIZE))) {
		// last is on the cx array stack
		cx->last--;
	} else {
		if (last->prev) {
................................................................................

//}}}
void free_cx(struct parse_context* cx) //{{{
{
	struct parse_context*	tail = cx->last;

	while (1) {
		if (tail->hold_key != NULL) {
			Tcl_DecrRefCount(tail->hold_key);
			tail->hold_key = NULL;
		}

		if (tail->val != NULL) {
			Tcl_DecrRefCount(tail->val);
			tail->val = NULL;
		}


		tail = pop_parse_context(cx);

		if (tail == cx) break;
	}
}

//}}}
static int is_whitespace(const unsigned char c) //{{{
{
	switch (c) {
................................................................................

		default:
			return 0;
	}
}

//}}}
static void char_advance(const unsigned char** p, size_t* char_adj) //{{{
{
	// TODO: use Tcl_UtfNext instead?
	// This relies on some properties from the utf-8 returned by Tcl_GetString:
	//	- no invalid encodings (partial utf-8 sequences, etc)
	//	- not truncated in the middle of a char
	const unsigned char	first = **p;
	unsigned int		eat;

	(*p)++;
	if (unlikely(first >= 0xC0)) {
		// Advance to next UTF-8 character
		// TODO: detect invalid sequences?






		if (first < 0xe0 /* 0b11100000 */) {
			eat = 1;
#if TCL_UTF_MAX == 3
		} else {
			eat = 2;
#else
		} else if (first < 0xf0 /* 0b11110000 */) {
................................................................................
		} else {
			eat = 5;
#endif
		}
		*p += eat;
		*char_adj += eat;
	}


}

//}}}
int skip_whitespace(const unsigned char** s, const unsigned char* e, const char** errmsg, const unsigned char** err_at, size_t* char_adj) //{{{
{
	const unsigned char*	p = *s;
	const unsigned char*	start;
	size_t					start_char_adj;


consume_space_or_comment:
	while (is_whitespace(*p)) p++;

	if (unlikely(*p == '/')) {
		start = p;
		start_char_adj = *char_adj;
		p++;
		if (*p == '/') {
			p++;

			while (likely(p < e && (*p > 0x1f || *p == 0x09)))
				char_advance(&p, char_adj);
		} else if (*p == '*') {
			p++;

			while (likely(p < e-2 && *p != '*')) {
				if (unlikely(*p <= 0x1f && !is_whitespace(*p))) goto err_illegal_char;
				char_advance(&p, char_adj);

			}

			if (unlikely(*p++ != '*' || *p++ != '/')) goto err_unterminated;
		} else {
			goto err_illegal_char;
		}

................................................................................
	*err_at = p;
	*errmsg = "Illegal character";
	*s = p;
	return 1;
}

//}}}






















int value_type(struct interp_cx* l, const unsigned char* doc, const unsigned char* p, const unsigned char* e, size_t* char_adj, const unsigned char** next, enum json_types *type, Tcl_Obj** val) //{{{
{
	const unsigned char*	err_at = NULL;
	const char*				errmsg = NULL;


	*val = NULL;



	if (unlikely(p >= e)) goto err;

	switch (*p) {
		case '"':
			p++;	// Advance past the " to the first byte of the string
			{
				Tcl_Obj*				out = NULL;
				const unsigned char*	chunk;
				size_t					len;
				char					mapped;
				enum json_types			stype = JSON_STRING;


				// Peek ahead to detect template subst markers.
				if (p[0] == '~' && e-p >= 3 && p[2] == ':') {
					switch (p[1]) {
						case 'S': stype = JSON_DYN_STRING; break;
						case 'N': stype = JSON_DYN_NUMBER; break;
						case 'B': stype = JSON_DYN_BOOL; break;
						case 'J': stype = JSON_DYN_JSON; break;
						case 'T': stype = JSON_DYN_TEMPLATE; break;
						case 'L': stype = JSON_DYN_LITERAL; break;
						default:  stype = JSON_STRING; p -= 3; break;
					}
					p += 3;
				}

				while (1) {
					chunk = p;

					// These tests are where the majority of the parsing time is spent
					while (likely(p < e && *p != '"' && *p != '\\' && *p > 0x1f))
						char_advance(&p, char_adj);

					if (unlikely(p >= e)) goto err;

					len = p-chunk;

					if (likely(out == NULL)) {
						out = new_stringobj_dedup(l, (const char*)chunk, len);
					} else if (len > 0) {
						if (unlikely(Tcl_IsShared(out)))
							out = Tcl_DuplicateObj(out);	// Can do this because the ref were were operating under is on loan from new_stringobj_dedup

						Tcl_AppendToObj(out, (const char*)chunk, len);
					}

					if (likely(*p == '"')) {
						p++;	// Point at the first byte after the string
						break;
................................................................................
					}

					if (unlikely(*p != '\\')) goto err;

					p++;	// Advance to the backquoted byte

					if (unlikely(Tcl_IsShared(out)))
						out = Tcl_DuplicateObj(out);	// Can do this because the ref were were operating under is on loan from new_stringobj_dedup

					switch (*p) {	// p could point at the NULL terminator at this point
						case '\\':
						case '"':
						case '/':		// RFC4627 allows this for some reason
							mapped = *p;
							goto append_mapped;
................................................................................
						default:
							goto err;
					}
					p++;	// Advance to the first byte after the backquoted sequence
				}

				*type = stype;
				*val = out;

			}
			break;

		case '{':
			*type = JSON_OBJECT;
			p++;
			break;
................................................................................
			p++;
			break;

		case 't':
			if (unlikely(e-p < 4 || *(uint32_t*)p != *(uint32_t*)"true")) goto err;		// Evil endian-compensated trick

			*type = JSON_BOOL;
			*val = l->tcl_true;

			p += 4;
			break;

		case 'f':
			if (unlikely(e-p < 5 || *(uint32_t*)(p+1) != *(uint32_t*)"alse")) goto err;	// Evil endian-compensated trick

			*type = JSON_BOOL;
			*val = l->tcl_false;

			p += 5;
			break;

		case 'n':
			if (unlikely(e-p < 4 || *(uint32_t*)p != *(uint32_t*)"null")) goto err;		// Evil endian-compensated trick

			*type = JSON_NULL;
			*val = l->tcl_empty;

			p += 4;
			break;

		default:
			// TODO: Reject leading zero?  The RFC doesn't allow leading zeros
			{
				const unsigned char*	start = p;
				const unsigned char*	t;

				if (*p == '-') p++;
















				t = p;
				while (*p >= '0' && *p <= '9') p++;
				if (unlikely(p == t)) goto err;	// No integer part after the decimal point

				if (*p == '.') {	// p could point at the NULL terminator at this point
					p++;
................................................................................
					if (*p == '+' || *p == '-') p++;
					t = p;
					while (*p >= '0' && *p <= '9') p++;
					if (unlikely(p == t)) goto err;	// No integer part after the exponent symbol
				}

				*type = JSON_NUMBER;
				*val = new_stringobj_dedup(l, (const char*)start, p-start);

			}
	}


	*next = p;
	return TCL_OK;

err:


	if (err_at == NULL)
		err_at = p;

	if (errmsg == NULL)
		errmsg = (err_at == e) ? "Document truncated" : "Illegal character";

	_parse_error(l->interp, errmsg, doc, (err_at - doc) - *char_adj);

	return TCL_ERROR;
}

//}}}

// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4
|
>

>
>
>
>
>
|

<
>

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



|



<










<
<


>
|
>
>
>
>
>
>
>




>
>
>







 







>
>
>

<
|







 







<
<
|
<
<
<
<
|
|
>


<
<







 







|












>
>
>
>
>
>







 







>
>



|

|
|
|
>




|






|
|





|
>







 







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



>

<
>
>







<
|
|
|
|
>


|
<
<
<
<
<
<
<
<
<
<
<





|
|






|


|







 







|







 







|
>







 







|
>







|
>







|
>




<





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







 







|
>



>




>
>






|







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
..
73
74
75
76
77
78
79
80
81
82
83

84
85
86
87
88
89
90
91
..
99
100
101
102
103
104
105


106




107
108
109
110
111


112
113
114
115
116
117
118
...
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
...
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
...
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255

256
257
258
259
260
261
262
263
264

265
266
267
268
269
270
271
272











273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
...
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
...
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
...
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452

453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
...
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
#include "rl_jsonInt.h"
#include "parser.h"

enum char_advance_status {
	CHAR_ADVANCE_OK,
	CHAR_ADVANCE_UNESCAPED_NULL
};

void parse_error(struct parse_error* details, const char* errmsg, const unsigned char* doc, size_t char_ofs) //{{{
{

	if (details == NULL) return;

	details->errmsg = errmsg;
	details->doc = (const char*)doc;
	details->char_ofs = char_ofs;
}

//}}}
void throw_parse_error(Tcl_Interp* interp, struct parse_error* details) //{{{
{
	char		char_ofs_buf[20];		// 20 bytes allows for 19 bytes of decimal max 64 bit size_t, plus null terminator

	snprintf(char_ofs_buf, 20, "%ld", (long) details->char_ofs);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error parsing JSON value: %s at offset %ld", details->errmsg, (long) details->char_ofs));
	Tcl_SetErrorCode(interp, "RL", "JSON", "PARSE", details->errmsg, details->doc, char_ofs_buf, NULL);
}

//}}}
struct parse_context* push_parse_context(struct parse_context* cx, const enum json_types container, const size_t char_ofs) //{{{
{
	struct parse_context*	last = cx->last;
	struct parse_context*	new;


	if (last->container == JSON_UNDEF) {
		new = last;
	} else if (likely((ptrdiff_t)last >= (ptrdiff_t)cx && (ptrdiff_t)last < (ptrdiff_t)(cx + CX_STACK_SIZE - 1))) {
		// Space remains on the cx array stack
		new = cx->last+1;
	} else {
		new = (struct parse_context*)malloc(sizeof(*new));
	}




	new->prev = last;
	if (last->mode == VALIDATE) {
		new->val = NULL;
	} else {
		Tcl_IncrRefCount(
			new->val = JSON_NewJvalObj(container, container == JSON_OBJECT  ?
				(cx->l ? cx->l->tcl_empty_dict : Tcl_NewDictObj())  :
				(cx->l ? cx->l->tcl_empty_list : Tcl_NewListObj(0, NULL))
		));
	}
	new->hold_key = NULL;
	new->char_ofs = char_ofs;
	new->container = container;
	new->closed = 0;
	new->objtype = g_objtype_for_type[container];
	new->l = last->l;
	new->mode = last->mode;

	cx->last = new;

	return new;
}

//}}}
................................................................................
	cx->last->closed = 1;

	if (unlikely((ptrdiff_t)cx == (ptrdiff_t)last)) {
		return cx->last;
	}

	if (likely(last->val != NULL)) {
		if (last->prev->val && Tcl_IsShared(last->prev->val))
			replace_tclobj(&last->prev->val, Tcl_DuplicateObj(last->prev->val));

		append_to_cx(last->prev, last->val);

		release_tclobj(&last->val);
	}

	if (likely((ptrdiff_t)last >= (ptrdiff_t)cx && (ptrdiff_t)last < (ptrdiff_t)(cx + CX_STACK_SIZE))) {
		// last is on the cx array stack
		cx->last--;
	} else {
		if (last->prev) {
................................................................................

//}}}
void free_cx(struct parse_context* cx) //{{{
{
	struct parse_context*	tail = cx->last;

	while (1) {


		release_tclobj(&tail->hold_key);




		release_tclobj(&tail->val);

		if (tail == cx) break;

		tail = pop_parse_context(cx);


	}
}

//}}}
static int is_whitespace(const unsigned char c) //{{{
{
	switch (c) {
................................................................................

		default:
			return 0;
	}
}

//}}}
static enum char_advance_status char_advance(const unsigned char** p, size_t* char_adj) //{{{
{
	// TODO: use Tcl_UtfNext instead?
	// This relies on some properties from the utf-8 returned by Tcl_GetString:
	//	- no invalid encodings (partial utf-8 sequences, etc)
	//	- not truncated in the middle of a char
	const unsigned char	first = **p;
	unsigned int		eat;

	(*p)++;
	if (unlikely(first >= 0xC0)) {
		// Advance to next UTF-8 character
		// TODO: detect invalid sequences?
		if (first == 0xC0 && **p == 0x80) {
			(*p)--;
			// Have to check for this here - other unescaped control chars are handled by the < 0x1F
			// test, but 0x00 is transformed to 0xC0 0x80 by Tcl (MUTF-8 rather than UTF-8)
			return CHAR_ADVANCE_UNESCAPED_NULL;
		}
		if (first < 0xe0 /* 0b11100000 */) {
			eat = 1;
#if TCL_UTF_MAX == 3
		} else {
			eat = 2;
#else
		} else if (first < 0xf0 /* 0b11110000 */) {
................................................................................
		} else {
			eat = 5;
#endif
		}
		*p += eat;
		*char_adj += eat;
	}

	return CHAR_ADVANCE_OK;
}

//}}}
int skip_whitespace(const unsigned char** s, const unsigned char* e, const char** errmsg, const unsigned char** err_at, size_t* char_adj, enum extensions extensions) //{{{
{
	const unsigned char*		p = *s;
	const unsigned char*		start;
	size_t						start_char_adj;
	enum char_advance_status	status = CHAR_ADVANCE_OK;

consume_space_or_comment:
	while (is_whitespace(*p)) p++;

	if (unlikely((extensions & EXT_COMMENTS) && *p == '/')) {
		start = p;
		start_char_adj = *char_adj;
		p++;
		if (*p == '/') {
			p++;

			while (likely(p < e && (*p > 0x1f || *p == 0x09) && status == CHAR_ADVANCE_OK))
				status = char_advance(&p, char_adj);
		} else if (*p == '*') {
			p++;

			while (likely(p < e-2 && *p != '*')) {
				if (unlikely(*p <= 0x1f && !is_whitespace(*p))) goto err_illegal_char;
				status = char_advance(&p, char_adj);
				if (unlikely(status != CHAR_ADVANCE_OK)) goto err_illegal_char;
			}

			if (unlikely(*p++ != '*' || *p++ != '/')) goto err_unterminated;
		} else {
			goto err_illegal_char;
		}

................................................................................
	*err_at = p;
	*errmsg = "Illegal character";
	*s = p;
	return 1;
}

//}}}
int is_template(const char* s, int len) //{{{
{
	if (
		len >= 3 &&
		s[0] == '~' &&
		s[2] == ':'
	) {
		switch (s[1]) {
			case 'S':
			case 'N':
			case 'B':
			case 'J':
			case 'T':
			case 'L':
				return 1;
		}
	}

	return 0;
}

//}}}
int value_type(struct interp_cx* l, const unsigned char* doc, const unsigned char* p, const unsigned char* e, size_t* char_adj, const unsigned char** next, enum json_types *type, Tcl_Obj** val, struct parse_error* details) //{{{
{
	const unsigned char*	err_at = NULL;
	const char*				errmsg = NULL;
	Tcl_Obj*				out = NULL;


	if (val)
		release_tclobj(val);

	if (unlikely(p >= e)) goto err;

	switch (*p) {
		case '"':
			p++;	// Advance past the " to the first byte of the string
			{

				const unsigned char*		chunk;
				size_t						len;
				char						mapped;
				enum json_types				stype = JSON_STRING;
				enum char_advance_status	status = CHAR_ADVANCE_OK;

				// Peek ahead to detect template subst markers.
				TEMPLATE_TYPE(p, e-p, stype);












				while (1) {
					chunk = p;

					// These tests are where the majority of the parsing time is spent
					while (likely(p < e && *p != '"' && *p != '\\' && *p > 0x1f && status == CHAR_ADVANCE_OK))
						status = char_advance(&p, char_adj);

					if (unlikely(p >= e)) goto err;

					len = p-chunk;

					if (likely(out == NULL)) {
						replace_tclobj(&out, get_string(l, (const char*)chunk, len));
					} else if (len > 0) {
						if (unlikely(Tcl_IsShared(out)))
							replace_tclobj(&out, Tcl_DuplicateObj(out));

						Tcl_AppendToObj(out, (const char*)chunk, len);
					}

					if (likely(*p == '"')) {
						p++;	// Point at the first byte after the string
						break;
................................................................................
					}

					if (unlikely(*p != '\\')) goto err;

					p++;	// Advance to the backquoted byte

					if (unlikely(Tcl_IsShared(out)))
						replace_tclobj(&out, Tcl_DuplicateObj(out));

					switch (*p) {	// p could point at the NULL terminator at this point
						case '\\':
						case '"':
						case '/':		// RFC4627 allows this for some reason
							mapped = *p;
							goto append_mapped;
................................................................................
						default:
							goto err;
					}
					p++;	// Advance to the first byte after the backquoted sequence
				}

				*type = stype;
				if (val)
					replace_tclobj(val, out);
			}
			break;

		case '{':
			*type = JSON_OBJECT;
			p++;
			break;
................................................................................
			p++;
			break;

		case 't':
			if (unlikely(e-p < 4 || *(uint32_t*)p != *(uint32_t*)"true")) goto err;		// Evil endian-compensated trick

			*type = JSON_BOOL;
			if (val)
				replace_tclobj(val, l ? l->tcl_true : Tcl_NewBooleanObj(1));
			p += 4;
			break;

		case 'f':
			if (unlikely(e-p < 5 || *(uint32_t*)(p+1) != *(uint32_t*)"alse")) goto err;	// Evil endian-compensated trick

			*type = JSON_BOOL;
			if (val)
				replace_tclobj(val, l ? l->tcl_false : Tcl_NewBooleanObj(0));
			p += 5;
			break;

		case 'n':
			if (unlikely(e-p < 4 || *(uint32_t*)p != *(uint32_t*)"null")) goto err;		// Evil endian-compensated trick

			*type = JSON_NULL;
			if (val)
				replace_tclobj(val, l ? l->tcl_empty : Tcl_NewStringObj("", 0));
			p += 4;
			break;

		default:

			{
				const unsigned char*	start = p;
				const unsigned char*	t;

				if (*p == '-') p++;

				if (unlikely(
						*p == '0' && (
							// Only 3 characters can legally follow a leading '0' according to the spec:
							// . - fraction, e or E - exponent
							(p[1] >= '0' && p[1] <= '9')		// Octal, hex, or decimal with leading 0
						)
				)) {
					// Indexing one beyond p is safe - all the strings we
					// receive are guaranteed to be null terminated by Tcl, and
					// *p here is '0'
					err_at = p;
					errmsg = "Leading 0 not allowed for numbers";
					goto err;
				}

				t = p;
				while (*p >= '0' && *p <= '9') p++;
				if (unlikely(p == t)) goto err;	// No integer part after the decimal point

				if (*p == '.') {	// p could point at the NULL terminator at this point
					p++;
................................................................................
					if (*p == '+' || *p == '-') p++;
					t = p;
					while (*p >= '0' && *p <= '9') p++;
					if (unlikely(p == t)) goto err;	// No integer part after the exponent symbol
				}

				*type = JSON_NUMBER;
				if (val)
					replace_tclobj(val, get_string(l, (const char*)start, p-start));
			}
	}

	release_tclobj(&out);
	*next = p;
	return TCL_OK;

err:
	release_tclobj(&out);

	if (err_at == NULL)
		err_at = p;

	if (errmsg == NULL)
		errmsg = (err_at == e) ? "Document truncated" : "Illegal character";

	parse_error(details, errmsg, doc, (err_at - doc) - *char_adj);

	return TCL_ERROR;
}

//}}}

// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4

Changes to jni/rl_json/generic/parser.h.

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
#ifndef _JSON_PARSER_H
#define _JSON_PARSER_H

enum json_types {
	JSON_UNDEF,
	JSON_OBJECT,
	JSON_ARRAY,
	JSON_STRING,
	JSON_NUMBER,
	JSON_BOOL,
	JSON_NULL,

	/* Dynamic types - placeholders for dynamic values in templates */
	JSON_DYN_STRING,	// ~S:
	JSON_DYN_NUMBER,	// ~N:
	JSON_DYN_BOOL,		// ~B:
	JSON_DYN_JSON,		// ~J:
	JSON_DYN_TEMPLATE,	// ~T:
	JSON_DYN_LITERAL,	// ~L:	literal escape - used to quote literal values that start with the above sequences

	JSON_TYPE_MAX		// Not an actual type - records the number of types
};

#define KC_ENTRIES		384		// Must be an integer multiple of 8*sizeof(long long)

struct kc_entry {
	Tcl_Obj			*val;
	unsigned int	hits;
};

enum action_opcode {
	NOP,
	ALLOCATE_SLOTS,
	ALLOCATE_STACK,
	FETCH_VALUE,
	JVAL_LITERAL,
	JVAL_STRING,
	JVAL_NUMBER,
	JVAL_BOOLEAN,
	JVAL_JSON,
	FILL_SLOT,
	EVALUATE_TEMPLATE,
	CX_OBJ_KEY,
	CX_ARR_IDX,
	POP_CX,
	REPLACE_VAL,
	REPLACE_KEY,

	TEMPLATE_ACTIONS_END
};

struct interp_cx {
	Tcl_Interp*		interp;
	Tcl_Obj*		tcl_true;
	Tcl_Obj*		tcl_false;
	Tcl_Obj*		tcl_empty;
	Tcl_Obj*		tcl_one;
	Tcl_Obj*		json_true;
	Tcl_Obj*		json_false;
	Tcl_Obj*		json_null;
	Tcl_Obj*		json_empty_string;
	Tcl_Obj*		action[TEMPLATE_ACTIONS_END];
	Tcl_Obj*		force_num_cmd[3];
	Tcl_Obj*		type[JSON_TYPE_MAX];
	Tcl_Obj*		templates;
	Tcl_HashTable	kc;
	int				kc_count;
	long long		freemap[(KC_ENTRIES / (8*sizeof(long long)))+1];	// long long for ffsll
	struct kc_entry	kc_entries[KC_ENTRIES];
};

#define CX_STACK_SIZE	6



void _parse_error(Tcl_Interp* interp, const char* errmsg, const unsigned char* doc, size_t char_ofs);

struct parse_context* push_parse_context(struct parse_context* cx, const int container, const size_t char_ofs);
struct parse_context* pop_parse_context(struct parse_context* cx);
void free_cx(struct parse_context* cx);
int skip_whitespace(const unsigned char** s, const unsigned char* e, const char** errmsg, const unsigned char** err_at, size_t* char_adj);
int value_type(struct interp_cx* l, const unsigned char* doc, const unsigned char* p, const unsigned char* e, size_t* char_adj, const unsigned char** next, enum json_types *type, Tcl_Obj** val);
int test_parse(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]);

#endif



|
<
<
<
<
<
<
<

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


<
<



1
2
3
4







5





























































6
7
8
9
10
11
12


13
14
15
#ifndef _JSON_PARSER_H
#define _JSON_PARSER_H

#include "rl_jsonInt.h"





































































int skip_whitespace(const unsigned char** s, const unsigned char* e, const char** errmsg, const unsigned char** err_at, size_t* char_adj, enum extensions extensions);
int value_type(struct interp_cx* l, const unsigned char* doc, const unsigned char* p, const unsigned char* e, size_t* char_adj, const unsigned char** next, enum json_types *type, Tcl_Obj** val, struct parse_error* details);
void parse_error(struct parse_error* details, const char* errmsg, const unsigned char* doc, size_t char_ofs);
void throw_parse_error(Tcl_Interp* interp, struct parse_error* details);
struct parse_context* push_parse_context(struct parse_context* cx, const enum json_types container, const size_t char_ofs);
struct parse_context* pop_parse_context(struct parse_context* cx);
void free_cx(struct parse_context* cx);


int test_parse(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]);

#endif

Changes to jni/rl_json/generic/rl_json.c.

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
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
..
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
209
210
211
212
213
214
215
216
217
218
219
220
221



222
223


224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

239
240
241
242
243

244

245
246
247
248
249
250
251
252
253
254
255
256
257





258
259




260
261
262
263
264
265




266



267
268
269
270
271
272
273
274
275
276
277


278
279
280
281
282




























283
284
285


286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
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
360
361
362
363
364
365
366
367
368
369




370
371
372
373
374


375
376
377
378
379
380
381
382
383
384
385
386
387
388

389



390
391
392
393
394
395
396
...
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
...
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
...
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510


511

512
513
514

515
516
517
518
519
520
521
...
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
...
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
...
629
630
631
632
633
634
635
636
637
638
639



640
641
642
643
644
645
646
647
648
649


650
651
652
653
654
655
656
...
669
670
671
672
673
674
675



676
677
678
679
680
681


682
683
684
685




686
687
688
689
690
691



692
693

694
695
696
697
698
699
700
701
702
703
704
705
706

707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
...
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463


1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474

1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
....
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
....
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567


1568
1569
1570
1571
1572
1573
1574

1575

1576
1577
1578
1579
1580
1581
1582
....
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598


1599
1600
1601
1602
1603
1604
1605
....
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
....
1663
1664
1665
1666
1667
1668
1669

1670

1671
1672
1673
1674

1675



1676
1677


1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691

1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709

1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724



1725
1726
1727
1728
1729
1730
1731
1732

1733
1734
1735
1736
1737
1738
1739
1740
1741



1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752




1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948


1949
1950
1951
1952
1953
1954
1955
1956
....
2027
2028
2029
2030
2031
2032
2033


2034
2035
2036
2037





2038

2039
































































2040
2041
2042
2043
2044
2045
2046
....
2057
2058
2059
2060
2061
2062
2063





2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086

2087
2088
2089
2090
2091
2092
2093












2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105

2106
2107
2108
2109
2110
2111
2112
2113
2114
....
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174

2175
2176
2177
2178
2179
2180
2181
2182
2183
2184

2185
2186
2187
2188
2189
2190
2191
....
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298

2299
2300
2301
2302
2303
2304
2305
2306
2307
2308

2309
2310
2311
2312
2313
2314
2315
....
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
....
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525



2526


2527
2528
2529



2530
2531

2532
2533
2534
2535
2536
2537
2538
2539
2540

2541
2542
2543
2544
2545
2546
2547
2548

2549
2550



2551



2552
2553
2554
2555




































2556
2557



2558



















2559
2560
2561
2562
2563
2564

2565

2566
2567
2568
2569
2570
2571
2572

2573
2574
2575
2576


2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623


2624


2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
....
2643
2644
2645
2646
2647
2648
2649













2650
2651
2652
2653
2654

2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675

2676
2677
2678

2679
2680
2681
2682
2683

2684
2685
2686
2687
2688
2689
2690
2691
2692

2693
2694
2695
2696
2697
2698
2699
2700
2701

2702
2703
2704


2705
2706
2707
2708
2709
2710
2711
2712


2713
2714


2715

2716
2717


2718
2719
2720
2721
2722
2723
2724

2725





2726
2727

2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739

2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774


2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789

2790
2791
2792
2793
2794
2795
2796

2797
2798

2799

2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811



2812
2813
2814
2815
2816
2817

2818
2819
2820
2821





2822
2823
2824
2825
2826
2827

2828

2829
2830
2831
2832

2833

2834
2835
2836

2837
2838

2839
2840
2841
2842
2843
2844
2845
2846

2847
2848








2849

2850



2851
2852
2853

2854
2855



2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889

2890
2891
2892

2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923


2924
2925
2926
2927
2928
2929


2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942

2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953

2954

2955
2956

2957
2958
2959
2960

2961

2962




2963
2964
2965
2966
2967
2968
2969

2970


2971
2972
2973

2974
2975
2976
2977
2978
2979

2980

2981
2982
2983
2984
2985
2986
2987

2988
2989
2990

2991
2992
2993
2994
2995

2996
2997
2998
2999
3000
3001
3002
3003
3004

3005
3006
3007
3008
3009
3010
3011
3012


3013
3014

3015
3016


3017
3018
3019
3020

3021
3022
3023


3024
3025





3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036

3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048

3049
3050
3051
3052
3053
3054
3055
3056

3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067


3068

3069


3070
3071

3072
3073





3074


3075
3076

3077
3078
3079
3080
3081
3082



3083
3084
3085
3086
3087




3088


3089
3090

3091
3092
3093




3094
3095
3096
3097
3098
3099
3100
3101
3102
3103




3104
3105



3106
3107
3108

3109





3110
3111
3112
3113
3114
3115
3116
3117
3118

3119


3120
3121
3122
3123
3124


3125


3126

3127





3128
3129
3130
3131
3132




3133
3134
3135

3136
3137
3138
3139

3140
3141
3142
3143
3144
3145

3146
3147
3148

3149
3150
3151
3152
3153
3154
3155

3156
3157







3158
3159
3160



















3161
3162














3163

3164
3165
3166
3167
3168
3169



3170
3171
3172
3173
3174
3175
3176


3177
3178
3179







































































































































































































3180
3181



















































































3182
3183



3184









































































































3185
3186
3187
3188
3189

3190












































































































































































3191


















































































































































































3192


3193
3194








3195
3196
3197

3198
3199
3200


3201
3202
3203
3204
3205

3206
3207
3208














































































































































3209
3210
3211
3212
3213


3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225


3226


3227
3228









3229

3230



3231
3232
3233
3234
3235
3236
3237


3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249


3250


3251
3252






3253

3254



3255
3256
3257
3258


3259
3260
3261
3262
3263
3264

3265
3266
3267
3268
3269
3270
3271


3272
3273
3274
3275
3276
3277
3278
3279
3280
3281

3282
3283
3284

3285
3286
3287
3288
3289

3290
3291



3292
3293
3294
3295

3296
3297

3298
3299
3300
3301
3302
3303
3304
3305
3306


3307
3308
3309

3310
3311
3312
3313

3314


3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325


3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343



3344
3345
3346
3347
3348
3349

3350
3351
3352
3353
3354
3355
3356

3357
3358
3359
3360

3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394

3395
3396
3397
3398
3399
3400

3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426




3427
3428


3429
3430






3431
3432
3433
3434


3435
3436
3437
3438



3439
3440
3441
3442
3443
3444
3445
3446
3447
3448


3449




3450
3451


3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492

3493




3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525

3526
3527






3528
3529
3530
3531
3532
3533
3534
3535
3536



3537
3538
3539
3540






3541

3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566












3567
3568
3569
3570
3571



3572
3573
3574
3575
3576
3577





3578
3579
3580
3581
3582
3583
3584
3585
3586
3587

3588
3589

3590


3591
3592
3593
3594
3595
3596





3597
3598


3599
3600

3601
3602
3603



3604
3605
3606
3607
3608
3609
3610
3611
3612





3613
3614
3615
3616
3617
3618
3619

3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691

3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713

3714
3715
3716
3717


3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737

3738
3739
3740
3741
3742
3743
3744
3745
3746
3747

3748













































































































3749
3750

























































































3751
3752

3753



3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767










































3768
3769
3770
3771
3772
3773
#include "rl_json.h"





#if defined(_WIN32)
#define snprintf _snprintf
#endif

static void free_internal_rep(Tcl_Obj* obj);
static void dup_internal_rep(Tcl_Obj* src, Tcl_Obj* dest);
static void update_string_rep(Tcl_Obj* obj);
static int set_from_any(Tcl_Interp* interp, Tcl_Obj* obj);

#ifdef WIN32
#define _DLLEXPORT extern DLLEXPORT
#else
#define _DLLEXPORT
#endif

Tcl_ObjType json_type = {
	"JSON",
	free_internal_rep,
	dup_internal_rep,
	update_string_rep,
	set_from_any
};

static const char* dyn_prefix[] = {
	NULL,	// JSON_UNDEF
	NULL,	// JSON_OBJECT
	NULL,	// JSON_ARRAY
	NULL,	// JSON_STRING
	NULL,	// JSON_NUMBER
	NULL,	// JSON_BOOL
................................................................................
	"string",		// JSON_DYN_STRING
	"string",		// JSON_DYN_NUMBER
	"string",		// JSON_DYN_BOOL
	"string",		// JSON_DYN_JSON
	"string",		// JSON_DYN_TEMPLATE
	"string"		// JSON_DYN_LITERAL
};
// These are just for debugging
const char* type_names_dbg[] = {
	"JSON_UNDEF",
	"JSON_OBJECT",
	"JSON_ARRAY",
	"JSON_STRING",
	"JSON_NUMBER",
	"JSON_BOOL",
	"JSON_NULL",
................................................................................
	"JSON_DYN_NUMBER",
	"JSON_DYN_BOOL",
	"JSON_DYN_JSON",
	"JSON_DYN_TEMPLATE",
	"JSON_DYN_LITERAL"
};

static const char* action_opcode_str[] = {
	"NOP",
	"ALLOCATE_SLOTS",
	"ALLOCATE_STACK",
	"FETCH_VALUE",
	"JVAL_LITERAL",
	"JVAL_STRING",
	"JVAL_NUMBER",
	"JVAL_BOOLEAN",
	"JVAL_JSON",
	"FILL_SLOT",
	"EVALUATE_TEMPLATE",
	"CX_OBJ_KEY",
	"CX_ARR_IDX",

	"POP_CX",
	"REPLACE_VAL",


	"REPLACE_KEY",

	(char*)NULL
};

enum serialize_modes {
	SERIALIZE_NORMAL,		// We're updating the string rep of a json value or template

	SERIALIZE_TEMPLATE		// We're interpolating values into a template

};

struct serialize_context {
	Tcl_DString*	ds;

	enum serialize_modes	serialize_mode;
	Tcl_Obj*				fromdict;	// NULL if no dict supplied
	struct interp_cx* l;
};

struct template_cx {
	Tcl_Interp*			interp;
	struct interp_cx*	l;
	Tcl_Obj*			map;
	Tcl_Obj*			actions;
	int					slots_used;
};

struct cx_stack {
	Tcl_Obj*		target;
	Tcl_Obj*		elem;
};

enum modifiers {
	MODIFIER_NONE,
	MODIFIER_LENGTH,	// for arrays and strings: return the length as an int
	MODIFIER_SIZE,		// for objects: return the number of keys as an int
	MODIFIER_TYPE,		// for all types: return the string name as Tcl_Obj
	MODIFIER_KEYS		// for objects: return the keys defined as Tcl_Obj
};

static int new_json_value_from_list(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res);
static int NRforeach_next_loop_bottom(ClientData cdata[], Tcl_Interp* interp, int retcode);

#if 0
static int json_pretty_dbg(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds);
#endif

#if defined(_GNU_SOURCE) && !defined(_WIN32) && !defined(ANDROID) && !defined(__OpenBSD__)
#define FFSLL	ffsll
#else
#define FFSLL	ffsll_polyfill
static int ffsll_polyfill(long long x) //{{{

{
	int i=0;
	long long mask = 1;
	for (i=0; i<sizeof(long long)*8;++i, mask <<= 1) {
		if (x & mask) {
			return i+1;
		}
	}

	return 0;
}

//}}}
#endif

static int first_free(long long* freemap) //{{{
{
	int	i=0, bit, res;
	while ((bit = FFSLL(freemap[i])) == 0) {
		i++;
	}
	res = i * (sizeof(long long)*8) + (bit-1);

	return res;
}

//}}}
static void mark_used(long long* freemap, int idx) //{{{
{
	int	i = idx / (sizeof(long long)*8);
	int bit = idx - (i * (sizeof(long long)*8));
	freemap[i] &= ~(1LL << bit);
}

//}}}
static void mark_free(long long* freemap, int idx) //{{{

{
	int	i = idx / (sizeof(long long)*8);
	int bit = idx - (i * (sizeof(long long)*8));
	freemap[i] |= 1LL << bit;

}

//}}}
static void age_cache(struct interp_cx* l) //{{{

{
	Tcl_HashEntry*		he;
	Tcl_HashSearch		search;
	struct kc_entry*	e;



	he = Tcl_FirstHashEntry(&l->kc, &search);
	while (he) {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(he);

		//if (idx >= KC_ENTRIES) Tcl_Panic("age_cache: idx (%ld) is out of bounds, KC_ENTRIES: %d", idx, KC_ENTRIES);
		//printf("age_cache: kc_count: %d", l->kc_count);
		e = &l->kc_entries[idx];

		if (e->hits < 1) {
			Tcl_DeleteHashEntry(he);
			Tcl_DecrRefCount(e->val);
			Tcl_DecrRefCount(e->val);	// Two references - one for the cache table and one on loan to callers' interim processing
			mark_free(l->freemap, idx);
			e->val = NULL;



		} else {
			e->hits >>= 1;


		}
		he = Tcl_NextHashEntry(&search);
	}
	l->kc_count = 0;
}

//}}}
Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, int length) //{{{
{
	char				buf[STRING_DEDUP_MAX + 1];
	const char			*keyname;
	int					is_new;
	struct kc_entry*	kce;
	Tcl_Obj*			out;
	Tcl_HashEntry*		entry = NULL;


	if (length == 0) {
		return l->tcl_empty;
	} else if (length < 0) {
		length = strlen(bytes);

	}


	if (length > STRING_DEDUP_MAX)
		return Tcl_NewStringObj(bytes, length);

	if (likely(bytes[length] == 0)) {
		keyname = bytes;
	} else {
		memcpy(buf, bytes, length);
		buf[length] = 0;
		keyname = buf;
	}
	entry = Tcl_CreateHashEntry(&l->kc, keyname, &is_new);






	if (is_new) {
		ptrdiff_t	idx = first_free(l->freemap);





		if (unlikely(idx >= KC_ENTRIES)) {
			// Cache overflow
			Tcl_DeleteHashEntry(entry);
			age_cache(l);
			return Tcl_NewStringObj(bytes, length);




		}




		kce = &l->kc_entries[idx];
		kce->hits = 0;
		out = kce->val = Tcl_NewStringObj(bytes, length);
		Tcl_IncrRefCount(out);	// Two references - one for the cache table and one on loan to callers' interim processing.
		Tcl_IncrRefCount(out);	// Without this, values not referenced elsewhere could reach callers with refCount 1, allowing
								// the value to be mutated in place and corrupt the state of the cache (hash key not matching obj value)

		mark_used(l->freemap, idx);

		Tcl_SetHashValue(entry, (void*)idx);


		l->kc_count++;

		if (unlikely(l->kc_count > (int)(KC_ENTRIES/2.5))) {
			kce->hits++; // Prevent the just-created entry from being pruned
			age_cache(l);




























		}
	} else {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(entry);



		kce = &l->kc_entries[idx];
		out = kce->val;
		if (kce->hits < 255) kce->hits++;
	}

	return out;
}

//}}}

int JSON_GetJvalFromObj(Tcl_Interp* interp, Tcl_Obj* obj, int* type, Tcl_Obj** val) //{{{
{
	if (obj->typePtr != &json_type)
		TEST_OK(set_from_any(interp, obj));

	*type = obj->internalRep.ptrAndLongRep.value;
	*val = obj->internalRep.ptrAndLongRep.ptr;

	return TCL_OK;
}

//}}}
int JSON_SetIntRep(Tcl_Interp* interp, Tcl_Obj* target, int type, Tcl_Obj* replacement) //{{{
{
	if (Tcl_IsShared(target))
		THROW_ERROR("Called JSON_SetIntRep on a shared object: ", Tcl_GetString(target));

	target->internalRep.ptrAndLongRep.value = type;

	if (target->internalRep.ptrAndLongRep.ptr != NULL)
		Tcl_DecrRefCount((Tcl_Obj*)target->internalRep.ptrAndLongRep.ptr);

	target->internalRep.ptrAndLongRep.ptr = replacement;
	if (target->internalRep.ptrAndLongRep.ptr != NULL)
		Tcl_IncrRefCount((Tcl_Obj*)target->internalRep.ptrAndLongRep.ptr);

	Tcl_InvalidateStringRep(target);

	return TCL_OK;
}

//}}}
Tcl_Obj* JSON_NewJvalObj(int type, Tcl_Obj* val) //{{{
{
	Tcl_Obj*	res = Tcl_NewObj();

	res->typePtr = &json_type;
	res->internalRep.ptrAndLongRep.ptr = NULL;

	switch (type) {
		case JSON_OBJECT:
		case JSON_ARRAY:
		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
		case JSON_NULL:

		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			break;

		default:
			Tcl_Panic("JSON_NewJvalObj, unhandled type: %d", type);
	}

	if (JSON_SetIntRep(NULL, res, type, val) != TCL_OK)
		Tcl_Panic("Couldn't set JSON intrep");

	return res;
}

//}}}

static int force_json_number(Tcl_Interp* interp, struct interp_cx* l, Tcl_Obj* obj, Tcl_Obj** forced) //{{{
{
	int	res;

	// TODO: investigate a direct bytecode version?





	if (l) { // Use the cached objs
		Tcl_IncrRefCount(l->force_num_cmd[2] = obj);
		res = Tcl_EvalObjv(interp, 3, l->force_num_cmd, TCL_EVAL_DIRECT);
		Tcl_DecrRefCount(l->force_num_cmd[2]);
		l->force_num_cmd[2] = NULL;


	} else {
		Tcl_Obj*	cmd;

		cmd = Tcl_NewListObj(0, NULL);
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, Tcl_NewStringObj("::tcl::mathop::+", -1)));
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, Tcl_NewIntObj(0)));
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, obj));

		Tcl_IncrRefCount(cmd);
		res = Tcl_EvalObjEx(interp, cmd, TCL_EVAL_DIRECT);
		Tcl_DecrRefCount(cmd);
	}

	if (res == TCL_OK && forced != NULL)

		*forced = Tcl_GetObjResult(interp);




	return res;
}

//}}}
static void append_json_string(const struct serialize_context* scx, Tcl_Obj* obj) //{{{
{
................................................................................
				case 0x8:	Tcl_DStringAppend(ds, "\\b", 2); break;
				case 0xC:	Tcl_DStringAppend(ds, "\\f", 2); break;
				case 0xA:	Tcl_DStringAppend(ds, "\\n", 2); break;
				case 0xD:	Tcl_DStringAppend(ds, "\\r", 2); break;
				case 0x9:	Tcl_DStringAppend(ds, "\\t", 2); break;

				default:
					if ((int)c < 0 || (int)c > 0x10ffff) {
						Tcl_DStringAppend(ds, "\\uFFFD", 6);
						break;
					}
					if (c > 0xffff) {
						snprintf(ustr, 7, "\\u%04X", (((c - 0x10000) >> 10) & 0x3FF) | 0xD800);
						Tcl_DStringAppend(ds, ustr, 6);
						c = ((c - 0x10000) & 0x3FF) | 0xDC00;
					}
					snprintf(ustr, 7, "\\u%04X", c);
					Tcl_DStringAppend(ds, ustr, 6);
					break;
			}
			p += adv;
			chunk = p;
		} else {
................................................................................
			//}}}
		case JSON_OBJECT: //{{{
			{
				int				done, first=1;
				Tcl_DictSearch	search;
				Tcl_Obj*		k;
				Tcl_Obj*		v;
				int				v_type = 0;
				Tcl_Obj*		iv = NULL;

				TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));

				Tcl_DStringAppend(ds, "{", 1);
				for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
					if (!first) {
................................................................................
					} else {
						first = 0;
					}

					// Have to do the template subst here rather than at
					// parse time since the dict keys would be broken otherwise
					if (scx->serialize_mode == SERIALIZE_TEMPLATE) {
						int			l, stype;
						const char*	s;

						s = Tcl_GetStringFromObj(k, &l);

						if (
								l >= 3 &&
								s[0] == '~' &&
								s[2] == ':'
						) {
							switch (s[1]) {
								case 'S': stype = JSON_DYN_STRING; break;
								case 'L': stype = JSON_DYN_LITERAL; break;

								case 'N':
								case 'B':
								case 'J':
								case 'T':
									Tcl_SetObjResult(interp, Tcl_NewStringObj(
												"Only strings allowed as object keys", -1));
									res = TCL_ERROR;
									goto done;

								default:  stype = JSON_UNDEF; break;
							}

							if (stype != JSON_UNDEF) {


								if (serialize_json_val(interp, scx, stype, Tcl_GetRange(k, 3, l-1)) != TCL_OK) {

									res = TCL_ERROR;
									break;
								}

							} else {
								append_json_string(scx, k);
							}
						} else {
							append_json_string(scx, k);
						}
					} else {
................................................................................
				Tcl_DStringAppend(ds, "}", 1);
				Tcl_DictObjDone(&search);
			}
			break;
			//}}}
		case JSON_ARRAY: //{{{
			{
				int			i, oc, first=1;
				Tcl_Obj**	ov;
				Tcl_Obj*	iv = NULL;
				int			v_type = 0;

				TEST_OK(Tcl_ListObjGetElements(interp, val, &oc, &ov));

				Tcl_DStringAppend(ds, "[", 1);
				for (i=0; i<oc; i++) {
					if (!first) {
						Tcl_DStringAppend(ds, ",", 1);
					} else {
						first = 0;
					}
					JSON_GetJvalFromObj(NULL, ov[i], &v_type, &iv);
					TEST_OK(serialize_json_val(interp, scx, v_type, iv));
				}
				Tcl_DStringAppend(ds, "]", 1);
			}
			break;
			//}}}
		case JSON_NUMBER: //{{{
................................................................................
			if (scx->serialize_mode == SERIALIZE_NORMAL) {
				Tcl_Obj*	tmp = Tcl_ObjPrintf("%s%s", dyn_prefix[type], Tcl_GetString(val));

				Tcl_IncrRefCount(tmp);
				append_json_string(scx, tmp);
				Tcl_DecrRefCount(tmp);
			} else {
				Tcl_Obj*	subst_val = NULL;
				int			subst_type;
				int			reset_mode = 0;

				if (type == JSON_DYN_LITERAL) {
					append_json_string(scx, val);
					break;
				}

				if (scx->fromdict != NULL) {
					TEST_OK(Tcl_DictObjGet(interp, scx->fromdict, val, &subst_val));
				} else {
					subst_val = Tcl_ObjGetVar2(interp, val, NULL, 0);
				}

				if (subst_val == NULL) {
					// TODO: reject a null substitution if we're in an object key context?  Would need an extra flag on the function :(
					subst_type = JSON_NULL;
				} else {
					subst_type = from_dyn[type];
					Tcl_IncrRefCount(subst_val);
				}

				if (subst_type == JSON_DYN_JSON) {
................................................................................
					scx->serialize_mode = SERIALIZE_NORMAL;
					reset_mode = 1;
				} else if (subst_type == JSON_DYN_TEMPLATE) {
					if (subst_val != NULL) Tcl_DecrRefCount(subst_val);
					res = JSON_GetJvalFromObj(interp, subst_val, &subst_type, &subst_val);
					if (subst_val != NULL) Tcl_IncrRefCount(subst_val);
				} else if (subst_type == JSON_NUMBER) {
					Tcl_Obj*	forced;

					if (force_json_number(interp, scx->l, subst_val, &forced) != TCL_OK) {
						Tcl_ResetResult(interp);



						Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error substituting value from \"%s\" into template, not a number: \"%s\"", Tcl_GetString(val), Tcl_GetString(subst_val)));
						return TCL_ERROR;
					}

					if (subst_val != NULL)
						Tcl_DecrRefCount(subst_val);

					Tcl_IncrRefCount(subst_val = forced);
					Tcl_ResetResult(interp);
				}



				if (res == TCL_OK)
					res = serialize_json_val(interp, scx, subst_type, subst_val);

				if (subst_val != NULL)
					Tcl_DecrRefCount(subst_val);

................................................................................
	return res;
}

//}}}

void append_to_cx(struct parse_context* cx, Tcl_Obj* val) //{{{
{



	/*
	fprintf(stderr, "append_to_cx, storing %s: \"%s\"\n",
			type_names[val->internalRep.ptrAndLongRep.value],
			val->internalRep.ptrAndLongRep.ptr == NULL ? "NULL" :
			Tcl_GetString((Tcl_Obj*)val->internalRep.ptrAndLongRep.ptr));
	*/


	switch (cx->container) {
		case JSON_OBJECT:
			//fprintf(stderr, "append_to_cx, cx->hold_key->refCount: %d (%s)\n", cx->hold_key->refCount, Tcl_GetString(cx->hold_key));
			Tcl_DictObjPut(NULL, cx->val->internalRep.ptrAndLongRep.ptr, cx->hold_key, val);




			Tcl_InvalidateStringRep(cx->val);
			Tcl_DecrRefCount(cx->hold_key);
			cx->hold_key = NULL;
			break;

		case JSON_ARRAY:



			//fprintf(stderr, "append_to_cx, appending to list: (%s)\n", Tcl_GetString(val));
			Tcl_ListObjAppendElement(NULL, cx->val->internalRep.ptrAndLongRep.ptr, val);

			Tcl_InvalidateStringRep(cx->val);
			break;

		default:
			cx->val = val;
			Tcl_IncrRefCount(cx->val);
	}
}

//}}}

static int serialize(Tcl_Interp* interp, struct serialize_context* scx, Tcl_Obj* obj) //{{{
{

	int			type = 0, res;
	Tcl_Obj*	val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, obj, &type, &val));

	res = serialize_json_val(interp, scx, type, val);

	// The result of the serialization is left in scx->ds.  Once the caller
	// is done with this value it must be freed with Tcl_DStringFree()
	return res;
}

//}}}

static void free_internal_rep(Tcl_Obj* obj) //{{{
{
	Tcl_Obj*	jv = obj->internalRep.ptrAndLongRep.ptr;

	if (jv == NULL) return;

	Tcl_DecrRefCount(jv); jv = NULL;
}

//}}}
static void dup_internal_rep(Tcl_Obj* src, Tcl_Obj* dest) //{{{
{
	Tcl_Obj* src_intrep_obj = (Tcl_Obj*)src->internalRep.ptrAndLongRep.ptr;

	dest->typePtr = src->typePtr;

	if (src == src_intrep_obj) {
		int			len;
		const char*	str = Tcl_GetStringFromObj(src_intrep_obj, &len);
		// Don't know how this happens yet, but it's bad news - we get into an endless recursion of duplicateobj calls until the stack blows up

		// Panic and go via the string rep
		Tcl_IncrRefCount((Tcl_Obj*)(dest->internalRep.ptrAndLongRep.ptr = Tcl_NewStringObj(str, len)));
	} else {
		Tcl_IncrRefCount((Tcl_Obj*)(dest->internalRep.ptrAndLongRep.ptr = Tcl_DuplicateObj(src_intrep_obj)));
		if (src_intrep_obj->typePtr && src_intrep_obj->internalRep.ptrAndLongRep.value == JSON_ARRAY) {
			// List intreps are themselves shared - this horrible hack is to ensure that the intrep is unshared
			//fprintf(stderr, "forcing dedup of list intrep\n");
			Tcl_ListObjReplace(NULL, (Tcl_Obj*)dest->internalRep.ptrAndLongRep.ptr, 0, 0, 0, NULL);
		}
	}
	dest->internalRep.ptrAndLongRep.value = src->internalRep.ptrAndLongRep.value;

}

//}}}
static void update_string_rep(Tcl_Obj* obj) //{{{
{
	struct serialize_context	scx;
	Tcl_DString					ds;

	Tcl_DStringInit(&ds);

	scx.ds = &ds;
	scx.serialize_mode = SERIALIZE_NORMAL;
	scx.fromdict = NULL;
	scx.l = NULL;

	serialize(NULL, &scx, obj);

	obj->length = Tcl_DStringLength(&ds);
	obj->bytes = ckalloc(obj->length + 1);
	memcpy(obj->bytes, Tcl_DStringValue(&ds), obj->length);
	obj->bytes[obj->length] = 0;

	Tcl_DStringFree(&ds);	scx.ds = NULL;
}

//}}}
static int set_from_any(Tcl_Interp* interp, Tcl_Obj* obj) //{{{
{
	struct interp_cx*	l;
	const unsigned char*	err_at = NULL;
	const char*				errmsg = "Illegal character";
	size_t					char_adj = 0;		// Offset addjustment to account for multibyte UTF-8 sequences
	const unsigned char*	doc;
	enum json_types			type;
	Tcl_Obj*				val;
	const unsigned char*	p;
	const unsigned char*	e;
	const unsigned char*	val_start;
	int						len;
	struct parse_context	cx[CX_STACK_SIZE];

	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	cx[0].prev = NULL;
	cx[0].last = cx;
	cx[0].hold_key = NULL;
	cx[0].container = JSON_UNDEF;
	cx[0].val = NULL;
	cx[0].char_ofs = 0;
	cx[0].closed = 0;

	p = doc = (const unsigned char*)Tcl_GetStringFromObj(obj, &len);
	e = p + len;

	// Skip leading whitespace and comments
	if (skip_whitespace(&p, e, &errmsg, &err_at, &char_adj) != 0) goto whitespace_err;

	while (p < e) {
		if (cx[0].last->container == JSON_OBJECT) { // Read the key if in object mode {{{
			const unsigned char*	key_start = p;
			size_t					key_start_char_adj = char_adj;

			if (value_type(l, doc, p, e, &char_adj, &p, &type, &val) != TCL_OK) goto err;

			switch (type) {
				case JSON_DYN_STRING:
				case JSON_DYN_NUMBER:
				case JSON_DYN_BOOL:
				case JSON_DYN_JSON:
				case JSON_DYN_TEMPLATE:
				case JSON_DYN_LITERAL:
					/* Add back the template format prefix, since we can't store the type
					 * in the dict key.  The template generation code reparses it later.
					 */
					// Can do this because val's ref is on loan from new_stringobj_dedup
					val = Tcl_ObjPrintf("~%c:%s", key_start[2], Tcl_GetString(val));
					// Falls through
				case JSON_STRING:
					Tcl_IncrRefCount(cx[0].last->hold_key = val);
					break;

				default:
					_parse_error(interp, "Object key is not a string", doc, (key_start-doc) - key_start_char_adj);
					goto err;
			}

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj) != 0)) goto whitespace_err;

			if (unlikely(*p != ':')) {
				_parse_error(interp, "Expecting : after object key", doc, (p-doc) - char_adj);
				goto err;
			}
			p++;

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj) != 0)) goto whitespace_err;
		}
		//}}}

		val_start = p;
		if (value_type(l, doc, p, e, &char_adj, &p, &type, &val) != TCL_OK) goto err;

		switch (type) {
			case JSON_OBJECT:
				push_parse_context(cx, JSON_OBJECT, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj) != 0)) goto whitespace_err;

				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_ARRAY:
				push_parse_context(cx, JSON_ARRAY, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj) != 0)) goto whitespace_err;

				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
			case JSON_STRING:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_NUMBER:
				append_to_cx(cx->last, JSON_NewJvalObj(type, val));
				break;

			default:
				free_cx(cx);
				THROW_ERROR("Unexpected json value type: ", Tcl_GetString(Tcl_NewIntObj(type)));
		}

after_value:	// Yeah, goto.  But the alternative abusing loops was worse
		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj) != 0)) goto whitespace_err;
		if (p >= e) break;

		switch (cx[0].last->container) { // Handle eof and end-of-context or comma for array and object {{{
			case JSON_OBJECT:
				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					_parse_error(interp, "Expecting } or ,", doc, (p-doc) - char_adj);
					goto err;
				}

				p++;
				break;

			case JSON_ARRAY:
				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					_parse_error(interp, "Expecting ] or ,", doc, (p-doc) - char_adj);
					goto err;
				}

				p++;
				break;

			default:
				if (unlikely(p < e)) {
					_parse_error(interp, "Trailing garbage after value", doc, (p - doc) - char_adj);
					goto err;
				}
		}

		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj) != 0)) goto whitespace_err;
		//}}}
	}

	if (unlikely(cx != cx[0].last || !cx[0].closed)) { // Unterminated object or array context {{{
		switch (cx[0].last->container) {
			case JSON_OBJECT:
				_parse_error(interp, "Unterminated object", doc, cx[0].last->char_ofs);
				goto err;

			case JSON_ARRAY:
				_parse_error(interp, "Unterminated array", doc, cx[0].last->char_ofs);
				goto err;
		}
	}
	//}}}

	if (unlikely(cx[0].val == NULL)) {
		err_at = doc;
		errmsg = "No JSON value found";
		goto whitespace_err;
	}

	if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL)
		obj->typePtr->freeIntRepProc(obj);

	obj->typePtr = &json_type;
	obj->internalRep.ptrAndLongRep.value = cx[0].val->internalRep.ptrAndLongRep.value;
	obj->internalRep.ptrAndLongRep.ptr = cx[0].val->internalRep.ptrAndLongRep.ptr;

	// We're transferring the ref from cx[0].val to our intrep
	if (obj->internalRep.ptrAndLongRep.ptr != NULL) {
		// NULL signals a JSON null type
		Tcl_IncrRefCount((Tcl_Obj*)obj->internalRep.ptrAndLongRep.ptr);
	}

	Tcl_DecrRefCount(cx[0].val);
	cx[0].val = NULL;

	return TCL_OK;

whitespace_err:
	_parse_error(interp, errmsg, doc, (err_at - doc) - char_adj);

err:
	free_cx(cx);
	return TCL_ERROR;
}

//}}}

static int get_modifier(Tcl_Interp* interp, Tcl_Obj* modobj, enum modifiers* modifier) //{{{
{
	// This must be kept in sync with the modifiers enum
	static CONST char *modstrings[] = {
		"",
................................................................................
	TEST_OK(Tcl_GetIndexFromObj(interp, modobj, modstrings, "modifier", TCL_EXACT, &index));
	*modifier = index;

	return TCL_OK;
}

//}}}
int JSON_Set(Tcl_Interp* interp, Tcl_Obj* srcvar, Tcl_Obj *const pathv[], int pathc, Tcl_Obj* replacement) //{{{
{
	int				type, i, newtype;
	Tcl_Obj*		val;
	Tcl_Obj*		step;
	Tcl_Obj*		src;
	Tcl_Obj*		target;
	Tcl_Obj*		newval;

	TEST_OK(JSON_GetJvalFromObj(interp, replacement, &newtype, &newval));

	src = Tcl_ObjGetVar2(interp, srcvar, NULL, 0);
	if (src == NULL) {
		src = Tcl_ObjSetVar2(interp, srcvar, NULL, JSON_NewJvalObj(JSON_OBJECT, Tcl_NewDictObj()), TCL_LEAVE_ERR_MSG);
	}

	if (Tcl_IsShared(src)) {
		src = Tcl_ObjSetVar2(interp, srcvar, NULL, Tcl_DuplicateObj(src), TCL_LEAVE_ERR_MSG);
		if (src == NULL)
			return TCL_ERROR;
	}

	/*
	fprintf(stderr, "JSON_Set, srcvar: \"%s\", src: \"%s\"\n",
			Tcl_GetString(srcvar), Tcl_GetString(src));
			*/
	target = src;

	TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
	if (val != NULL && Tcl_IsShared(val)) {
		Tcl_DecrRefCount(val);
		val = Tcl_DuplicateObj(val);
		Tcl_IncrRefCount((Tcl_Obj*)(target->internalRep.ptrAndLongRep.ptr = val));
	}

	// Walk the path as far as it exists in src
	//fprintf(stderr, "set, initial type %s\n", type_names[type]);
	for (i=0; i<pathc; i++) {
		step = pathv[i];
		//fprintf(stderr, "looking at step %s, cx type: %s\n", Tcl_GetString(step), type_names_dbg[type]);

		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				TEST_OK(Tcl_DictObjGet(interp, val, step, &target));
				if (target == NULL) {
					//fprintf(stderr, "Path element %d: \"%s\" doesn't exist creating a new key for it and storing a null\n",
					//		i, Tcl_GetString(step));
					target = JSON_NewJvalObj(JSON_NULL, NULL);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
					i++;
					goto followed_path;
				}
				if (Tcl_IsShared(target)) {
					//fprintf(stderr, "Path element %d: \"%s\" exists but the TclObj is shared (%d), replacing it with an unshared duplicate\n",
					//		i, Tcl_GetString(step), target->refCount);
					target = Tcl_DuplicateObj(target);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
				}
				break;
				//}}}
			case JSON_ARRAY: //{{{
				{
					int			ac, index_str_len, ok=1;
					long		index;
					const char*	index_str;
					char*		end;
					Tcl_Obj**	av;

					TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
					//fprintf(stderr, "descending into array of length %d\n", ac);

					if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
						// Index isn't an integer, check for end(+/-int)?
						index_str = Tcl_GetStringFromObj(step, &index_str_len);
						if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
							ok = 0;

						if (ok) {
							index = ac-1;
							if (index_str_len >= 4) {
								if (index_str[3] != '-' && index_str[3] != '+') {
									ok = 0;
								} else {
									// errno is magically thread-safe on POSIX
									// systems (it's thread-local)
									errno = 0;
									index += strtol(index_str+3, &end, 10);
									if (errno != 0 || *end != 0)
										ok = 0;
								}
							}
						}

						if (!ok)
							THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

						//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
					} else {
						//fprintf(stderr, "Explicit index: %ld\n", index);
					}

					if (index < 0) {
						// Prepend element to the array
						target = JSON_NewJvalObj(JSON_NULL, NULL);
						TEST_OK(Tcl_ListObjReplace(interp, val, -1, 0, 1, &target));

						i++;
						goto followed_path;
					} else if (index >= ac) {
						int			new_i;
						for (new_i=ac; new_i<index; new_i++) {
							TEST_OK(Tcl_ListObjAppendElement(interp, val,
										JSON_NewJvalObj(JSON_NULL, NULL)));
						}
						target = JSON_NewJvalObj(JSON_NULL, NULL);
						TEST_OK(Tcl_ListObjAppendElement(interp, val, target));

						i++;
						goto followed_path;
					} else {
						target = av[index];
						if (Tcl_IsShared(target)) {
							target = Tcl_DuplicateObj(target);
							TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 1, &target));
						}
						//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
					}
				}
				break;
				//}}}
			case JSON_STRING:
			case JSON_NUMBER:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
				THROW_ERROR("Attempt to index into atomic type ", type_names[type], " at path key \"", Tcl_GetString(step), "\"");
				/*
				i++;
				goto followed_path;
				*/
			default:
				THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
		}

		TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
		//fprintf(stderr, "Followed path element %d: \"%s\", type %s\n", i, Tcl_GetString(step), type_names_dbg[type]);
		if (val != NULL && Tcl_IsShared(val)) {
			Tcl_DecrRefCount(val);
			val = Tcl_DuplicateObj(val);
			Tcl_IncrRefCount((Tcl_Obj*)(target->internalRep.ptrAndLongRep.ptr = val));
		}
		//fprintf(stderr, "Walked on to new type %s\n", type_names[type]);
	}

	goto set_val;

followed_path:
	TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
	//fprintf(stderr, "Followed path element %d: \"%s\", type %s\n", i, Tcl_GetString(step), type_names_dbg[type]);
	if (val != NULL && Tcl_IsShared(val)) {
		Tcl_DecrRefCount(val);
		val = Tcl_DuplicateObj(val);
		Tcl_IncrRefCount((Tcl_Obj*)(target->internalRep.ptrAndLongRep.ptr = val));
	}

	// target points at the (first) object to replace.  It and its internalRep
	// are unshared

	// If any path elements remain then they need to be created as object
	// keys
	//fprintf(stderr, "After walking path, %d elements remain to be created\n", pathc-i);
	for (; i<pathc; i++) {
		//fprintf(stderr, "create walk %d: %s, cx type: %s\n", i, Tcl_GetString(pathv[i]), type_names_dbg[type]);
		if (type != JSON_OBJECT) {
			//fprintf(stderr, "Type isn't JSON_OBJECT: %s, replacing with a JSON_OBJECT\n", type_names_dbg[type]);
			if (val != NULL)
				Tcl_DecrRefCount(val);
			val = Tcl_NewDictObj();
			TEST_OK(JSON_SetIntRep(interp, target, JSON_OBJECT, val));
		}

		target = JSON_NewJvalObj(JSON_OBJECT, Tcl_NewDictObj());
		//fprintf(stderr, "Adding key \"%s\"\n", Tcl_GetString(pathv[i]));
		TEST_OK(Tcl_DictObjPut(interp, val, pathv[i], target));
		TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
		//fprintf(stderr, "Newly added key \"%s\" is of type %s\n", Tcl_GetString(pathv[i]), type_names_dbg[type]);
		// This was just created - it can't be shared
	}

set_val:
	//fprintf(stderr, "Reached end of path, calling JSON_SetIntRep for replacement value %s (%s), target is %s\n",
	//		type_names_dbg[newtype], Tcl_GetString(replacement), type_names_dbg[type]);
	TEST_OK(JSON_SetIntRep(interp, target, newtype, newval));

	Tcl_InvalidateStringRep(src);

	if (interp)
		Tcl_SetObjResult(interp, src);

	return TCL_OK;
}

//}}}
static int unset_path(Tcl_Interp* interp, Tcl_Obj* srcvar, Tcl_Obj *const pathv[], int pathc) //{{{
{
	int				type, i;
	Tcl_Obj*		val;
	Tcl_Obj*		step;
	Tcl_Obj*		src;
	Tcl_Obj*		target;

	src = Tcl_ObjGetVar2(interp, srcvar, NULL, TCL_LEAVE_ERR_MSG);
	if (src == NULL)
		return TCL_ERROR;

	if (pathc == 0) {
		Tcl_SetObjResult(interp, src);
		return TCL_OK;	// Do Nothing Gracefully
	}

	if (Tcl_IsShared(src)) {
		src = Tcl_ObjSetVar2(interp, srcvar, NULL, Tcl_DuplicateObj(src), TCL_LEAVE_ERR_MSG);
		if (src == NULL)
			return TCL_ERROR;
	}

	/*
	fprintf(stderr, "JSON_Set, srcvar: \"%s\", src: \"%s\"\n",
			Tcl_GetString(srcvar), Tcl_GetString(src));
			*/
	target = src;

	TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
	if (val != NULL && Tcl_IsShared(val)) {
		Tcl_DecrRefCount(val);
		val = Tcl_DuplicateObj(val);
		Tcl_IncrRefCount((Tcl_Obj*)(target->internalRep.ptrAndLongRep.ptr = val));
	}

	// Walk the path as far as it exists in src
	//fprintf(stderr, "set, initial type %s\n", type_names[type]);
	for (i=0; i<pathc-1; i++) {
		step = pathv[i];
		//fprintf(stderr, "looking at step %s, cx type: %s\n", Tcl_GetString(step), type_names_dbg[type]);

		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				TEST_OK(Tcl_DictObjGet(interp, val, step, &target));
				if (target == NULL) {
					goto bad_path;
				}
				if (Tcl_IsShared(target)) {
					//fprintf(stderr, "Path element %d: \"%s\" exists but the TclObj is shared (%d), replacing it with an unshared duplicate\n",
					//		i, Tcl_GetString(step), target->refCount);
					target = Tcl_DuplicateObj(target);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
				}
				break;
				//}}}
			case JSON_ARRAY: //{{{
				{
					int			ac, index_str_len, ok=1;
					long		index;
					const char*	index_str;
					char*		end;
					Tcl_Obj**	av;

					TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
					//fprintf(stderr, "descending into array of length %d\n", ac);

					if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
						// Index isn't an integer, check for end(+/-int)?
						index_str = Tcl_GetStringFromObj(step, &index_str_len);
						if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
							ok = 0;

						if (ok) {
							index = ac-1;
							if (index_str_len >= 4) {
								if (index_str[3] != '-' && index_str[3] != '+') {
									ok = 0;
								} else {
									// errno is magically thread-safe on POSIX
									// systems (it's thread-local)
									errno = 0;
									index += strtol(index_str+3, &end, 10);
									if (errno != 0 || *end != 0)
										ok = 0;
								}
							}
						}

						if (!ok)
							THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

						//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
					} else {
						//fprintf(stderr, "Explicit index: %ld\n", index);
					}

					if (index < 0) {
						goto bad_path;
					} else if (index >= ac) {
						goto bad_path;
					} else {
						target = av[index];
						if (Tcl_IsShared(target)) {
							target = Tcl_DuplicateObj(target);
							TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 1, &target));
						}
						//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
					}
				}
				break;
				//}}}
			case JSON_STRING:
			case JSON_NUMBER:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
				THROW_ERROR("Attempt to index into atomic type ", type_names[type], " at path key \"", Tcl_GetString(step), "\"");
				/*
				i++;
				goto bad_path;
				*/
			default:
				THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
		}

		TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
		//fprintf(stderr, "Followed path element %d: \"%s\", type %s\n", i, Tcl_GetString(step), type_names_dbg[type]);
		if (val != NULL && Tcl_IsShared(val)) {
			Tcl_DecrRefCount(val);
			val = Tcl_DuplicateObj(val);
			Tcl_IncrRefCount((Tcl_Obj*)(target->internalRep.ptrAndLongRep.ptr = val));
		}
		//fprintf(stderr, "Walked on to new type %s\n", type_names[type]);
	}

	//fprintf(stderr, "Reached end of path, calling JSON_SetIntRep for replacement value %s (%s), target is %s\n",
	//		type_names_dbg[newtype], Tcl_GetString(replacement), type_names_dbg[type]);

	step = pathv[i];	// This names the key / element to unset
	//fprintf(stderr, "To replace: path step %d: \"%s\"\n", i, Tcl_GetString(step));
	switch (type) {
		case JSON_UNDEF: //{{{
			THROW_ERROR("Found JSON_UNDEF type jval following path");
			//}}}
		case JSON_OBJECT: //{{{
			TEST_OK(Tcl_DictObjRemove(interp, val, step));
			break;
			//}}}
		case JSON_ARRAY: //{{{
			{
				int			ac, index_str_len, ok=1;
				long		index;
				const char*	index_str;
				char*		end;
				Tcl_Obj**	av;

				TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
				//fprintf(stderr, "descending into array of length %d\n", ac);

				if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
					// Index isn't an integer, check for end(+/-int)?
					index_str = Tcl_GetStringFromObj(step, &index_str_len);
					if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
						ok = 0;

					if (ok) {
						index = ac-1;
						if (index_str_len >= 4) {
							if (index_str[3] != '-' && index_str[3] != '+') {
								ok = 0;
							} else {
								// errno is magically thread-safe on POSIX
								// systems (it's thread-local)
								errno = 0;
								index += strtol(index_str+3, &end, 10);
								if (errno != 0 || *end != 0)
									ok = 0;
							}
						}
					}

					if (!ok)
						THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

					//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
				} else {
					//fprintf(stderr, "Explicit index: %ld\n", index);
				}
				//fprintf(stderr, "Removing array index %d of %d\n", index, ac);

				if (index < 0) {
					break;
				} else if (index >= ac) {
					break;
				} else {
					TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 0, NULL));
					//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
				}
			}
			break;
			//}}}
		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
		case JSON_NULL:
		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			{
				const char* bad_path_str = Tcl_GetString(Tcl_NewListObj(i+1, pathv));
				Tcl_SetErrorCode(interp, "RL", "JSON", "BAD_PATH", bad_path_str, NULL);
				THROW_ERROR("Attempt to index into atomic type ", type_names[type], " at path \"", bad_path_str, "\"");
			}
		default:
			THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
	}

	Tcl_InvalidateStringRep(src);

	if (interp)
		Tcl_SetObjResult(interp, src);

	return TCL_OK;

bad_path:
	{
		const char* bad_path_str = Tcl_GetString(Tcl_NewListObj(i+1, pathv));
		Tcl_SetErrorCode(interp, "RL", "JSON", "BAD_PATH", bad_path_str, NULL);
		THROW_ERROR("Path element \"", bad_path_str, "\" doesn't exist");
	}
}

//}}}
static int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int pathc, Tcl_Obj** target, const int exists, const int modifiers) //{{{
{
	int				type, i, modstrlen;


	const char*		modstr;
	enum modifiers	modifier;
	Tcl_Obj*		val;
	Tcl_Obj*		step;

#define EXISTS(bool) \
	if (exists) { \

		Tcl_SetObjResult(interp, Tcl_NewBooleanObj(bool)); return TCL_OK; \
	}

	*target = src;


	if (unlikely(JSON_GetJvalFromObj(interp, *target, &type, &val) != TCL_OK)) {
		if (exists) {
			Tcl_ResetResult(interp);
			// [dict exists] considers any test to be false when applied to an invalid value, so we do the same
			EXISTS(0);
			return TCL_OK;
		}
		return TCL_ERROR;
	}

	//fprintf(stderr, "resolve_path, initial type %s\n", type_names[type]);
	for (i=0; i<pathc; i++) {
		step = pathv[i];
................................................................................
							switch (type) {
								case JSON_ARRAY:
									{
										int			ac;
										Tcl_Obj**	av;
										TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
										EXISTS(1);
										*target = Tcl_NewIntObj(ac);
									}
									break;
								case JSON_STRING:
									EXISTS(1);
									*target = Tcl_NewIntObj(Tcl_GetCharLength(val));
									break;
								case JSON_DYN_STRING:
								case JSON_DYN_NUMBER:
								case JSON_DYN_BOOL:
								case JSON_DYN_JSON:
								case JSON_DYN_TEMPLATE:
								case JSON_DYN_LITERAL:
									EXISTS(1);
									*target = Tcl_NewIntObj(Tcl_GetCharLength(val) + 3);
									break;
								default:
									EXISTS(0);
									THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							break;
							//}}}
................................................................................
								EXISTS(0);
								THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							{
								int	size;
								TEST_OK(Tcl_DictObjSize(interp, val, &size));
								EXISTS(1);
								*target = Tcl_NewIntObj(size);
							}
							break;
							//}}}
						case MODIFIER_TYPE: //{{{
							EXISTS(1);
							*target = Tcl_NewStringObj(type_names[type], -1);
							break;
							//}}}
						case MODIFIER_KEYS: //{{{
							if (type != JSON_OBJECT) {
								EXISTS(0);
								THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							{
								Tcl_DictSearch	search;
								Tcl_Obj*		k;
								Tcl_Obj*		v;
								int				done;
								Tcl_Obj*		res = Tcl_NewListObj(0, NULL);

								TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));
								if (exists) {
									Tcl_DictObjDone(&search);
									EXISTS(1);
								}



								for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
									if (Tcl_ListObjAppendElement(interp, res, k) != TCL_OK) {
										Tcl_DictObjDone(&search);
										return TCL_ERROR;
									}
								}
								Tcl_DictObjDone(&search);

								*target = res;

							}
							break;
							//}}}
						default:
							THROW_ERROR("Unhandled modifier type: ", Tcl_GetString(Tcl_NewIntObj(modifier)));
					}
					//fprintf(stderr, "Handled modifier, skipping descent check\n");
................................................................................
			}
		}
		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				TEST_OK(Tcl_DictObjGet(interp, val, step, target));
				if (*target == NULL) {
					EXISTS(0);
					THROW_ERROR(
							"Path element ",
							Tcl_GetString(Tcl_NewIntObj(pathc+1)),
							": \"", Tcl_GetString(step), "\" not found");


				}

				//TEST_OK(JSON_GetJvalFromObj(interp, src, &type, &val));
				//fprintf(stderr, "Descended into object, new type: %s, val: (%s)\n", type_names[type], Tcl_GetString(val));
				break;
				//}}}
			case JSON_ARRAY: //{{{
................................................................................
						//fprintf(stderr, "Explicit index: %ld\n", index);
					}

					if (index < 0 || index >= ac) {
						// Soft error - set target to an NULL object in
						// keeping with [lindex] behaviour
						EXISTS(0);
						*target = JSON_NewJvalObj(JSON_NULL, NULL);
						//fprintf(stderr, "index %ld is out of range [0, %d], setting target to a synthetic null\n", index, ac);
					} else {
						*target = av[index];
						//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(*target));
					}
				}
				break;
				//}}}
			case JSON_STRING:
			case JSON_NUMBER:
................................................................................
			case JSON_NULL:
			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:

				EXISTS(0);

				THROW_ERROR("Cannot descend into atomic type \"",
						type_names[type],
						"\" with path element ",
						Tcl_GetString(Tcl_NewIntObj(pathc)),

						": \"", Tcl_GetString(step), "\"");



			default:
				THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));


		}

		TEST_OK(JSON_GetJvalFromObj(interp, *target, &type, &val));
		//fprintf(stderr, "Walked on to new type %s\n", type_names[type]);
	}

	//fprintf(stderr, "Returning target: (%s)\n", Tcl_GetString(*target));
	EXISTS(type != JSON_NULL);
	return TCL_OK;
}

//}}}
static int convert_to_tcl(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** out) //{{{
{

	int			type, res = TCL_OK;
	Tcl_Obj*	val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, obj, &type, &val));
	/*
	fprintf(stderr, "Retrieved internal rep of jval: type: %s, intrep Tcl_Obj type: %s, object: %p\n",
			type_names[type], val && val->typePtr ? val->typePtr->name : "<no type>",
			val);
	*/

	switch (type) {
		case JSON_OBJECT:
			{
				int				done;
				Tcl_DictSearch	search;
				Tcl_Obj*		k;
				Tcl_Obj*		v;
				Tcl_Obj*		vo;


				*out = Tcl_NewDictObj();

				TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));

				for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
					if (
							convert_to_tcl(interp, v, &vo) != TCL_OK ||
							Tcl_DictObjPut(interp, *out, k, vo) != TCL_OK
					) {
						res = TCL_ERROR;
						break;
					}
				}
				Tcl_DictObjDone(&search);



			}
			break;

		case JSON_ARRAY:
			{
				int			i, oc;
				Tcl_Obj**	ov;
				Tcl_Obj*	elem;


				*out = Tcl_NewListObj(0, NULL);

				TEST_OK(Tcl_ListObjGetElements(interp, val, &oc, &ov));

				for (i=0; i<oc; i++) {
					TEST_OK(convert_to_tcl(interp, ov[i], &elem));
					TEST_OK(Tcl_ListObjAppendElement(interp, *out, elem));
				}



			}
			break;

		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
			*out = val;
			break;

		case JSON_NULL:
			*out = Tcl_NewObj();




			break;

		// These are all just semantically normal JSON string values in this
		// context
		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			*out = Tcl_ObjPrintf("%s%s", dyn_prefix[type], Tcl_GetString(val));
			break;

		default:
			THROW_ERROR("Invalid value type");
	}

	return res;
}

//}}}
static int _new_object(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res) //{{{
{
	int			i, ac;
	Tcl_Obj**	av;
	Tcl_Obj*	k;
	Tcl_Obj*	v;
	Tcl_Obj*	new_val;
	Tcl_Obj*	val;

	if (objc % 2 != 0)
		THROW_ERROR("json fmt object needs an even number of arguments");

	*res = JSON_NewJvalObj(JSON_OBJECT, Tcl_NewDictObj());
	val = ((Tcl_Obj*)*res)->internalRep.ptrAndLongRep.ptr;

	for (i=0; i<objc; i+=2) {
		k = objv[i];
		v = objv[i+1];
		TEST_OK(Tcl_ListObjGetElements(interp, v, &ac, &av));
		TEST_OK(new_json_value_from_list(interp, ac, av, &new_val));
		TEST_OK(Tcl_DictObjPut(interp, val, k, new_val));
	}

	return TCL_OK;
}

//}}}
static int new_json_value_from_list(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res) //{{{
{
	int		new_type;
	static const char* types[] = {
		"string",
		"object",
		"array",
		"number",
		"true",
		"false",
		"null",
		"boolean",
		"json",
		(char*)NULL
	};
	enum {
		NEW_STRING,
		NEW_OBJECT,
		NEW_ARRAY,
		NEW_NUMBER,
		NEW_TRUE,
		NEW_FALSE,
		NEW_NULL,
		NEW_BOOL,
		NEW_JSON
	};

	if (objc < 1) CHECK_ARGS(0, "type ?val?");

	TEST_OK(Tcl_GetIndexFromObj(interp, objv[0], types, "type", 0, &new_type));

	switch (new_type) {
		case NEW_STRING: //{{{
			{
				int			l, type;
				const char*	s;
				CHECK_ARGS(1, "string val");
				s = Tcl_GetStringFromObj(objv[1], &l);
				if (
						l >= 3 &&
						s[0] == '~' &&
						s[2] == ':'
				) {
					switch (s[1]) {
						case 'S': type = JSON_DYN_STRING; break;
						case 'N': type = JSON_DYN_NUMBER; break;
						case 'B': type = JSON_DYN_BOOL; break;
						case 'J': type = JSON_DYN_JSON; break;
						case 'T': type = JSON_DYN_TEMPLATE; break;
						case 'L': type = JSON_DYN_LITERAL; break;
						default:  type = JSON_UNDEF; break;
					}

					if (type != JSON_UNDEF) {
						*res = JSON_NewJvalObj(type, Tcl_NewStringObj((const char*)s+3, l-3));
						break;
					}
				}
				*res = JSON_NewJvalObj(JSON_STRING, Tcl_NewStringObj(s, l));
			}
			break;
			//}}}
		case NEW_OBJECT: //{{{
			{
				int			oc;
				Tcl_Obj**	ov;

				if (objc == 2) {
					TEST_OK(Tcl_ListObjGetElements(interp, objv[1], &oc, &ov));
					TEST_OK(_new_object(interp, oc, ov, res));
				} else {
					TEST_OK(_new_object(interp, objc-1, objv+1, res));
				}
			}
			break;
			//}}}
		case NEW_ARRAY: //{{{
			{
				int			i, ac;
				Tcl_Obj**	av;
				Tcl_Obj*	elem;
				Tcl_Obj*	val;

				*res = JSON_NewJvalObj(JSON_ARRAY, Tcl_NewListObj(0, NULL));
				val = ((Tcl_Obj*)*res)->internalRep.ptrAndLongRep.ptr;
				for (i=1; i<objc; i++) {
					TEST_OK(Tcl_ListObjGetElements(interp, objv[i], &ac, &av));
					TEST_OK(new_json_value_from_list(interp, ac, av, &elem));
					TEST_OK(Tcl_ListObjAppendElement(interp, val, elem));
				}
			}
			break;
			//}}}
		case NEW_NUMBER: //{{{
			{
				Tcl_Obj*	forced;
				struct interp_cx* l = Tcl_GetAssocData(interp, "rl_json", NULL);

				CHECK_ARGS(1, "number val");
				TEST_OK(force_json_number(interp, l, objv[1], &forced));
				*res = JSON_NewJvalObj(JSON_NUMBER, forced);
			}
			break;
			//}}}
		case NEW_TRUE: //{{{
			{
				CHECK_ARGS(0, "true");
				*res = JSON_NewJvalObj(JSON_BOOL, Tcl_NewBooleanObj(1));
			}
			break;
			//}}}
		case NEW_FALSE: //{{{
			{
				CHECK_ARGS(0, "false");
				*res = JSON_NewJvalObj(JSON_BOOL, Tcl_NewBooleanObj(0));
			}
			break;
			//}}}
		case NEW_NULL: //{{{
			CHECK_ARGS(0, "null");
			*res = JSON_NewJvalObj(JSON_NULL, NULL);
			break;
			//}}}
		case NEW_BOOL: //{{{
			{
				int b;

				CHECK_ARGS(1, "boolean val");
				TEST_OK(Tcl_GetBooleanFromObj(interp, objv[1], &b));
				*res = JSON_NewJvalObj(JSON_BOOL, Tcl_NewBooleanObj(b));
			}
			break;
			//}}}
		case NEW_JSON: //{{{
			{
				int _type;
				Tcl_Obj *_val;

				CHECK_ARGS(1, "json val");
				TEST_OK(JSON_GetJvalFromObj(interp, objv[1], &_type, &_val));
				*res = objv[1];
			}
			break;
			//}}}
		default:
			THROW_ERROR("Invalid new_type: ", Tcl_GetString(Tcl_NewIntObj(new_type)));
	}



	return TCL_OK;
}

//}}}
static void foreach_state_free(struct foreach_state* state) //{{{
{
	unsigned int i, j;

................................................................................
	return Tcl_NREvalObj(interp, state->script, 0);
}

//}}}
static int NRforeach_next_loop_bottom(ClientData cdata[], Tcl_Interp* interp, int retcode) //{{{
{
	struct foreach_state*	state = (struct foreach_state*)cdata[0];



	switch (retcode) {
		case TCL_OK:
			if (state->res != NULL) // collecting





				TEST_OK_LABEL(done, retcode, Tcl_ListObjAppendElement(interp, state->res, Tcl_GetObjResult(interp)));

			break;

































































		case TCL_CONTINUE:
			retcode = TCL_OK;
			break;

		case TCL_BREAK:
			retcode = TCL_OK;
................................................................................
		if (state->res != NULL) {
			Tcl_SetObjResult(interp, state->res);
		}
	}

done:
	//fprintf(stderr, "done\n");





	if (retcode == TCL_OK && state->res != NULL /* collecting */)
		Tcl_SetObjResult(interp, state->res);

	foreach_state_free(state);
	Tcl_Free((char*)state);
	state = NULL;

	return retcode;
}

//}}}
static int foreach(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], int collecting) //{{{
{
	// Caller must ensure that objc is valid
	unsigned int			i;
	int						retcode=TCL_OK;
	struct foreach_state*	state = NULL;

	state = (struct foreach_state*)Tcl_Alloc(sizeof(*state));
	state->iterators = (objc-1)/2;
	state->it = (struct foreach_iterator*)Tcl_Alloc(sizeof(struct foreach_iterator) * state->iterators);
	state->max_loops = 0;
	state->loop_num = 0;


	Tcl_IncrRefCount(state->script = objv[objc-1]);

	if (collecting) {
		Tcl_IncrRefCount(state->res = Tcl_NewListObj(0, NULL));
	} else {
		state->res = NULL;












	}

	for (i=0; i<state->iterators; i++) {
		state->it[i].search.dictionaryPtr = NULL;
		state->it[i].data_v = NULL;
		state->it[i].is_array = 0;
		state->it[i].var_v = NULL;
		state->it[i].varlist = NULL;
	}

	for (i=0; i<state->iterators; i++) {
		int			loops, type, j;

		Tcl_Obj*	val;
		Tcl_Obj*	varlist = objv[i*2];

		if (Tcl_IsShared(varlist))
			varlist = Tcl_DuplicateObj(varlist);

		Tcl_IncrRefCount(state->it[i].varlist = varlist);

		TEST_OK_LABEL(done, retcode, Tcl_ListObjGetElements(interp, state->it[i].varlist, &state->it[i].var_c, &state->it[i].var_v));
................................................................................
	}

	if (state->loop_num < state->max_loops)
		return NRforeach_next_loop_top(interp, state);

done:
	//fprintf(stderr, "done\n");
	if (retcode == TCL_OK && collecting)
		Tcl_SetObjResult(interp, state->res);

	foreach_state_free(state);
	Tcl_Free((char*)state);
	state = NULL;

	return retcode;
}

//}}}
static int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds) //{{{
{
	int							type, indent_len, pad_len, next_pad_len, count;

	const char*					pad_str;
	const char*					next_pad_str;
	Tcl_Obj*					next_pad;
	Tcl_Obj*					val;
	struct serialize_context	scx;

	scx.ds = ds;
	scx.serialize_mode = SERIALIZE_NORMAL;
	scx.fromdict = NULL;
	scx.l = Tcl_GetAssocData(interp, "rl_json", NULL);


	TEST_OK(JSON_GetJvalFromObj(interp, json, &type, &val));

	Tcl_GetStringFromObj(indent, &indent_len);
	pad_str = Tcl_GetStringFromObj(pad, &pad_len);

	switch (type) {
................................................................................
			serialize(interp, &scx, json);
	}

	return TCL_OK;
}

//}}}
#if 0
static int json_pretty_dbg(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds) //{{{
{
	int							type, indent_len, pad_len, next_pad_len, count;

	const char*					pad_str;
	const char*					next_pad_str;
	Tcl_Obj*					next_pad;
	Tcl_Obj*					val;
	struct serialize_context	scx;

	scx.ds = ds;
	scx.serialize_mode = SERIALIZE_NORMAL;
	scx.fromdict = NULL;
	scx.l = Tcl_GetAssocData(interp, "rl_json", NULL);


	TEST_OK(JSON_GetJvalFromObj(interp, json, &type, &val));

	Tcl_GetStringFromObj(indent, &indent_len);
	pad_str = Tcl_GetStringFromObj(pad, &pad_len);

	if (type == JSON_NULL) {
................................................................................

		default:
			serialize_json_val(interp, &scx, type, val);
	}

	return TCL_OK;
}
#endif
//}}}
#if 0
static int merge(Tcl_Interp* interp, int deep, Tcl_Obj *const orig, Tcl_Obj *const patch, Tcl_Obj **const res) //{{{
{
	Tcl_Obj*		val;
	Tcl_Obj*		pval;
	int				type, ptype, done, retcode=TCL_OK;
................................................................................
		default:
			THROW_ERROR("Unsupported JSON type: ", Tcl_GetString(Tcl_NewIntObj(type)));
	}
}

//}}}
#endif
static int prev_opcode(struct template_cx* cx) //{{{
{
	int			len, opcode;
	Tcl_Obj*	last = NULL;

	TEST_OK(Tcl_ListObjLength(cx->interp, cx->actions, &len));

	if (len == 0) return NOP;

	TEST_OK(Tcl_ListObjIndex(cx->interp, cx->actions, len-2, &last));
	TEST_OK(Tcl_GetIndexFromObj(cx->interp, last, action_opcode_str, "opcode", TCL_EXACT, &opcode));

	return opcode;
}

//}}}
static int emit_action(struct template_cx* cx, enum action_opcode opcode, Tcl_Obj* value) // TODO: inline? {{{
{



	//fprintf(stderr, "opcode %s: %s\n", Tcl_GetString(cx->l->action[action]), value == NULL ? "NULL" : Tcl_GetString(value));



	if (opcode == POP_CX) {
		int			prev, len;




		TEST_OK(Tcl_ListObjLength(cx->interp, cx->actions, &len));


		prev = prev_opcode(cx);

		if (prev == CX_OBJ_KEY || prev == CX_ARR_IDX) {
			TEST_OK(Tcl_ListObjReplace(cx->interp, cx->actions, len-2, 2, 0, NULL));
			return TCL_OK;
		} else if (prev == POP_CX) {
			// Fold pops
			int			depth;

			Tcl_Obj*	depthobj;

			TEST_OK(Tcl_ListObjIndex(cx->interp, cx->actions, len-1, &depthobj));
			TEST_OK(Tcl_GetIntFromObj(cx->interp, depthobj, &depth));
			if (Tcl_IsShared(depthobj)) {
				depthobj = Tcl_DuplicateObj(depthobj);
				TEST_OK(Tcl_ListObjReplace(cx->interp, cx->actions, len-1, 1, 1, &depthobj));
			}

			Tcl_SetIntObj(depthobj, depth+1);
			return TCL_OK;



		}



	}
	TEST_OK(Tcl_ListObjAppendElement(cx->interp, cx->actions, cx->l->action[opcode]));
	if (value == NULL) {
		TEST_OK(Tcl_ListObjAppendElement(cx->interp, cx->actions, cx->l->tcl_empty));




































	} else {
		TEST_OK(Tcl_ListObjAppendElement(cx->interp, cx->actions, value));



	}



















	return TCL_OK;
}

//}}}
static int get_subst_slot(struct template_cx* cx, Tcl_Obj* elem, Tcl_Obj* type, int subst_type, Tcl_Obj** slot) //{{{
{

	Tcl_Obj*	keydict = NULL;


	// Find the map for this key
	TEST_OK(Tcl_DictObjGet(cx->interp, cx->map, elem, &keydict));
	if (keydict == NULL) {
		keydict = Tcl_NewDictObj();
		TEST_OK(Tcl_DictObjPut(cx->interp, cx->map, elem, keydict));
	}


	// Find the allocated slot for this type for this key
	TEST_OK(Tcl_DictObjGet(cx->interp, keydict, type, slot));
	if (*slot == NULL) {


		*slot = Tcl_NewIntObj(cx->slots_used++);
		TEST_OK(Tcl_DictObjPut(cx->interp, keydict, type, *slot));
		/*
		fprintf(stderr, "Allocated new slot for %s %s: %s\n", Tcl_GetString(elem), Tcl_GetString(type), Tcl_GetString(*slot));
	} else {
		fprintf(stderr, "Found slot for %s %s: %s\n", Tcl_GetString(elem), Tcl_GetString(type), Tcl_GetString(*slot));
		*/

		// Slot population actions
		if (subst_type == JSON_DYN_LITERAL) {
			TEST_OK(emit_action(cx, JVAL_LITERAL, elem));
			TEST_OK(emit_action(cx, FILL_SLOT, *slot));
		} else {
			TEST_OK(emit_action(cx, FETCH_VALUE, elem));

			// Each of these actions checks for NULL in value and inserts a JSON null in that case
			switch (subst_type) {
				case JSON_DYN_STRING: //{{{
					TEST_OK(emit_action(cx, JVAL_STRING, NULL));
					TEST_OK(emit_action(cx, FILL_SLOT, *slot));
					break;
					//}}}
				case JSON_DYN_JSON: //{{{
					TEST_OK(emit_action(cx, JVAL_JSON, NULL));
					TEST_OK(emit_action(cx, FILL_SLOT, *slot));
					break;
					//}}}
				case JSON_DYN_TEMPLATE: //{{{
					TEST_OK(emit_action(cx, EVALUATE_TEMPLATE, NULL));
					TEST_OK(emit_action(cx, JVAL_JSON, NULL));
					TEST_OK(emit_action(cx, FILL_SLOT, *slot));
					break;
					//}}}
				case JSON_DYN_NUMBER: //{{{
					TEST_OK(emit_action(cx, JVAL_NUMBER, NULL));
					TEST_OK(emit_action(cx, FILL_SLOT, *slot));
					break;
					//}}}
				case JSON_DYN_BOOL: //{{{
					TEST_OK(emit_action(cx, JVAL_BOOLEAN, NULL));
					TEST_OK(emit_action(cx, FILL_SLOT, *slot));
					break;
					//}}}
				default:
					Tcl_SetObjResult(cx->interp, Tcl_ObjPrintf("Invalid type \"%s\"", Tcl_GetString(type)));
					// TODO: errorcode?
					return TCL_ERROR;


			}


		}
	}

	return TCL_OK;
}

//}}}
/*
static int record_subst_location(Tcl_Interp* interp, Tcl_Obj* parent, Tcl_Obj* elem, Tcl_Obj* registry, Tcl_Obj* slot) //{{{
{
	Tcl_Obj*	path_info = NULL;
................................................................................
	TEST_OK(Tcl_DictObjPut(interp, path_info, elem, slot));

	return TCL_OK;
}

//}}}
*/













static int template_actions(struct template_cx* cx, Tcl_Obj* template, Tcl_Obj* path, Tcl_Obj* parent, Tcl_Obj* elem) //{{{
{
	int			type;
	Tcl_Obj*	val = NULL;
	Tcl_Interp*	interp = cx->interp;


	TEST_OK(JSON_GetJvalFromObj(interp, template, &type, &val));

	switch (type) {
		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
		case JSON_NULL:
			break;

		case JSON_OBJECT:
			{
				int				done, tail;
				Tcl_DictSearch	search;
				Tcl_Obj*		k;
				Tcl_Obj*		v;
				Tcl_Obj*		subpath = Tcl_DuplicateObj(path);

				Tcl_IncrRefCount(subpath = Tcl_DuplicateObj(path));
				TEST_OK(Tcl_ListObjLength(interp, subpath, &tail));


				TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));
				for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
					int			len, stype;

					const char*	s = Tcl_GetStringFromObj(k, &len);

					TEST_OK(emit_action(cx, CX_OBJ_KEY, k));
					TEST_OK(Tcl_ListObjAppendElement(interp, subpath, k));
					TEST_OK(template_actions(cx, v, subpath, path, k));


					// Check for key substs after walking through the children (and emitting any replacement opcodes)
					// Have to do the template subst here rather than at
					// parse time since the dict keys would be broken otherwise
					if (
							len >= 3 &&
							s[0] == '~' &&
							s[2] == ':'
					) {

						switch (s[1]) {
							case 'S': stype = JSON_DYN_STRING; break;
							case 'L': stype = JSON_DYN_LITERAL; break;

							case 'N':
							case 'B':
							case 'J':
							case 'T':
								THROW_ERROR("Only strings allowed as object keys");


							default:  stype = JSON_UNDEF; break;
						}



						if (stype != JSON_UNDEF) {
							Tcl_Obj*	slot = NULL;

							TEST_OK(get_subst_slot(cx, new_stringobj_dedup(cx->l, s+3, len-3), cx->l->type[stype], stype, &slot));
							//fprintf(stderr, "Found key subst at \"%s\": (%s) %s %s, allocated slot %s\n", Tcl_GetString(path), Tcl_GetString(k), type_names_dbg[stype], s+3, Tcl_GetString(slot));

							//TEST_OK(record_subst_location(cx->interp, path, k, cx->keys, slot));


							TEST_OK(emit_action(cx, REPLACE_KEY, slot));
						}


					}


					TEST_OK(emit_action(cx, POP_CX, cx->l->tcl_one));



					if (Tcl_IsShared(subpath)) { // the paths cx dict will pick up references to subpath
						Tcl_DecrRefCount(subpath);
						Tcl_IncrRefCount(subpath = Tcl_DuplicateObj(subpath));
					}
					TEST_OK(Tcl_ListObjReplace(interp, subpath, tail, 1, 0, NULL));
				}

				Tcl_DictObjDone(&search);






				Tcl_DecrRefCount(subpath); subpath = NULL;

			}
			break;

		case JSON_ARRAY:
			{
				int			i, oc, tail;
				Tcl_Obj**	ov;
				Tcl_Obj*	subpath = NULL;
				Tcl_Obj*	elem = NULL;

				Tcl_IncrRefCount(subpath = Tcl_DuplicateObj(path));
				TEST_OK(Tcl_ListObjLength(interp, subpath, &tail));


				TEST_OK(Tcl_ListObjGetElements(interp, val, &oc, &ov));
				for (i=0; i<oc; i++) {
					elem = Tcl_NewIntObj(i);
					Tcl_IncrRefCount(elem);
					TEST_OK(emit_action(cx, CX_ARR_IDX, elem));
					TEST_OK(Tcl_ListObjAppendElement(interp, subpath, elem));
					TEST_OK(template_actions(cx, ov[i], subpath, path, elem))

					if (Tcl_IsShared(subpath)) { // the paths cx dict will pick up references to subpath
						Tcl_DecrRefCount(subpath);
						Tcl_IncrRefCount(subpath = Tcl_DuplicateObj(subpath));
					}
					TEST_OK(Tcl_ListObjReplace(interp, subpath, tail, 1, 0, NULL));
					Tcl_DecrRefCount(elem); elem = NULL;
					TEST_OK(emit_action(cx, POP_CX, cx->l->tcl_one));
				}

				Tcl_DecrRefCount(subpath); subpath = NULL;
			}
			break;

		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			{
				Tcl_Obj*	slot = NULL;

				TEST_OK(get_subst_slot(cx, val, cx->l->type[type], type, &slot));

				//fprintf(stderr, "Found value subst at \"%s\": (%s) %s: %s, allocated slot %s\n", Tcl_GetString(parent), Tcl_GetString(elem), type_names_dbg[type], Tcl_GetString(val), Tcl_GetString(slot));



				//TEST_OK(record_subst_location(cx->interp, parent, elem, cx->values, slot));
				TEST_OK(emit_action(cx, REPLACE_VAL, slot));
			}
			break;

		default:
			THROW_ERROR("unhandled type: %d", type);
	}

	return TCL_OK;
}

//}}}
static int build_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj** actions) //{{{
{

	struct template_cx	cx;

	cx.interp = interp;
	cx.l = Tcl_GetAssocData(interp, "rl_json", NULL);
	cx.map = Tcl_NewDictObj();
	cx.actions = Tcl_NewListObj(0, NULL);
	cx.slots_used = 0;


	Tcl_IncrRefCount(cx.map);



	TEST_OK(template_actions(&cx, template, Tcl_NewObj(), Tcl_NewObj(), Tcl_NewObj()));
	{ // trim trailing POP_CX opcodes
		int			len;
		Tcl_Obj*	last = NULL;
		int			opcode;

		TEST_OK(Tcl_ListObjLength(interp, cx.actions, &len));
		if (len > 0) {
			TEST_OK(Tcl_ListObjIndex(interp, cx.actions, len-2, &last));
			TEST_OK(Tcl_GetIndexFromObj(interp, last, action_opcode_str, "opcode", TCL_EXACT, &opcode));
			if (opcode == POP_CX) {
				TEST_OK(Tcl_ListObjReplace(interp, cx.actions, len-2, 2, 0, NULL));



			}
		}
	}

	if (cx.slots_used) { // Prepend the template action to allocate the slots
		Tcl_Obj*	ov[2];


		ov[0] = cx.l->action[ALLOCATE_SLOTS];
		ov[1] = Tcl_NewIntObj(cx.slots_used);
		TEST_OK(Tcl_ListObjReplace(cx.interp, cx.actions, 0, 0, 2, ov));






		{ // Find max cx stack depth
			int			depth=1, maxdepth=1, actionc, i;
			Tcl_Obj**	actionv;
			Tcl_Obj*	ov[2];


			TEST_OK(Tcl_ListObjGetElements(interp, cx.actions, &actionc, &actionv));


			for (i=0; i<actionc; i+=2) {
				int			opcode, levels;


				TEST_OK(Tcl_GetIndexFromObj(interp, actionv[i], action_opcode_str, "opcode", TCL_EXACT, &opcode));

				switch (opcode) {
					case CX_OBJ_KEY:
					case CX_ARR_IDX:

						if (++depth > maxdepth) maxdepth = depth;
						break;

					case POP_CX:
						TEST_OK(Tcl_GetIntFromObj(interp, actionv[i+1], &levels));
						depth -= levels;
						break;
				}
			}

			// Prepend a stack allocation instruction

			ov[0] = cx.l->action[ALLOCATE_STACK];
			ov[1] = Tcl_NewIntObj(maxdepth);








			TEST_OK(Tcl_ListObjReplace(interp, cx.actions, 0, 0, 2, ov));

		}



	}

	*actions = cx.actions;


	Tcl_DecrRefCount(cx.map); cx.map = NULL;




	return TCL_OK;
}

//}}}
/*
static int lookup_type(Tcl_Interp* interp, Tcl_Obj* typeobj, int* type) //{{{
{
	// Must match the order in the json_types enum
	static const char *types[] = {
		"JSON_UNDEF",
		"JSON_OBJECT",
		"JSON_ARRAY",
		"JSON_STRING",
		"JSON_NUMBER",
		"JSON_BOOL",
		"JSON_NULL",
		"JSON_DYN_STRING",
		"JSON_DYN_NUMBER",
		"JSON_DYN_BOOL",
		"JSON_DYN_JSON",
		"JSON_DYN_TEMPLATE",
		"JSON_DYN_LITERAL",
		(char*)NULL
	};

	TEST_OK(Tcl_GetIndexFromObj(interp, typeobj, types, "type", TCL_EXACT, type));

	return TCL_OK;
}

//}}}
*/
static int replace(Tcl_Interp* interp, struct cx_stack* containers, int stacklevel, Tcl_Obj* replacement) //{{{

{
	int			containertype;
	Tcl_Obj*	container;


	//fprintf(stderr, "Replacing key %s in %s with %s\n", containers[stacklevel].elem ? Tcl_GetString(containers[stacklevel].elem) : "NULL", Tcl_GetString(containers[stacklevel].target), Tcl_GetString(replacement));
	TEST_OK(JSON_GetJvalFromObj(interp, containers[stacklevel].target, &containertype, &container));

	if (containers[stacklevel].elem == NULL) {
		// Top-level
		containers[stacklevel].target = replacement;
	} else if (containertype == JSON_OBJECT) {
		if (Tcl_IsShared(containers[stacklevel].target))
			Tcl_Panic("Parent container is shared");

		TEST_OK(Tcl_DictObjPut(interp, container, containers[stacklevel].elem, replacement));
	} else {
		int			idx;

		if (Tcl_IsShared(containers[stacklevel].target))
			Tcl_Panic("Parent container is shared");

		TEST_OK(Tcl_GetIntFromObj(interp, containers[stacklevel].elem, &idx));
		//fprintf(stderr, "replacing offset %d in array\n", idx);
		TEST_OK(Tcl_ListObjReplace(interp, container, idx, 1, 1, &replacement));
	}
	Tcl_InvalidateStringRep(containers[stacklevel].target);
	//fprintf(stderr, "res: %s\n", Tcl_GetString(*res));
	return TCL_OK;
}

//}}}
static int apply_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* actions, Tcl_Obj* dict, Tcl_Obj** res) // dict may be null, which means lookup vars {{{
{
	struct interp_cx* l = NULL;


	Tcl_Obj**	slots = NULL;
	int			slotslen = 0;
	int			retcode = TCL_OK;
	Tcl_Obj**	actionv;
	int			actionc, i;
	struct cx_stack*	containers = NULL;


	int			stacklevel = 0;
	Tcl_Obj*	subst_val = NULL;
	Tcl_Obj*	jval = NULL;
	Tcl_Obj*	key = NULL;
	int			slot, stacklevels=0;
	Tcl_Obj*	target = NULL;

#define REPLACE(newobj) \
		TEST_OK_LABEL(finally, retcode, replace(interp, containers, stacklevel, (newobj)));

	TEST_OK_LABEL(finally, retcode, Tcl_ListObjGetElements(interp, actions, &actionc, &actionv));
	if (actionc == 0) {
		*res = template;

		Tcl_InvalidateStringRep(*res);		// Some code relies on the fact that the result of the template command is a normalized json doc (no unnecessary whitespace / newlines)
		return TCL_OK;
	}

	if (actionc % 2 != 0)
		THROW_ERROR_LABEL(finally, retcode, "Invalid actions (odd number of elements)");

	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	for (i=0; i<actionc; i+=2) {
		int			opcode;

		Tcl_Obj*	value = actionv[i+1];


		TEST_OK_LABEL(finally, retcode, Tcl_GetIndexFromObj(interp, actionv[i], action_opcode_str, "opcode", TCL_EXACT, &opcode));

		//fprintf(stderr, "%s (%s)\n", Tcl_GetString(actionv[i]), Tcl_GetString(value));
		switch (opcode) {
			case ALLOCATE_SLOTS: //{{{
				{

					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, value, &slotslen));

					slots = ckalloc(sizeof(Tcl_Obj*) * slotslen);




					memset(slots, 0, sizeof(Tcl_Obj*) * slotslen);
				}
				break;
				//}}}
			case ALLOCATE_STACK: //{{{
				{
					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, value, &stacklevels));

					containers = ckalloc(sizeof(struct cx_stack) * stacklevels);



					containers[stacklevel].target = target = template;
					containers[stacklevel].elem = NULL;

				}
				break;
				//}}}
			case FETCH_VALUE: //{{{
				key = value;	// Keep a reference in case we need it for an error message shortly
				if (dict) {

					TEST_OK_LABEL(finally, retcode, Tcl_DictObjGet(interp, dict, value, &subst_val));

				} else {
					subst_val = Tcl_ObjGetVar2(interp, value, NULL, 0);
				}
				break;
				//}}}
			case JVAL_LITERAL: //{{{
				jval = JSON_NewJvalObj(JSON_STRING, value);

				break;
				//}}}
			case JVAL_STRING: //{{{

				if (subst_val == NULL) {
					jval = l->json_null;
				} else {
					const char*	str;
					int			len;


					str = Tcl_GetStringFromObj(subst_val, &len);
					if (len == 0) {
						jval = l->json_empty_string;
					} else if (len < 3) {
						jval = JSON_NewJvalObj(JSON_STRING, subst_val);
					} else {
						if (str[0] == '~' && str[2] == ':') {
							switch (str[1]) {

								case 'S': jval = JSON_NewJvalObj(JSON_DYN_STRING,   new_stringobj_dedup(l, str+3, len-3)); break;
								case 'N': jval = JSON_NewJvalObj(JSON_DYN_NUMBER,   new_stringobj_dedup(l, str+3, len-3)); break;
								case 'B': jval = JSON_NewJvalObj(JSON_DYN_BOOL,     new_stringobj_dedup(l, str+3, len-3)); break;
								case 'J': jval = JSON_NewJvalObj(JSON_DYN_JSON,     new_stringobj_dedup(l, str+3, len-3)); break;
								case 'T': jval = JSON_NewJvalObj(JSON_DYN_TEMPLATE, new_stringobj_dedup(l, str+3, len-3)); break;
								case 'L': jval = JSON_NewJvalObj(JSON_DYN_LITERAL,  new_stringobj_dedup(l, str+3, len-3)); break;
								default:  jval = JSON_NewJvalObj(JSON_STRING,       subst_val);                            break;
							}


						} else {
							jval = JSON_NewJvalObj(JSON_STRING, subst_val);

						}
					}


				}
				break;
				//}}}
			case JVAL_NUMBER: //{{{

				if (subst_val == NULL) {
					jval = l->json_null;
				} else {


					if (force_json_number(interp, l, subst_val, NULL) != TCL_OK) {
						Tcl_ResetResult(interp);





						Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error substituting value from \"%s\" into template, not a number: \"%s\"", Tcl_GetString(key), Tcl_GetString(subst_val)));
						retcode = TCL_ERROR;
						goto finally;
					}

					jval = JSON_NewJvalObj(JSON_NUMBER, subst_val);
					Tcl_ResetResult(interp);
				}
				break;
				//}}}
			case JVAL_BOOLEAN: //{{{

				if (subst_val == NULL) {
					jval = l->json_null;
				} else {
					int is_true;

					TEST_OK_LABEL(finally, retcode, Tcl_GetBooleanFromObj(interp, subst_val, &is_true));

					jval = is_true ? l->json_true : l->json_false;
				}
				break;
				//}}}
			case JVAL_JSON: //{{{

				if (subst_val == NULL) {
					jval = l->json_null;
				} else {
					Tcl_Obj*	dummy;
					int			subst_type;

					TEST_OK_LABEL(finally, retcode, JSON_GetJvalFromObj(interp, subst_val, &subst_type, &dummy));
					jval = subst_val;

				}
				break;
				//}}}
			case FILL_SLOT: //{{{
				TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, value, &slot));
				slots[slot] = jval;
				break;
				//}}}
			case EVALUATE_TEMPLATE: //{{{
				{
					Tcl_Obj*	sub_template_actions = Tcl_NewDictObj();




					if (subst_val) {


						// recursively fill out sub template
						// TODO: subst_val refcount?

						TEST_OK_LABEL(finally, retcode, build_template_actions(interp, subst_val, &sub_template_actions));
						TEST_OK_LABEL(finally, retcode, apply_template_actions(interp, subst_val, sub_template_actions, dict, &subst_val));





					}


				}
				break;

				//}}}
			case CX_OBJ_KEY: //{{{
				{
					int			containertype;
					Tcl_Obj*	container;




					if (Tcl_IsShared(target)) {
						Tcl_Obj*	newtarget = Tcl_DuplicateObj(target);
						//fprintf(stderr, "Duplicating target: %p -> %p\n", target, newtarget);
						REPLACE(target = newtarget);
					}







					stacklevel++;
					if (unlikely(stacklevel >= stacklevels)) Tcl_Panic("Template container stack overflowed: allocated %d", stacklevels);


					containers[stacklevel].target = target;
					containers[stacklevel].elem = value;





					TEST_OK_LABEL(finally, retcode, JSON_GetJvalFromObj(interp, target, &containertype, &container));
					TEST_OK_LABEL(finally, retcode, Tcl_DictObjGet(interp, container, value, &target));
				}
				break;
				//}}}
			case CX_ARR_IDX: //{{{
				{
					int	idx;
					int			containertype;




					Tcl_Obj*	container;




					if (Tcl_IsShared(target)) {
						Tcl_Obj*	newtarget = Tcl_DuplicateObj(target);
						REPLACE(target = newtarget);

					}






					stacklevel++;
					if (unlikely(stacklevel >= stacklevels)) Tcl_Panic("Template container stack overflowed: allocated %d", stacklevels);

					containers[stacklevel].target = target;
					containers[stacklevel].elem = value;

					TEST_OK_LABEL(finally, retcode, JSON_GetJvalFromObj(interp, target, &containertype, &container));
					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, value, &idx));

					TEST_OK_LABEL(finally, retcode, Tcl_ListObjIndex(interp, container, idx, &target));


				}
				break;
				//}}}
			case POP_CX: //{{{
				{


					int	levels;




					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, value, &levels));






					stacklevel -= levels;
					//fprintf(stderr, "stacklevel: %d, target %p -> %p\n", stacklevel, target, containers[stacklevel].target);
					target = containers[stacklevel+1].target;
					//fprintf(stderr, "\ttarget now %s\n\telem: %s\n", Tcl_GetString(target), stacklevel > 0 ? Tcl_GetString(containers[stacklevel].elem) : "NULL");




				}
				break;
				//}}}

			case REPLACE_VAL: //{{{
				{
					int	slot;


					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, value, &slot));

					REPLACE(slots[slot]);
				}
				break;
				//}}}

			case REPLACE_KEY: //{{{
				{
					int	slot;

					Tcl_Obj*	container;
					Tcl_Obj*	elem = containers[stacklevel].elem;
					Tcl_Obj*	hold = NULL;
					Tcl_Obj*	tclval = NULL;
					int			slottype, containertype;

					TEST_OK_LABEL(finally, retcode, JSON_GetJvalFromObj(interp, containers[stacklevel].target, &containertype, &container));

					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, value, &slot));
					TEST_OK_LABEL(finally, retcode, JSON_GetJvalFromObj(interp, slots[slot], &slottype, &tclval));







					TEST_OK_LABEL(finally, retcode, Tcl_DictObjGet(interp, container, elem, &hold));
					Tcl_IncrRefCount(hold);
					TEST_OK_LABEL(finally, retcode, Tcl_DictObjRemove(interp, container, elem));



















					TEST_OK_LABEL(finally, retcode, Tcl_DictObjPut(interp, container, tclval, hold));
					Tcl_DecrRefCount(hold);














					Tcl_InvalidateStringRep(containers[stacklevel].target);

				}
				break;
				//}}}

			default:
				THROW_ERROR_LABEL(finally, retcode, "Unhandled opcode");



		}
	}

	*res = containers[0].target;

finally:
	if (slots) {


		ckfree(slots); slots = NULL;
	}








































































































































































































	if (containers) {
		ckfree(containers);



















































































		containers = NULL;
	}













































































































	return retcode;
}

//}}}
int JSON_Template(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* dict, Tcl_Obj** res) //{{{

{












































































































































































	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);


















































































































































































	Tcl_Obj*			actions = NULL;



	TEST_OK(Tcl_DictObjGet(interp, l->templates, template, &actions));








	if (actions == NULL) {
		TEST_OK(build_template_actions(interp, template, &actions));
		TEST_OK(Tcl_DictObjPut(interp, l->templates, template, actions));

	}

	TEST_OK(apply_template_actions(interp, template, actions, dict, res));



	return TCL_OK;
}

//}}}

static int jsonNRObjCmd(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	int method, retcode=TCL_OK;














































































































































	static const char *methods[] = {
		"parse",
		"normalize",
		"extract",
		"type",


		"exists",
		"get",
		"get_typed",
		"set",
		"unset",
		"new",
		"fmt",
		"isnull",
		"template",
		"_template",
		"foreach",
		"lmap",


		"pretty",


//		"merge",










		// Debugging

		"nop",



		(char*)NULL
	};
	enum {
		M_PARSE,
		M_NORMALIZE,
		M_EXTRACT,
		M_TYPE,


		M_EXISTS,
		M_GET,
		M_GET_TYPED,
		M_SET,
		M_UNSET,
		M_NEW,
		M_FMT,
		M_ISNULL,
		M_TEMPLATE,
		M_TEMPLATE_NEW,
		M_FOREACH,
		M_LMAP,


		M_PRETTY,


//		M_MERGE,







		// Debugging

		M_NOP



	};

	if (objc < 2)
		CHECK_ARGS(1, "method ?arg ...?");



	TEST_OK(Tcl_GetIndexFromObj(interp, objv[1], methods, "method", TCL_EXACT, &method));

	switch (method) {
		case M_PARSE: //{{{
			CHECK_ARGS(2, "parse json_val");

			{
				Tcl_Obj*	res = NULL;
				TEST_OK(convert_to_tcl(interp, objv[2], &res));
				Tcl_SetObjResult(interp, res);
			}
			break;
			//}}}


		case M_NORMALIZE: //{{{
			CHECK_ARGS(2, "normalize json_val");
			{
				int			type;
				Tcl_Obj*	json = objv[2];
				Tcl_Obj*	val;

				if (Tcl_IsShared(json))
					json = Tcl_DuplicateObj(json);


				TEST_OK(JSON_GetJvalFromObj(interp, json, &type, &val));
				Tcl_InvalidateStringRep(json);


				// Defer string rep generation to our caller
				Tcl_SetObjResult(interp, json);
			}
			break;
			//}}}

		case M_TYPE: //{{{
			{



				int			type;
				Tcl_Obj*	val;
				Tcl_Obj*	target = NULL;


				if (objc < 3) CHECK_ARGS(2, "type json_val ?path ...?");


				if (objc >= 4) {
					TEST_OK(resolve_path(interp, objv[2], objv+3, objc-3, &target, 0, 0));
				} else {
					int			type;
					Tcl_Obj*	val;
					TEST_OK(JSON_GetJvalFromObj(interp, objv[2], &type, &val));
					target = objv[2];
				}



				TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
				Tcl_SetObjResult(interp, Tcl_NewStringObj(type_names[type], -1));
			}

			break;
			//}}}
		case M_EXISTS: //{{{
			{

				Tcl_Obj*		target = NULL;



				if (objc < 3) CHECK_ARGS(2, "exists json_val ?path ...?");

				if (objc >= 4) {
					TEST_OK(resolve_path(interp, objv[2], objv+3, objc-3, &target, 1, 1));
					// resolve_path sets the interp result in exists mode
				} else {
					int			type;
					Tcl_Obj*	val;
					TEST_OK(JSON_GetJvalFromObj(interp, objv[2], &type, &val));
					Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));


				}
			}
			break;
			//}}}
		case M_GET: //{{{
			{
				Tcl_Obj*	target = NULL;
				Tcl_Obj*	res = NULL;

				if (objc < 3) CHECK_ARGS(2, "get json_val ?path ...?");

				if (objc >= 4) {
					TEST_OK(resolve_path(interp, objv[2], objv+3, objc-3, &target, 0, 1));
				} else {
					int			type;
					Tcl_Obj*	val;
					TEST_OK(JSON_GetJvalFromObj(interp, objv[2], &type, &val));
					target = objv[2];



				}

				// Might be the result of a modifier
				if (target->typePtr == &json_type) {
					TEST_OK(convert_to_tcl(interp, target, &res));
					target = res;

				}

				Tcl_SetObjResult(interp, target);
			}
			break;
			//}}}
		case M_GET_TYPED: //{{{

			{
				Tcl_Obj*		target = NULL;
				Tcl_Obj*		res[2];
				int				rescount;


				if (objc < 3) CHECK_ARGS(2, "get_typed json_val ?path ...?");

				if (objc >= 4) {
					TEST_OK(resolve_path(interp, objv[2], objv+3, objc-3, &target, 0, 1));
				} else {
					int			type;
					Tcl_Obj*	val;
					TEST_OK(JSON_GetJvalFromObj(interp, objv[2], &type, &val));
					target = objv[2];
				}

				// Might be the result of a modifier
				if (target->typePtr == &json_type) {
					int				type;
					Tcl_Obj*		val;

					TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
					TEST_OK(convert_to_tcl(interp, target, &target));
					res[0] = target;
					res[1] = Tcl_NewStringObj(type_names[type], -1);
					rescount = 2;
				} else {
					res[0] = target;
					rescount = 1;
				}

				Tcl_SetObjResult(interp, Tcl_NewListObj(rescount, res));
			}
			break;
			//}}}
		case M_EXTRACT: //{{{
			{
				Tcl_Obj*		target = NULL;


				if (objc < 3) CHECK_ARGS(2, "extract json_val ?path ...?");

				if (objc >= 4) {
					TEST_OK(resolve_path(interp, objv[2], objv+3, objc-3, &target, 0, 0));
				} else {

					int			type;
					Tcl_Obj*	val;
					TEST_OK(JSON_GetJvalFromObj(interp, objv[2], &type, &val));
					target = objv[2];
				}

				Tcl_SetObjResult(interp, target);
			}
			break;
			//}}}
		case M_SET: //{{{
			if (objc < 4) CHECK_ARGS(5, "set varname ?path ...? json_val");
			TEST_OK(JSON_Set(interp, objv[2], objv+3, objc-4, objv[objc-1]));
			break;
			//}}}
		case M_UNSET: //{{{
			if (objc < 3) CHECK_ARGS(4, "unset varname ?path ...?");
			TEST_OK(unset_path(interp, objv[2], objv+3, objc-3));
			break;
			//}}}
		case M_FMT:
		case M_NEW: //{{{
			{
				Tcl_Obj*	res = NULL;

				if (objc < 3) CHECK_ARGS(2, "new type ?val?");





				TEST_OK(new_json_value_from_list(interp, objc-2, objv+2, &res));



				Tcl_SetObjResult(interp, res);






			}
			break;
			//}}}
		case M_ISNULL: //{{{


			{
				Tcl_Obj*	target = NULL;
				Tcl_Obj*	val;
				int			type;




				if (objc < 3) CHECK_ARGS(2, "isnull json_val ?path ...?");

				if (objc >= 4) {
					TEST_OK(resolve_path(interp, objv[2], objv+3, objc-3, &target, 0, 0));
				} else {
					int			type;
					Tcl_Obj*	val;
					TEST_OK(JSON_GetJvalFromObj(interp, objv[2], &type, &val));
					target = objv[2];


				}





				TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));



				Tcl_SetObjResult(interp, Tcl_NewBooleanObj(type == JSON_NULL));
			}
			break;
			//}}}
		case M_TEMPLATE: //{{{
			{
				int		res;
				struct serialize_context	scx;
				Tcl_DString					ds;

				if (objc < 3 || objc > 4)
					CHECK_ARGS(2, "template json_template ?source_dict?");

				Tcl_DStringInit(&ds);

				scx.ds = &ds;
				scx.serialize_mode = SERIALIZE_TEMPLATE;
				scx.fromdict = NULL;
				scx.l = Tcl_GetAssocData(interp, "rl_json", NULL);

				if (objc == 4)
					Tcl_IncrRefCount(scx.fromdict = objv[3]);

				res = serialize(interp, &scx, objv[2]);

				if (scx.fromdict != NULL) {
					Tcl_DecrRefCount(scx.fromdict); scx.fromdict = NULL;
				}

				if (res == TCL_OK)
					Tcl_DStringResult(interp, scx.ds);

				Tcl_DStringFree(scx.ds); scx.ds = NULL;

				return res == TCL_OK ? TCL_OK : TCL_ERROR;
			}

			break;
			//}}}
		case M_TEMPLATE_NEW: //{{{

			{




				Tcl_Obj*	res = NULL;

				if (objc < 3 || objc > 4)
					CHECK_ARGS(2, "template json_template ?source_dict?");

				TEST_OK(JSON_Template(interp, objv[2], objc >= 4 ? objv[3] : NULL, &res));

				Tcl_SetObjResult(interp, res);
				return TCL_OK;
			}
			break;
			//}}}
		case M_FOREACH: //{{{
			if (objc < 5 || (objc-3) % 2 != 0)
				CHECK_ARGS(5, "foreach varlist datalist ?varlist datalist ...? script");

			retcode = foreach(interp, objc-2, objv+2, 0);
			break;
			//}}}
		case M_LMAP: //{{{
			if (objc < 5 || (objc-3) % 2 != 0)
				CHECK_ARGS(5, "lmap varlist datalist ?varlist datalist ...? script");

			retcode = foreach(interp, objc-2, objv+2, 1);
			break;
			//}}}
		case M_NOP: //{{{
			break;
			//}}}
		case M_PRETTY: //{{{
			{
				Tcl_DString	ds;

				Tcl_Obj*	indent;
				Tcl_Obj*	pad = Tcl_NewStringObj("", 0);







				if (objc < 3 || objc > 4)
					CHECK_ARGS(2, "pretty json_val ?indent?");

				if (objc > 3) {
					indent = objv[3];
				} else {
					indent = Tcl_NewStringObj("    ", 4);
				}




				Tcl_DStringInit(&ds);
				if (json_pretty(interp, objv[2], indent, pad, &ds) != TCL_OK) {
					Tcl_DStringFree(&ds);






					return TCL_ERROR;

				}
				Tcl_DStringResult(interp, &ds);
				Tcl_DStringFree(&ds);
			}
			break;
			//}}}
			/*
		case M_MERGE: //{{{
			THROW_ERROR("merge method is not functional yet, sorry");
			{
				int		i=2, deep=0, checking_flags=1, str_len;
				const char*	str;
				Tcl_Obj*	res = NULL;
				Tcl_Obj*	patch;
				Tcl_Obj*	new;
				static const char* flags[] = {
					"--",
					"-deep",
					(char*)NULL
				};
				enum {
					FLAG_ENDARGS,
					FLAG_DEEP
				};
				int	index;













				if (objc < 2) CHECK_ARGS(1, "merge ?flag ...? ?json_val ...?");

				while (i < objc) {
					patch = objv[i++];




					// Nasty optimization - prevent generating string rep of
					// a pure JSON value to check if it is a flag (can never
					// be: "-" isn't valid as the first char of a JSON value)
					if (patch->typePtr == &json_type)
						checking_flags = 0;






					if (checking_flags) {
						str = Tcl_GetStringFromObj(patch, &str_len);
						if (str_len > 0 && str[0] == '-') {
							TEST_OK(Tcl_GetIndexFromObj(interp, patch, flags,
										"flag", TCL_EXACT, &index));
							switch (index) {
								case FLAG_ENDARGS: checking_flags = 0; break;
								case FLAG_DEEP:    deep = 1;           break;
								default: THROW_ERROR("Invalid flag");

							}
							continue;

						}


					}

					if (res == NULL) {
						res = patch;
					} else {
						TEST_OK(merge(interp, deep, res, patch, &new));





						if (new != res)
							res = new;


					}
				}


				if (res != NULL)
					Tcl_SetObjResult(interp, res);



			}
			break;
			//}}}
			*/

		default:
			// Should be impossible to reach
			THROW_ERROR("Invalid method");
	}






	return retcode;
}

//}}}
static int jsonObjCmd(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{

	return Tcl_NRCallObjProc(interp, jsonNRObjCmd, cdata, objc, objv);
}

//}}}
void free_interp_cx(ClientData cdata, Tcl_Interp* interp) //{{{
{
	struct interp_cx* l = cdata;
	Tcl_HashEntry*		he;
	Tcl_HashSearch		search;
	struct kc_entry*	e;
	int					i;

	l->interp = NULL;

	Tcl_DecrRefCount(l->tcl_true);   l->tcl_true = NULL;
	Tcl_DecrRefCount(l->tcl_false);  l->tcl_false = NULL;
	Tcl_DecrRefCount(l->tcl_one);    l->tcl_one = NULL;

	Tcl_DecrRefCount(l->tcl_empty);
	Tcl_DecrRefCount(l->tcl_empty);  l->tcl_empty = NULL;

	Tcl_DecrRefCount(l->json_true);          l->json_true = NULL;
	Tcl_DecrRefCount(l->json_false);         l->json_false = NULL;
	Tcl_DecrRefCount(l->json_null);          l->json_null = NULL;

	he = Tcl_FirstHashEntry(&l->kc, &search);
	while (he) {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(he);

		e = &l->kc_entries[idx];

		Tcl_DeleteHashEntry(he);
		Tcl_DecrRefCount(e->val);
		Tcl_DecrRefCount(e->val);	// Two references - one for the cache table and one on loan to callers' interim processing
		mark_free(l->freemap, idx);
		e->val = NULL;

		he = Tcl_NextHashEntry(&search);
	}
	l->kc_count = 0;

	for (i=0; i<2; i++) {
		Tcl_DecrRefCount(l->force_num_cmd[i]);	l->force_num_cmd[i] = NULL;
	}

	Tcl_DecrRefCount(l->type[JSON_UNDEF]);			l->type[JSON_UNDEF] = NULL;
	Tcl_DecrRefCount(l->type[JSON_OBJECT]);			l->type[JSON_OBJECT] = NULL;
	Tcl_DecrRefCount(l->type[JSON_ARRAY]);			l->type[JSON_ARRAY] = NULL;
	Tcl_DecrRefCount(l->type[JSON_STRING]);			l->type[JSON_STRING] = NULL;
	Tcl_DecrRefCount(l->type[JSON_NUMBER]);			l->type[JSON_NUMBER] = NULL;
	Tcl_DecrRefCount(l->type[JSON_BOOL]);			l->type[JSON_BOOL] = NULL;
	Tcl_DecrRefCount(l->type[JSON_NULL]);			l->type[JSON_NULL] = NULL;
	Tcl_DecrRefCount(l->type[JSON_DYN_STRING]);		l->type[JSON_DYN_STRING] = NULL;
	Tcl_DecrRefCount(l->type[JSON_DYN_NUMBER]);		l->type[JSON_DYN_NUMBER] = NULL;
	Tcl_DecrRefCount(l->type[JSON_DYN_BOOL]);		l->type[JSON_DYN_BOOL] = NULL;
	Tcl_DecrRefCount(l->type[JSON_DYN_JSON]);		l->type[JSON_DYN_JSON] = NULL;
	Tcl_DecrRefCount(l->type[JSON_DYN_TEMPLATE]);	l->type[JSON_DYN_TEMPLATE] = NULL;
	Tcl_DecrRefCount(l->type[JSON_DYN_LITERAL]);	l->type[JSON_DYN_LITERAL] = NULL;

	for (i=0; i<TEMPLATE_ACTIONS_END; i++) {
		Tcl_DecrRefCount(l->action[i]); l->action[i] = NULL;
	}

	Tcl_DecrRefCount(l->templates);		l->templates = NULL;

	Tcl_DeleteHashTable(&l->kc);
	free(l); l = NULL;
}

//}}}
extern Rl_jsonStubs rl_jsonStubs;
_DLLEXPORT

int Rl_json_Init(Tcl_Interp* interp) //{{{
{
	int					i;
	struct interp_cx*	l = NULL;

#ifdef USE_TCL_STUBS
	if (Tcl_InitStubs(interp, "8.5", 0) == NULL)
		return TCL_ERROR;
#endif // USE_TCL_STUBS

	Tcl_RegisterObjType(&json_type);

	l = (struct interp_cx*)malloc(sizeof *l);
	l->interp = interp;
	Tcl_IncrRefCount(l->tcl_true   = Tcl_NewStringObj("1", 1));
	Tcl_IncrRefCount(l->tcl_false  = Tcl_NewStringObj("0", 1));

	Tcl_IncrRefCount(l->tcl_empty  = Tcl_NewStringObj("", 0));
	// Ensure the empty string rep is considered "shared"
	Tcl_IncrRefCount(l->tcl_empty);

	Tcl_IncrRefCount(l->tcl_one    = Tcl_NewIntObj(1));

	Tcl_IncrRefCount(l->json_true  = JSON_NewJvalObj(JSON_BOOL, l->tcl_true));
	Tcl_IncrRefCount(l->json_false = JSON_NewJvalObj(JSON_BOOL, l->tcl_false));
	Tcl_IncrRefCount(l->json_null  = JSON_NewJvalObj(JSON_NULL, NULL));
	Tcl_IncrRefCount(l->json_empty_string  = JSON_NewJvalObj(JSON_STRING, l->tcl_empty));



	// Hack to ensure a value is a number (could be any of the Tcl number types: double, int, wide, bignum)
	Tcl_IncrRefCount(l->force_num_cmd[0] = Tcl_NewStringObj("::tcl::mathop::+", -1));
	Tcl_IncrRefCount(l->force_num_cmd[1] = Tcl_NewIntObj(0));
	l->force_num_cmd[2] = NULL;

	// Const type name objects
	Tcl_IncrRefCount(l->type[JSON_UNDEF]        = Tcl_NewStringObj("JSON_UNDEF", -1));
	Tcl_IncrRefCount(l->type[JSON_OBJECT]       = Tcl_NewStringObj("JSON_OBJECT", -1));
	Tcl_IncrRefCount(l->type[JSON_ARRAY]        = Tcl_NewStringObj("JSON_ARRAY", -1));
	Tcl_IncrRefCount(l->type[JSON_STRING]       = Tcl_NewStringObj("JSON_STRING", -1));
	Tcl_IncrRefCount(l->type[JSON_NUMBER]       = Tcl_NewStringObj("JSON_NUMBER", -1));
	Tcl_IncrRefCount(l->type[JSON_BOOL]         = Tcl_NewStringObj("JSON_BOOL", -1));
	Tcl_IncrRefCount(l->type[JSON_NULL]         = Tcl_NewStringObj("JSON_NULL", -1));
	Tcl_IncrRefCount(l->type[JSON_DYN_STRING]   = Tcl_NewStringObj("JSON_DYN_STRING", -1));
	Tcl_IncrRefCount(l->type[JSON_DYN_NUMBER]   = Tcl_NewStringObj("JSON_DYN_NUMBER", -1));
	Tcl_IncrRefCount(l->type[JSON_DYN_BOOL]     = Tcl_NewStringObj("JSON_DYN_BOOL", -1));
	Tcl_IncrRefCount(l->type[JSON_DYN_JSON]     = Tcl_NewStringObj("JSON_DYN_JSON", -1));
	Tcl_IncrRefCount(l->type[JSON_DYN_TEMPLATE] = Tcl_NewStringObj("JSON_DYN_TEMPLATE", -1));
	Tcl_IncrRefCount(l->type[JSON_DYN_LITERAL]  = Tcl_NewStringObj("JSON_DYN_LITERAL", -1));


	// Const template action objects
	for (i=0; i<TEMPLATE_ACTIONS_END; i++)
		Tcl_IncrRefCount(l->action[i] = Tcl_NewStringObj(action_opcode_str[i], -1));

	Tcl_IncrRefCount(l->templates = Tcl_NewDictObj());

	Tcl_InitHashTable(&l->kc, TCL_STRING_KEYS);
	l->kc_count = 0;
	memset(&l->freemap, 0xFF, sizeof(l->freemap));















































































































	Tcl_SetAssocData(interp, "rl_json", free_interp_cx, l);


























































































	Tcl_NRCreateCommand(interp, "::rl_json::json", jsonObjCmd, jsonNRObjCmd, NULL, NULL);
	TEST_OK(Tcl_EvalEx(interp, "namespace eval ::rl_json {namespace export *}", -1, TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL));





	TEST_OK(Tcl_PkgProvideEx(interp, PACKAGE_NAME, PACKAGE_VERSION, &rl_jsonStubs));

	return TCL_OK;
}

//}}}
_DLLEXPORT
int Rl_json_SafeInit(Tcl_Interp* interp) //{{{
{
	// No unsafe features
	return Rl_json_Init(interp);
}

//}}}











































/* Local Variables: */
/* tab-width: 4 */
/* c-basic-offset: 4 */
/* End: */
// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4
|
>
>
>
>





<
<
<
<
<






<
<
<
<
<
<
<
<







 







<
|







 







|

|
<

|
|
|
|
|
<
|
<
<
>
|

>
>





|
<
>
|
>


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


<
<

<

<
<
<
<
<
>

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

<
>

<
<
<
>



<
>

<
<
<
>
>

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

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

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

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

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













|
>
|
>
>
>







 







<
<
<
<
<
<
<
<
<







 







|







 







|


|


|











<
|







>
>
|
>



>







 







|
|
|
|










|







 







|
|
|













<







 







|

|
|
>
>
>



|
<
<

<
<
<
>
>







 







>
>
>






>
>



|
>
>
>
>

<
|



>
>
>

|
>




|
<





|

>
|
|










<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|

|
>
>
|
|
|
|



>
|


<
>






<







 







|




|








|







 







|





|











|
|







>
>
|
|
<
<
|
<

>
|
>







 







|
|
|
|
|
|
|
>
>







 







|


|







 







>
|
>
|

<
<
>
|
>
>
>

<
>
>












|

>
|
|













|
|
|
>

|


<

<
|
|
<
<
<
|
<

>
>
>






|
|
>

|


<

|
|

>
>
>






|



<
>
>
>
>


|
<






|












|







|

|
<




|
|
|


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







 







>
>



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







 







>
>
>
>
>











|











>



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











|
>
|
|







 







|










|

|
>










>







 







<


|
>










>







 







|







 







|








|






|

>
>
>
|
>
>

<
<
>
>
>
|
<
>
|
<

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





>

>





|

>


|
|
>
>
|
|





|
<
<
<
<
<
<

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







 







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

|
|
|
>












|



<

<
<
<
>


|
>
|

<
<
<
>

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

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

<
>
>
|
<
<
<
|
<
<
>

>
>
>
>
>
|
<
>





|

<
|

<
<
>



|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
<












<
<
|

>
>
|
|







|



|

>
|
<
|
|
|
<
<
>

<
>

>
|
<
<
<
<

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

<
<
<
>
>
>
>
>


|

<

>
|
>

|
|

>
|
>

<
<
>


>
|
<
|



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


|
>

<
>
>
>

|



<
|

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
|
<

<
<
>

<
<
>
|
<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

|


>
>





|
>
>


<




<
<
<


<
>




|




|
|
>
|
>

|
>
|

|

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




|

>
|
>

|



|
<
>


|
>

|



>



|

|

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

<
>


>
>



|
>

|

>
>
|
<
>
>
>
>
>




<
<
<



|
>

|





|



|
>

|

<
<
<
|
<
>



<
<
<
<
<
|

|
>
>

>
|
>
>

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

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

>
>
|
<
>

<
<
>
>
>
>
|
<
<
<

<
<
|
<
<
>
>
>
>
|

>
>
>

<
<
>

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


<
<
|
>
>
|
>
>

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


<
>
|

|

>
|
<
|


<
>
|

|
>
|
<
|
<
<

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

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


<


<
>
>
>



|



>
>
|


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

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



<
>

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

<
>
>
>
>
>
>
>
>

|
<
>


<
>
>





>
|

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



>
>


<


|
|


|


>
>

>
>


>
>
>
>
>
>
>
>
>

>

>
>
>







>
>


<






|


>
>

>
>

<
>
>
>
>
>
>

>
|
>
>
>


|
<
>
>
|
<

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

>
|
>
>

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

<
<
<
<
<
<
<
>
>
>
|

<
<
<
<
>
|

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

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

<
>
>
>
>

<
>
>

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

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

<
>
>

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
|
<
<

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

<
|

<
<
<
<
|
>
>
>

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

<
<
>
>
>

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

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





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





|



|











>




>
>







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





|
<



>

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


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

>
>
>
|





<
|






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






1
2
3
4
5
6
7
8
9
10





11
12
13
14
15
16








17
18
19
20
21
22
23
..
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74
..
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
209



210














211
































































212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
...
270
271
272
273
274
275
276









277
278
279
280
281
282
283
...
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
...
320
321
322
323
324
325
326
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
360
361
362
363
364
365
366
367
...
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463

464
465
466
467
468
469
470
...
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491


492



493
494
495
496
497
498
499
500
501
...
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540

541
542
543
544
545
546
547
548
549
550
551
552
553
554
555

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575








































































































































































































































































576
577
578
579
580
581
582
...
591
592
593
594
595
596
597








































































































































































































































































































































































































































































598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620

621
622
623
624
625
626
627
...
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
...
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710


711

712
713
714
715
716
717
718
719
720
721
722
...
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
...
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
...
805
806
807
808
809
810
811
812
813
814
815
816


817
818
819
820
821
822

823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862

863

864
865



866

867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883

884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900

901
902
903
904
905
906
907

908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937

938
939
940
941
942
943
944
945
946




























































































































947



























948
949
950
951
952
953
954
955
956
957
....
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
....
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169

1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
....
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
....
1380
1381
1382
1383
1384
1385
1386

1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
....
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
....
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625


1626
1627
1628
1629

1630
1631

1632






1633
1634
1635
1636
1637
1638
1639

1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651



1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688

1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742






1743
































1744
1745
1746
1747
1748
1749


1750
1751
1752
1753
1754
1755
1756
1757
....
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806

1807



1808
1809
1810
1811
1812
1813
1814



1815
1816








1817
1818



1819




1820
1821


1822
1823
1824

1825


1826


1827
1828
1829
1830
1831
1832
1833
1834
1835

1836
1837
1838



1839


1840
1841
1842
1843
1844
1845
1846
1847

1848
1849
1850
1851
1852
1853
1854
1855

1856
1857


1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874



1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886


1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907

1908
1909
1910


1911
1912

1913
1914
1915
1916




1917






1918
1919
1920
1921



1922
1923
1924
1925



1926
1927
1928
1929
1930
1931
1932
1933
1934

1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946


1947
1948
1949
1950
1951

1952
1953
1954
1955
1956

1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978

1979
1980
1981
1982
1983
1984
1985
1986

1987
1988


















1989
1990

1991

1992


1993
1994


1995
1996


1997























1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013

2014
2015
2016
2017



2018
2019

2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051




2052
2053
2054
2055
2056
2057

2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074

2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093

2094
2095






2096
2097
2098
2099

2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115

2116
2117
2118
2119
2120
2121
2122
2123
2124



2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145



2146

2147
2148
2149
2150





2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161

2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176

2177



2178
2179
2180
2181
2182


2183
2184
2185
2186
2187
2188
2189
2190
2191

2192
2193


2194
2195
2196
2197
2198



2199


2200


2201
2202
2203
2204
2205
2206
2207
2208
2209
2210


2211
2212
2213
2214
2215
2216
2217
2218








2219
2220
2221
2222
2223
2224


2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239




2240
2241
2242
2243
2244
2245

2246
2247
2248
2249
2250
2251
2252

2253
2254
2255

2256
2257
2258
2259
2260
2261

2262


2263

2264
2265

2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295

2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313

2314
2315

2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530

2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728

2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085

3086
3087
3088
3089
3090
3091
3092
3093
3094
3095

3096
3097
3098

3099
3100
3101
3102
3103
3104
3105
3106
3107
3108

3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259

3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301

3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316

3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331

3332
3333
3334

3335



3336
3337






3338
3339
3340







3341

3342
3343
3344

3345
3346
3347



3348
3349

3350
3351
3352
3353
3354
3355

3356
3357

3358
3359
3360
3361
3362
3363
3364
3365


3366
3367
3368
3369

3370
3371

3372
3373
3374
3375
3376
3377
3378
3379


3380



3381


3382
3383
3384

3385





3386

3387







3388
3389
3390
3391
3392




3393
3394
3395



3396

3397
3398



3399
3400

3401



























3402

3403

3404
3405





3406
3407



3408


















3409
3410

3411
3412
3413
3414
3415

3416
3417
3418

3419
3420
3421
3422
3423
3424
3425



3426
3427
3428



3429
3430
3431
3432

3433







3434
3435
3436
3437
3438
3439
3440
3441

3442
3443
3444

















3445

3446


3447















3448

3449
3450
3451
3452
3453
3454
3455































3456
3457

3458
3459
3460
3461
3462
3463
3464

3465
3466




3467
3468
3469
3470
3471



3472
3473
3474
3475
3476
3477
3478
3479
3480


3481





















3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494

3495


3496
3497
3498
3499





3500
3501
3502
3503
3504
3505









3506
3507

3508
3509
3510
3511
3512





3513
3514
3515
3516
3517
3518

3519
3520
3521
3522
3523
3524


3525
3526
3527
3528








3529
3530
3531
3532
3533
3534
3535
3536
3537
3538

3539
3540
3541







































































3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581










3582
3583
3584
3585
3586
3587
3588

3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794

3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805

3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
#include "rl_jsonInt.h"

#ifndef ENSEMBLE
#define ENSEMBLE	0
#endif

#if defined(_WIN32)
#define snprintf _snprintf
#endif






#ifdef WIN32
#define _DLLEXPORT extern DLLEXPORT
#else
#define _DLLEXPORT
#endif









static const char* dyn_prefix[] = {
	NULL,	// JSON_UNDEF
	NULL,	// JSON_OBJECT
	NULL,	// JSON_ARRAY
	NULL,	// JSON_STRING
	NULL,	// JSON_NUMBER
	NULL,	// JSON_BOOL
................................................................................
	"string",		// JSON_DYN_STRING
	"string",		// JSON_DYN_NUMBER
	"string",		// JSON_DYN_BOOL
	"string",		// JSON_DYN_JSON
	"string",		// JSON_DYN_TEMPLATE
	"string"		// JSON_DYN_LITERAL
};

const char* type_names_int[] = {	// Must match the order of the json_types enum
	"JSON_UNDEF",
	"JSON_OBJECT",
	"JSON_ARRAY",
	"JSON_STRING",
	"JSON_NUMBER",
	"JSON_BOOL",
	"JSON_NULL",
................................................................................
	"JSON_DYN_NUMBER",
	"JSON_DYN_BOOL",
	"JSON_DYN_JSON",
	"JSON_DYN_TEMPLATE",
	"JSON_DYN_LITERAL"
};

static const char* action_opcode_str[] = { // Must match the order of the action_opcode enum
	"NOP",
	"ALLOCATE",

	"FETCH_VALUE",
	"DECLARE_LITERAL",
	"STORE_STRING",
	"STORE_NUMBER",
	"STORE_BOOLEAN",
	"STORE_JSON",

	"STORE_TEMPLATE",


	"PUSH_TARGET",
	"POP_TARGET",
	"REPLACE_VAL",
	"REPLACE_ARR",
	"REPLACE_ATOM",
	"REPLACE_KEY",

	(char*)NULL
};

static const char *extension_str[] = {

	"",
	"comments",
	(char*)NULL
};






























static int new_json_value_from_list(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res);
static int NRforeach_next_loop_bottom(ClientData cdata[], Tcl_Interp* interp, int retcode);


static int json_pretty_dbg(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds);







const char* get_dyn_prefix(enum json_types type) //{{{
{







	if (!type_is_dynamic(type)) {
		return "";












	} else {
		return dyn_prefix[type];
	}
}








//}}}

const char* get_type_name(enum json_types type) //{{{
{



	return type_names[type];
}

//}}}

Tcl_Obj* as_json(Tcl_Interp* interp, Tcl_Obj* from) //{{{
{



	Tcl_ObjIntRep*	ir = NULL;
	enum json_types	type;















	if (JSON_GetIntrepFromObj(interp, from, &type, &ir) == TCL_OK) {
		// Already a JSON value, use it directly
		return from;
	} else {

		// Anything else, use it as a JSON string
		return JSON_NewJvalObj(JSON_STRING, from);		// EIAS, so we can use whatever $from is as the intrep for a JSON_STRING value
	}

}



//}}}








int force_json_number(Tcl_Interp* interp, struct interp_cx* l, Tcl_Obj* obj, Tcl_Obj** forced) //{{{
{




	int	res = TCL_OK;

	// TODO: investigate a direct bytecode version?













	/*
display *obj
	 */
	if (l) {
		// Attempt to snoop on the intrep to verify that it is one of the numeric types
		if (

			obj->typePtr && (
				(l->typeInt    && Tcl_FetchIntRep(obj, l->typeInt) != NULL) ||
				(l->typeDouble && Tcl_FetchIntRep(obj, l->typeDouble) != NULL) ||
				(l->typeBignum && Tcl_FetchIntRep(obj, l->typeBignum) != NULL)
		   )





		) {
			// It's a known number type, we can safely use it directly
			//fprintf(stderr, "force_json_number fastpath, verified obj to be a number type\n");
			if (forced == NULL) return TCL_OK;

			if (Tcl_HasStringRep(obj)) { // Has a string rep already, make sure it's not hex or octal, and not padded with whitespace
				const char* s;
				int			len, start=0;











				s = Tcl_GetStringFromObj(obj, &len);
				if (len >= 1 && s[0] == '-')
					start++;

				if (unlikely(


					(len+start >= 1 && (
						(s[start] == '0' && len+start >= 2 && s[start+1] != '.') || // Octal or hex, or double with leading zero not immediately followed by .)
						s[start] == ' '  ||
						s[start] == '\n' ||
						s[start] == '\t' ||
						s[start] == '\v' ||
						s[start] == '\r' ||
						s[start] == '\f'
					)) ||
					(len-start >= 2 && (
						s[len-1] == ' '  ||
						s[len-1] == '\n' ||
						s[len-1] == '\t' ||
						s[len-1] == '\v' ||
						s[len-1] == '\r' ||
						s[len-1] == '\f'
					))
				)) {
					// The existing string rep is one of the cases
					// (octal / hex / whitespace padded) that is not a
					// valid JSON number.  Duplicate the obj and
					// invalidate the string rep
					Tcl_IncrRefCount(*forced = Tcl_DuplicateObj(obj));
					Tcl_InvalidateStringRep(*forced);
				} else {
					// String rep is safe as a JSON number
					Tcl_IncrRefCount(*forced = obj);
					//fprintf(stderr, "force_json_number obj stringrep is safe json number: (%s), intrep: (%s)\n", Tcl_GetString(obj), obj->typePtr->name);
				}
			} else {

				// Pure number - no string rep
				Tcl_IncrRefCount(*forced = obj);
			}


















			return TCL_OK;
































































		} else {
			// Could be a string that is a valid number representation, or
			// something that will convert to a valid number.  Add 0 to it to
			// check (all valid numbers succeed at this, and are unchanged by
			// it).  Use the cached objs
			Tcl_IncrRefCount(l->force_num_cmd[2] = obj);
			res = Tcl_EvalObjv(interp, 3, l->force_num_cmd, TCL_EVAL_DIRECT);
			Tcl_DecrRefCount(l->force_num_cmd[2]);
			l->force_num_cmd[2] = NULL;
		}

	} else {
		Tcl_Obj*	cmd;

		cmd = Tcl_NewListObj(0, NULL);
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, Tcl_NewStringObj("::tcl::mathop::+", -1)));
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, Tcl_NewIntObj(0)));
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, obj));

		Tcl_IncrRefCount(cmd);
		res = Tcl_EvalObjEx(interp, cmd, TCL_EVAL_DIRECT);
		Tcl_DecrRefCount(cmd);
	}

	if (res == TCL_OK) {
		if (forced != NULL)
			Tcl_IncrRefCount(*forced = Tcl_GetObjResult(interp));

		Tcl_ResetResult(interp);
	}

	return res;
}

//}}}
static void append_json_string(const struct serialize_context* scx, Tcl_Obj* obj) //{{{
{
................................................................................
				case 0x8:	Tcl_DStringAppend(ds, "\\b", 2); break;
				case 0xC:	Tcl_DStringAppend(ds, "\\f", 2); break;
				case 0xA:	Tcl_DStringAppend(ds, "\\n", 2); break;
				case 0xD:	Tcl_DStringAppend(ds, "\\r", 2); break;
				case 0x9:	Tcl_DStringAppend(ds, "\\t", 2); break;

				default:









					snprintf(ustr, 7, "\\u%04X", c);
					Tcl_DStringAppend(ds, ustr, 6);
					break;
			}
			p += adv;
			chunk = p;
		} else {
................................................................................
			//}}}
		case JSON_OBJECT: //{{{
			{
				int				done, first=1;
				Tcl_DictSearch	search;
				Tcl_Obj*		k;
				Tcl_Obj*		v;
				enum json_types	v_type = JSON_UNDEF;
				Tcl_Obj*		iv = NULL;

				TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));

				Tcl_DStringAppend(ds, "{", 1);
				for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
					if (!first) {
................................................................................
					} else {
						first = 0;
					}

					// Have to do the template subst here rather than at
					// parse time since the dict keys would be broken otherwise
					if (scx->serialize_mode == SERIALIZE_TEMPLATE) {
						int			len, stype;
						const char*	s;

						s = Tcl_GetStringFromObj(k, &len);

						if (
								len >= 3 &&
								s[0] == '~' &&
								s[2] == ':'
						) {
							switch (s[1]) {
								case 'S': stype = JSON_DYN_STRING; break;
								case 'L': stype = JSON_DYN_LITERAL; break;

								case 'N':
								case 'B':
								case 'J':
								case 'T':

									Tcl_SetObjResult(interp, Tcl_ObjPrintf("Only strings allowed as object keys, got %s", s));
									res = TCL_ERROR;
									goto done;

								default:  stype = JSON_UNDEF; break;
							}

							if (stype != JSON_UNDEF) {
								int hold = scx->allow_null;
								scx->allow_null = 0;
								if (serialize_json_val(interp, scx, stype, Tcl_GetRange(k, 3, len-1)) != TCL_OK) {
									scx->allow_null = hold;
									res = TCL_ERROR;
									break;
								}
								scx->allow_null = hold;
							} else {
								append_json_string(scx, k);
							}
						} else {
							append_json_string(scx, k);
						}
					} else {
................................................................................
				Tcl_DStringAppend(ds, "}", 1);
				Tcl_DictObjDone(&search);
			}
			break;
			//}}}
		case JSON_ARRAY: //{{{
			{
				int				i, oc, first=1;
				Tcl_Obj**		ov;
				Tcl_Obj*		iv = NULL;
				enum json_types	v_type = JSON_UNDEF;

				TEST_OK(Tcl_ListObjGetElements(interp, val, &oc, &ov));

				Tcl_DStringAppend(ds, "[", 1);
				for (i=0; i<oc; i++) {
					if (!first) {
						Tcl_DStringAppend(ds, ",", 1);
					} else {
						first = 0;
					}
					JSON_GetJvalFromObj(interp, ov[i], &v_type, &iv);
					TEST_OK(serialize_json_val(interp, scx, v_type, iv));
				}
				Tcl_DStringAppend(ds, "]", 1);
			}
			break;
			//}}}
		case JSON_NUMBER: //{{{
................................................................................
			if (scx->serialize_mode == SERIALIZE_NORMAL) {
				Tcl_Obj*	tmp = Tcl_ObjPrintf("%s%s", dyn_prefix[type], Tcl_GetString(val));

				Tcl_IncrRefCount(tmp);
				append_json_string(scx, tmp);
				Tcl_DecrRefCount(tmp);
			} else {
				Tcl_Obj*		subst_val = NULL;
				enum json_types	subst_type;
				int				reset_mode = 0;

				if (type == JSON_DYN_LITERAL) {
					append_json_string(scx, val);
					break;
				}

				if (scx->fromdict != NULL) {
					TEST_OK(Tcl_DictObjGet(interp, scx->fromdict, val, &subst_val));
				} else {
					subst_val = Tcl_ObjGetVar2(interp, val, NULL, 0);
				}

				if (subst_val == NULL) {

					subst_type = JSON_NULL;
				} else {
					subst_type = from_dyn[type];
					Tcl_IncrRefCount(subst_val);
				}

				if (subst_type == JSON_DYN_JSON) {
................................................................................
					scx->serialize_mode = SERIALIZE_NORMAL;
					reset_mode = 1;
				} else if (subst_type == JSON_DYN_TEMPLATE) {
					if (subst_val != NULL) Tcl_DecrRefCount(subst_val);
					res = JSON_GetJvalFromObj(interp, subst_val, &subst_type, &subst_val);
					if (subst_val != NULL) Tcl_IncrRefCount(subst_val);
				} else if (subst_type == JSON_NUMBER) {
					Tcl_Obj*	forced = NULL;

					if ((res = force_json_number(interp, scx->l, subst_val, &forced)) == TCL_OK)
						replace_tclobj(&subst_val, forced);

					release_tclobj(&forced);
					if (res != TCL_OK) {
						Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error substituting value from \"%s\" into template, not a number: \"%s\"", Tcl_GetString(val), Tcl_GetString(subst_val)));
						return TCL_ERROR;
					}
				}






				if (subst_type == JSON_NULL && !scx->allow_null)
					THROW_ERROR("Only strings allowed as object keys");

				if (res == TCL_OK)
					res = serialize_json_val(interp, scx, subst_type, subst_val);

				if (subst_val != NULL)
					Tcl_DecrRefCount(subst_val);

................................................................................
	return res;
}

//}}}

void append_to_cx(struct parse_context* cx, Tcl_Obj* val) //{{{
{
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		ir_val = NULL;

	/*
	fprintf(stderr, "append_to_cx, storing %s: \"%s\"\n",
			type_names[val->internalRep.ptrAndLongRep.value],
			val->internalRep.ptrAndLongRep.ptr == NULL ? "NULL" :
			Tcl_GetString((Tcl_Obj*)val->internalRep.ptrAndLongRep.ptr));
	*/
	if (cx->mode == VALIDATE) return;

	switch (cx->container) {
		case JSON_OBJECT:
			//fprintf(stderr, "append_to_cx, cx->hold_key->refCount: %d (%s)\n", cx->hold_key->refCount, Tcl_GetString(cx->hold_key));
			ir = Tcl_FetchIntRep(cx->val, cx->objtype);
			if (ir == NULL) Tcl_Panic("Can't get intrep for container");
			ir_val = get_unshared_val(ir);
			Tcl_DictObjPut(NULL, ir_val, cx->hold_key, val);
			if (ir->twoPtrValue.ptr2) {release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);}
			Tcl_InvalidateStringRep(cx->val);

			release_tclobj(&cx->hold_key);
			break;

		case JSON_ARRAY:
			ir = Tcl_FetchIntRep(cx->val, cx->objtype);
			if (ir == NULL) Tcl_Panic("Can't get intrep for container");
			ir_val = get_unshared_val(ir);
			//fprintf(stderr, "append_to_cx, appending to list: (%s)\n", Tcl_GetString(val));
			Tcl_ListObjAppendElement(NULL, ir_val, val);
			if (ir->twoPtrValue.ptr2) {release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);}
			Tcl_InvalidateStringRep(cx->val);
			break;

		default:
			replace_tclobj(&cx->val, val);

	}
}

//}}}

int serialize(Tcl_Interp* interp, struct serialize_context* scx, Tcl_Obj* obj) //{{{
{
	enum json_types	type = JSON_UNDEF;
	int				res;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, obj, &type, &val));

	res = serialize_json_val(interp, scx, type, val);

	// The result of the serialization is left in scx->ds.  Once the caller
	// is done with this value it must be freed with Tcl_DStringFree()
	return res;
}









































































































































































































































































//}}}

static int get_modifier(Tcl_Interp* interp, Tcl_Obj* modobj, enum modifiers* modifier) //{{{
{
	// This must be kept in sync with the modifiers enum
	static CONST char *modstrings[] = {
		"",
................................................................................
	TEST_OK(Tcl_GetIndexFromObj(interp, modobj, modstrings, "modifier", TCL_EXACT, &index));
	*modifier = index;

	return TCL_OK;
}

//}}}








































































































































































































































































































































































































































































int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int pathc, Tcl_Obj** target, const int exists, const int modifiers) //{{{
{
	int					i, modstrlen;
	enum json_types		type;
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	const char*			modstr;
	enum modifiers		modifier;
	Tcl_Obj*			val;
	Tcl_Obj*			step;

#define EXISTS(bool) \
	if (exists) { \
		Tcl_SetObjResult(interp, (bool) ? l->tcl_true : l->tcl_false); \
		return TCL_OK; \
	}


	replace_tclobj(target, src);

	if (unlikely(JSON_GetJvalFromObj(interp, *target, &type, &val) != TCL_OK)) {
		if (exists) {
			Tcl_ResetResult(interp);
			// [dict exists] considers any test to be false when applied to an invalid value, so we do the same
			EXISTS(0);

		}
		return TCL_ERROR;
	}

	//fprintf(stderr, "resolve_path, initial type %s\n", type_names[type]);
	for (i=0; i<pathc; i++) {
		step = pathv[i];
................................................................................
							switch (type) {
								case JSON_ARRAY:
									{
										int			ac;
										Tcl_Obj**	av;
										TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
										EXISTS(1);
										replace_tclobj(target, Tcl_NewIntObj(ac));
									}
									break;
								case JSON_STRING:
									EXISTS(1);
									replace_tclobj(target, Tcl_NewIntObj(Tcl_GetCharLength(val)));
									break;
								case JSON_DYN_STRING:
								case JSON_DYN_NUMBER:
								case JSON_DYN_BOOL:
								case JSON_DYN_JSON:
								case JSON_DYN_TEMPLATE:
								case JSON_DYN_LITERAL:
									EXISTS(1);
									replace_tclobj(target, Tcl_NewIntObj(Tcl_GetCharLength(val) + 3));
									break;
								default:
									EXISTS(0);
									THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							break;
							//}}}
................................................................................
								EXISTS(0);
								THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							{
								int	size;
								TEST_OK(Tcl_DictObjSize(interp, val, &size));
								EXISTS(1);
								replace_tclobj(target, Tcl_NewIntObj(size));
							}
							break;
							//}}}
						case MODIFIER_TYPE: //{{{
							EXISTS(1);
							replace_tclobj(target, l->type[type]);
							break;
							//}}}
						case MODIFIER_KEYS: //{{{
							if (type != JSON_OBJECT) {
								EXISTS(0);
								THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							{
								Tcl_DictSearch	search;
								Tcl_Obj*		k;
								Tcl_Obj*		v;
								int				done, retval=TCL_OK;
								Tcl_Obj*		res = NULL;

								TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));
								if (exists) {
									Tcl_DictObjDone(&search);
									EXISTS(1);
								}

								replace_tclobj(&res, Tcl_NewListObj(0, NULL));

								for (; !done; Tcl_DictObjNext(&search, &k, &v, &done))
									TEST_OK_BREAK(retval, Tcl_ListObjAppendElement(interp, res, k));




								Tcl_DictObjDone(&search);
								if (retval == TCL_OK) replace_tclobj(target, res);
								release_tclobj(&res);
								if (retval != TCL_OK) return retval;
							}
							break;
							//}}}
						default:
							THROW_ERROR("Unhandled modifier type: ", Tcl_GetString(Tcl_NewIntObj(modifier)));
					}
					//fprintf(stderr, "Handled modifier, skipping descent check\n");
................................................................................
			}
		}
		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				{
					Tcl_Obj*	new = NULL;
					TEST_OK(Tcl_DictObjGet(interp, val, step, &new));
					replace_tclobj(target, new);
				}
				if (*target == NULL) {
					EXISTS(0);
					Tcl_SetObjResult(interp, Tcl_ObjPrintf("Path element %d: \"%s\" not found", pathc+1, Tcl_GetString(step)));
					return TCL_ERROR;
				}

				//TEST_OK(JSON_GetJvalFromObj(interp, src, &type, &val));
				//fprintf(stderr, "Descended into object, new type: %s, val: (%s)\n", type_names[type], Tcl_GetString(val));
				break;
				//}}}
			case JSON_ARRAY: //{{{
................................................................................
						//fprintf(stderr, "Explicit index: %ld\n", index);
					}

					if (index < 0 || index >= ac) {
						// Soft error - set target to an NULL object in
						// keeping with [lindex] behaviour
						EXISTS(0);
						replace_tclobj(target, l->json_null);
						//fprintf(stderr, "index %ld is out of range [0, %d], setting target to a synthetic null\n", index, ac);
					} else {
						replace_tclobj(target, av[index]);
						//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(*target));
					}
				}
				break;
				//}}}
			case JSON_STRING:
			case JSON_NUMBER:
................................................................................
			case JSON_NULL:
			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
				{
					EXISTS(0);
					Tcl_SetObjResult(interp, Tcl_ObjPrintf(
						"Cannot descend into atomic type \"%s\" with path element %d: \"%s\"",
						type_names[type],


						pathc,
						Tcl_GetString(step)
					));
					return TCL_ERROR;
				}
			default:

				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Unhandled type: %d", type));
				return TCL_ERROR;
		}

		TEST_OK(JSON_GetJvalFromObj(interp, *target, &type, &val));
		//fprintf(stderr, "Walked on to new type %s\n", type_names[type]);
	}

	//fprintf(stderr, "Returning target: (%s)\n", Tcl_GetString(*target));
	EXISTS(type != JSON_NULL);
	return TCL_OK;
}

//}}}
int convert_to_tcl(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** out) //{{{
{
	enum json_types	type;
	int				res = TCL_OK;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, obj, &type, &val));
	/*
	fprintf(stderr, "Retrieved internal rep of jval: type: %s, intrep Tcl_Obj type: %s, object: %p\n",
			type_names[type], val && val->typePtr ? val->typePtr->name : "<no type>",
			val);
	*/

	switch (type) {
		case JSON_OBJECT:
			{
				int				done;
				Tcl_DictSearch	search;
				Tcl_Obj*		k = NULL;
				Tcl_Obj*		v = NULL;
				Tcl_Obj*		vo = NULL;
				Tcl_Obj*		new = NULL;

				replace_tclobj(&new, Tcl_NewDictObj());

				TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));

				for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {

					TEST_OK_BREAK(res, convert_to_tcl(interp, v, &vo));
					TEST_OK_BREAK(res, Tcl_DictObjPut(interp, new, k, vo));



				}

				Tcl_DictObjDone(&search);
				release_tclobj(&vo);
				if (res == TCL_OK) replace_tclobj(out, new);
				release_tclobj(&new);
			}
			break;

		case JSON_ARRAY:
			{
				int			i, oc;
				Tcl_Obj**	ov = NULL;
				Tcl_Obj*	elem = NULL;
				Tcl_Obj*	new = NULL;

				replace_tclobj(&new, Tcl_NewListObj(0, NULL));

				TEST_OK(Tcl_ListObjGetElements(interp, val, &oc, &ov));

				for (i=0; i<oc; i++) {
					TEST_OK_BREAK(res, convert_to_tcl(interp, ov[i], &elem));
					TEST_OK_BREAK(res, Tcl_ListObjAppendElement(interp, new, elem));
				}
				release_tclobj(&elem);
				if (res == TCL_OK) replace_tclobj(out, new);
				release_tclobj(&new);
			}
			break;

		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
			replace_tclobj(out, val);
			break;

		case JSON_NULL:

			{
				struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
				replace_tclobj(out, l->tcl_empty);
			}
			break;

		// These are all just semantically normal JSON string values in this context

		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			replace_tclobj(out, Tcl_ObjPrintf("%s%s", dyn_prefix[type], Tcl_GetString(val)));
			break;

		default:
			THROW_ERROR("Invalid value type");
	}

	return res;
}

//}}}
static int _new_object(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res) //{{{
{
	int			i, ac, retval = TCL_OK;
	Tcl_Obj**	av;
	Tcl_Obj*	k;
	Tcl_Obj*	v;
	Tcl_Obj*	new_val;
	Tcl_Obj*	val;

	if (objc % 2 != 0)
		THROW_ERROR("json new object needs an even number of arguments");

	Tcl_IncrRefCount(val = Tcl_NewDictObj());


	for (i=0; i<objc; i+=2) {
		k = objv[i];
		v = objv[i+1];
		TEST_OK_LABEL(end, retval, Tcl_ListObjGetElements(interp, v, &ac, &av));
		TEST_OK_LABEL(end, retval, new_json_value_from_list(interp, ac, av, &new_val));
		TEST_OK_LABEL(end, retval, Tcl_DictObjPut(interp, val, k, new_val));
	}





























































































































	Tcl_IncrRefCount(*res = JSON_NewJvalObj(JSON_OBJECT, val));



























end:
	release_tclobj(&val);
	return retval;
}

//}}}
static void foreach_state_free(struct foreach_state* state) //{{{
{
	unsigned int i, j;

................................................................................
	return Tcl_NREvalObj(interp, state->script, 0);
}

//}}}
static int NRforeach_next_loop_bottom(ClientData cdata[], Tcl_Interp* interp, int retcode) //{{{
{
	struct foreach_state*	state = (struct foreach_state*)cdata[0];
	struct interp_cx*		l = Tcl_GetAssocData(interp, "rl_json", NULL);
	Tcl_Obj*				it_res = NULL;

	switch (retcode) {
		case TCL_OK:

			switch (state->collecting) {
				case COLLECT_NONE: break;
				case COLLECT_LIST:
					Tcl_IncrRefCount(it_res = Tcl_GetObjResult(interp));
					Tcl_ResetResult(interp);
					TEST_OK_LABEL(done, retcode, Tcl_ListObjAppendElement(interp, state->res, it_res));
					Tcl_DecrRefCount(it_res); it_res = NULL;
					break;

				case COLLECT_ARRAY:
				case COLLECT_OBJECT:
					{
						enum json_types	type;
						Tcl_Obj*		val = NULL;		// Intrep of state->res

						if (Tcl_IsShared(state->res)) {
							Tcl_Obj*	new = NULL;
							Tcl_IncrRefCount(new = Tcl_DuplicateObj(state->res));
							Tcl_DecrRefCount(state->res);
							state->res = new;	// Transfers ref from new to state->res
						}
						TEST_OK_LABEL(done, retcode, JSON_GetJvalFromObj(interp, state->res, &type, &val));

						Tcl_IncrRefCount(it_res = Tcl_GetObjResult(interp));
						Tcl_ResetResult(interp);

						switch (state->collecting) {
							case COLLECT_ARRAY:
								TEST_OK_LABEL(done, retcode, Tcl_ListObjAppendElement(interp, val, as_json(interp, it_res)));
								break;

							case COLLECT_OBJECT:
								if (it_res->typePtr == l->typeDict) { // Iterate over it_res as a dictionary {{{
									Tcl_DictSearch	search;
									Tcl_Obj*		k = NULL;
									Tcl_Obj*		v = NULL;
									int				done;

									TEST_OK_LABEL(done, retcode, Tcl_DictObjFirst(interp, it_res, &search, &k, &v, &done));
									for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
										TEST_OK_LABEL(cleanup_search, retcode, Tcl_DictObjPut(interp, val, k, as_json(interp, v)));
									}

cleanup_search:
									Tcl_DictObjDone(&search);
									if (retcode != TCL_OK) goto done;
									break;
									//}}}
								} else { // Iterate over it_res as a list {{{
									int			oc, i;
									Tcl_Obj**	ov = NULL;

									TEST_OK_LABEL(done, retcode, Tcl_ListObjGetElements(interp, it_res, &oc, &ov));

									if (oc % 2 != 0)
										THROW_ERROR_LABEL(done, retcode, "Iteration result must be a list with an even number of elements");

									for (i=0; i<oc; i+=2)
										TEST_OK_LABEL(done, retcode, Tcl_DictObjPut(interp, val, ov[i], as_json(interp, ov[i+1])));
									//}}}
								}
								break;

							default:
								THROW_ERROR_LABEL(done, retcode, "Unexpect value for collecting");
						}

						if (it_res)
							Tcl_DecrRefCount(it_res); it_res = NULL;
					}
					break;
			}

		case TCL_CONTINUE:
			retcode = TCL_OK;
			break;

		case TCL_BREAK:
			retcode = TCL_OK;
................................................................................
		if (state->res != NULL) {
			Tcl_SetObjResult(interp, state->res);
		}
	}

done:
	//fprintf(stderr, "done\n");
	if (it_res != NULL) {
		Tcl_DecrRefCount(it_res);
		it_res = NULL;
	}

	if (retcode == TCL_OK && state->res != NULL /* collecting */)
		Tcl_SetObjResult(interp, state->res);

	foreach_state_free(state);
	Tcl_Free((char*)state);
	state = NULL;

	return retcode;
}

//}}}
static int foreach(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], enum collecting_mode collecting) //{{{
{
	// Caller must ensure that objc is valid
	unsigned int			i;
	int						retcode=TCL_OK;
	struct foreach_state*	state = NULL;

	state = (struct foreach_state*)Tcl_Alloc(sizeof(*state));
	state->iterators = (objc-1)/2;
	state->it = (struct foreach_iterator*)Tcl_Alloc(sizeof(struct foreach_iterator) * state->iterators);
	state->max_loops = 0;
	state->loop_num = 0;
	state->collecting = collecting;

	Tcl_IncrRefCount(state->script = objv[objc-1]);

	switch (state->collecting) {
		case COLLECT_NONE:

			state->res = NULL;
			break;
		case COLLECT_LIST:
			Tcl_IncrRefCount(state->res = Tcl_NewListObj(0, NULL));
			break;
		case COLLECT_ARRAY:
			Tcl_IncrRefCount(state->res = JSON_NewJvalObj(JSON_ARRAY, Tcl_NewListObj(0, NULL)));
			break;
		case COLLECT_OBJECT:
			Tcl_IncrRefCount(state->res = JSON_NewJvalObj(JSON_OBJECT, Tcl_NewDictObj()));
			break;
		default:
			THROW_ERROR_LABEL(done, retcode, "Unhandled value for collecting");
	}

	for (i=0; i<state->iterators; i++) {
		state->it[i].search.dictionaryPtr = NULL;
		state->it[i].data_v = NULL;
		state->it[i].is_array = 0;
		state->it[i].var_v = NULL;
		state->it[i].varlist = NULL;
	}

	for (i=0; i<state->iterators; i++) {
		int				loops, j;
		enum json_types	type;
		Tcl_Obj*		val;
		Tcl_Obj*		varlist = objv[i*2];

		if (Tcl_IsShared(varlist))
			varlist = Tcl_DuplicateObj(varlist);

		Tcl_IncrRefCount(state->it[i].varlist = varlist);

		TEST_OK_LABEL(done, retcode, Tcl_ListObjGetElements(interp, state->it[i].varlist, &state->it[i].var_c, &state->it[i].var_v));
................................................................................
	}

	if (state->loop_num < state->max_loops)
		return NRforeach_next_loop_top(interp, state);

done:
	//fprintf(stderr, "done\n");
	if (retcode == TCL_OK && state->collecting != COLLECT_NONE)
		Tcl_SetObjResult(interp, state->res);

	foreach_state_free(state);
	Tcl_Free((char*)state);
	state = NULL;

	return retcode;
}

//}}}
int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds) //{{{
{
	int							indent_len, pad_len, next_pad_len, count;
	enum json_types				type;
	const char*					pad_str;
	const char*					next_pad_str;
	Tcl_Obj*					next_pad;
	Tcl_Obj*					val;
	struct serialize_context	scx;

	scx.ds = ds;
	scx.serialize_mode = SERIALIZE_NORMAL;
	scx.fromdict = NULL;
	scx.l = Tcl_GetAssocData(interp, "rl_json", NULL);
	scx.allow_null = 1;

	TEST_OK(JSON_GetJvalFromObj(interp, json, &type, &val));

	Tcl_GetStringFromObj(indent, &indent_len);
	pad_str = Tcl_GetStringFromObj(pad, &pad_len);

	switch (type) {
................................................................................
			serialize(interp, &scx, json);
	}

	return TCL_OK;
}

//}}}

static int json_pretty_dbg(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds) //{{{
{
	int							indent_len, pad_len, next_pad_len, count;
	enum json_types				type;
	const char*					pad_str;
	const char*					next_pad_str;
	Tcl_Obj*					next_pad;
	Tcl_Obj*					val;
	struct serialize_context	scx;

	scx.ds = ds;
	scx.serialize_mode = SERIALIZE_NORMAL;
	scx.fromdict = NULL;
	scx.l = Tcl_GetAssocData(interp, "rl_json", NULL);
	scx.allow_null = 1;

	TEST_OK(JSON_GetJvalFromObj(interp, json, &type, &val));

	Tcl_GetStringFromObj(indent, &indent_len);
	pad_str = Tcl_GetStringFromObj(pad, &pad_len);

	if (type == JSON_NULL) {
................................................................................

		default:
			serialize_json_val(interp, &scx, type, val);
	}

	return TCL_OK;
}

//}}}
#if 0
static int merge(Tcl_Interp* interp, int deep, Tcl_Obj *const orig, Tcl_Obj *const patch, Tcl_Obj **const res) //{{{
{
	Tcl_Obj*		val;
	Tcl_Obj*		pval;
	int				type, ptype, done, retcode=TCL_OK;
................................................................................
		default:
			THROW_ERROR("Unsupported JSON type: ", Tcl_GetString(Tcl_NewIntObj(type)));
	}
}

//}}}
#endif
static int prev_opcode(const struct template_cx *const cx) //{{{
{
	int			len, opcode;
	Tcl_Obj*	last = NULL;

	TEST_OK(Tcl_ListObjLength(cx->interp, cx->actions, &len));

	if (len == 0) return NOP;

	TEST_OK(Tcl_ListObjIndex(cx->interp, cx->actions, len-3, &last));
	TEST_OK(Tcl_GetIndexFromObj(cx->interp, last, action_opcode_str, "opcode", TCL_EXACT, &opcode));

	return opcode;
}

//}}}
static int emit_action(const struct template_cx* cx, enum action_opcode opcode, Tcl_Obj *const a, Tcl_Obj *const slot) // TODO: inline? {{{
{
	/*
	fprintf(stderr, "opcode %s: %s %s\n",
			Tcl_GetString(cx->l->action[opcode]),
			a == NULL ? "NULL" : Tcl_GetString(a),
			b == NULL ? "NULL" : Tcl_GetString(b));
			*/



	TEST_OK(Tcl_ListObjAppendElement(cx->interp, cx->actions, cx->l->action[opcode]));
	TEST_OK(Tcl_ListObjAppendElement(cx->interp, cx->actions, a==NULL ? cx->l->tcl_empty : a));
	TEST_OK(Tcl_ListObjAppendElement(cx->interp, cx->actions, slot==NULL ? cx->l->tcl_empty : slot));
	

	return TCL_OK;
}








//}}}
static int emit_fetches(const struct template_cx *const cx) //{{{
{
	Tcl_DictSearch	search;
	Tcl_Obj*		elem;
	Tcl_Obj*		v;
	int				done, retcode=TCL_OK;


	TEST_OK(Tcl_DictObjFirst(cx->interp, cx->map, &search, &elem, &v, &done));
	for (; !done; Tcl_DictObjNext(&search, &elem, &v, &done)) {
		int				len, fetch_idx, types_search_done=0, used_fetch=0;
		Tcl_DictSearch	types_search;
		Tcl_Obj*		type;
		Tcl_Obj*		slot;

		TEST_OK_LABEL(done, retcode,	emit_action(cx, FETCH_VALUE, elem, NULL)				);
		TEST_OK_LABEL(done, retcode,	Tcl_ListObjLength(cx->interp, cx->actions, &len)		);
		fetch_idx = len-3;		// Record the position of the fetch, in case we need to remove it later (DYN_LITERAL)




		TEST_OK_LABEL(done, retcode,	Tcl_DictObjFirst(cx->interp, v, &types_search, &type, &slot, &done));
		for (; !types_search_done; Tcl_DictObjNext(&types_search, &type, &slot, &types_search_done)) {
			int		subst_type;
			TEST_OK_LABEL(done2, retcode,	lookup_type(cx->interp, type, &subst_type));

			if (subst_type != JSON_DYN_LITERAL)
				used_fetch = 1;

			// Each of these actions checks for NULL in value and inserts a JSON null in that case
			switch (subst_type) {
				case JSON_DYN_STRING:
					TEST_OK_LABEL(done2, retcode,	emit_action(cx, STORE_STRING, NULL, slot)	);
					break;
				case JSON_DYN_JSON:
					TEST_OK_LABEL(done2, retcode,	emit_action(cx, STORE_JSON, NULL, slot)		);
					break;
				case JSON_DYN_TEMPLATE:
					TEST_OK_LABEL(done2, retcode,	emit_action(cx, STORE_TEMPLATE, NULL, slot)	);
					break;
				case JSON_DYN_NUMBER:
					TEST_OK_LABEL(done2, retcode,	emit_action(cx, STORE_NUMBER, NULL, slot)	);
					break;
				case JSON_DYN_BOOL:
					TEST_OK_LABEL(done2, retcode,	emit_action(cx, STORE_BOOLEAN, NULL, slot)	);
					break;
				case JSON_DYN_LITERAL:
					{
						const char*		s;
						int				len;
						enum json_types	type;

						s = Tcl_GetStringFromObj(elem, &len);
						TEMPLATE_TYPE(s, len, type);	// s is advanced past prefix
						if (type == JSON_STRING) {
							TEST_OK_LABEL(done2, retcode,	emit_action(cx, DECLARE_LITERAL, elem, NULL)	);
							TEST_OK_LABEL(done2, retcode,	emit_action(cx, STORE_STRING, NULL, slot)		);
						} else {

							TEST_OK_LABEL(done2, retcode,	emit_action(cx, DECLARE_LITERAL,
										JSON_NewJvalObj(type, get_string(cx->l, s, len-3)), NULL)	);
							TEST_OK_LABEL(done2, retcode,	emit_action(cx, STORE_JSON, NULL, slot)			);
						}
					}
					break;
				default:
					Tcl_SetObjResult(cx->interp, Tcl_ObjPrintf("Invalid type \"%s\"", Tcl_GetString(type)));
					retcode = TCL_ERROR;
					goto done2;
			}
		}

		if (!used_fetch)	// Value from fetch wasn't used, drop the FETCH_VALUE opcode
			TEST_OK_LABEL(done, retcode,	Tcl_ListObjReplace(cx->interp, cx->actions, fetch_idx, 3, 0, NULL)	);

done2:
		Tcl_DictObjDone(&types_search);
		if (retcode != TCL_OK) break;
	}

done:
	Tcl_DictObjDone(&search);
	return retcode;
}

//}}}
static int get_subst_slot(struct template_cx* cx, Tcl_Obj* elem, Tcl_Obj* type, int subst_type, Tcl_Obj** slot) //{{{
{
	int			retcode = TCL_OK;
	Tcl_Obj*	keydict = NULL;
	Tcl_Obj*	slotobj = NULL;

	// Find the map for this key
	TEST_OK(Tcl_DictObjGet(cx->interp, cx->map, elem, &keydict));
	if (keydict == NULL) {
		keydict = Tcl_NewDictObj();
		TEST_OK_LABEL(finally, retcode, Tcl_DictObjPut(cx->interp, cx->map, elem, keydict));
	}
	//fprintf(stderr, "get_subst_slot (%s) %s:\n%s\n", Tcl_GetString(elem), Tcl_GetString(type), Tcl_GetString(keydict));

	// Find the allocated slot for this type for this key
	TEST_OK_LABEL(finally, retcode, Tcl_DictObjGet(cx->interp, keydict, type, &slotobj));
	if (slotobj != NULL) {
		Tcl_IncrRefCount(slotobj);
	} else {
		replace_tclobj(&slotobj, Tcl_NewIntObj(cx->slots_used++));
		TEST_OK_LABEL(finally, retcode, Tcl_DictObjPut(cx->interp, keydict, type, slotobj));
		/*
		fprintf(stderr, "Allocated new slot for %s %s: %s\n", Tcl_GetString(elem), Tcl_GetString(type), Tcl_GetString(*slot));
	} else {
		fprintf(stderr, "Found slot for %s %s: %s\n", Tcl_GetString(elem), Tcl_GetString(type), Tcl_GetString(*slot));
		*/
	}







































	if (retcode == TCL_OK)
		replace_tclobj(slot, slotobj);

finally:
	release_tclobj(&slotobj);



	return retcode;
}

//}}}
/*
static int record_subst_location(Tcl_Interp* interp, Tcl_Obj* parent, Tcl_Obj* elem, Tcl_Obj* registry, Tcl_Obj* slot) //{{{
{
	Tcl_Obj*	path_info = NULL;
................................................................................
	TEST_OK(Tcl_DictObjPut(interp, path_info, elem, slot));

	return TCL_OK;
}

//}}}
*/
static int remove_action(Tcl_Interp* interp, struct template_cx* cx, int idx) //{{{
{
	idx *= 3;
	if (idx < 0) {
		int	len;

		TEST_OK(Tcl_ListObjLength(interp, cx->actions, &len));
		idx += len;
	}
	return Tcl_ListObjReplace(interp, cx->actions, idx, 3, 0, NULL);
}

//}}}
static int template_actions(struct template_cx* cx, Tcl_Obj* template, enum action_opcode rep_action, Tcl_Obj* elem) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;
	Tcl_Interp*		interp = cx->interp;
	int				retval = TCL_OK;

	TEST_OK(JSON_GetJvalFromObj(interp, template, &type, &val));

	switch (type) {
		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
		case JSON_NULL:
			break;

		case JSON_OBJECT:
			{
				int				done, retval = TCL_OK;
				Tcl_DictSearch	search;
				Tcl_Obj*		k;
				Tcl_Obj*		v;





				TEST_OK(emit_action(cx, PUSH_TARGET, template, NULL));
				TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));
				for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
					int				len;
					enum json_types	stype;
					const char*		s = Tcl_GetStringFromObj(k, &len);




					TEST_OK_LABEL(free_search, retval, template_actions(cx, v, REPLACE_VAL, k));









					TEMPLATE_TYPE(s, len, stype);	// s is advanced past prefix
					switch (stype) {



						case JSON_STRING:




							break;



						case JSON_DYN_STRING:
						case JSON_DYN_LITERAL:
							{

								Tcl_Obj*	slot = NULL;


								//fprintf(stderr, "Found key subst at \"%s\": (%s) %s %s, allocated slot %s\n", Tcl_GetString(path), Tcl_GetString(k), type_names_int[stype], s+3, Tcl_GetString(slot));


								retval = get_subst_slot(cx, get_string(cx->l, s, len-3), cx->l->type_int[stype], stype, &slot);
								if (retval == TCL_OK)
									retval = emit_action(cx, REPLACE_KEY, k, slot);

								release_tclobj(&slot);
								if (retval != TCL_OK) goto free_search;
							}
							break;


						default:
							THROW_ERROR("Only strings allowed as object keys");
					}



				}


free_search:
				Tcl_DictObjDone(&search);
				if (prev_opcode(cx) == PUSH_TARGET) {
					remove_action(interp, cx, -1);
				} else {
					TEST_OK(emit_action(cx, POP_TARGET, NULL, NULL));
					TEST_OK(emit_action(cx, rep_action, elem, cx->l->tcl_zero));
				}

				if (retval != TCL_OK) return retval;
			}
			break;

		case JSON_ARRAY:
			{
				int			i, oc;
				Tcl_Obj**	ov;

				Tcl_Obj*	arr_elem = NULL;



				TEST_OK(emit_action(cx, PUSH_TARGET, template, NULL));

				TEST_OK(Tcl_ListObjGetElements(interp, val, &oc, &ov));
				for (i=0; i<oc; i++) {
					replace_tclobj(&arr_elem, Tcl_NewIntObj(i));
					if (TCL_OK != (retval = template_actions(cx, ov[i], REPLACE_ARR, arr_elem)))
						break;
				}

				release_tclobj(&arr_elem);
				if (retval != TCL_OK) return retval;
				if (prev_opcode(cx) == PUSH_TARGET) {
					remove_action(interp, cx, -1);
				} else {
					TEST_OK(emit_action(cx, POP_TARGET, NULL, NULL));
					TEST_OK(emit_action(cx, rep_action, elem, cx->l->tcl_zero));
				}



			}
			break;

		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			{
				Tcl_Obj*	slot = NULL;



				//fprintf(stderr, "Found value subst at \"%s\": (%s) %s: %s, allocated slot %s\n", Tcl_GetString(parent), Tcl_GetString(elem), type_names_int[type], Tcl_GetString(val), Tcl_GetString(slot));

				retval = get_subst_slot(cx, val, cx->l->type_int[type], type, &slot);
				if (retval == TCL_OK)
					retval = emit_action(cx, rep_action, elem, slot);
				release_tclobj(&slot);
			}
			break;

		default:
			THROW_ERROR("unhandled type: %d", type);
	}

	return retval;
}

//}}}
int build_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj** actions) //{{{
{
	int					retcode=TCL_OK;
	struct template_cx	cx = {	// Unspecified members are initialized to 0

		.interp		= interp,
		.l			= Tcl_GetAssocData(interp, "rl_json", NULL),
		.slots_used	= 1	// slot 0 is the scratch space, where completed targets go when popped


	};


	release_tclobj(actions);

	replace_tclobj(&cx.map,     Tcl_NewDictObj());
	replace_tclobj(&cx.actions, Tcl_NewListObj(0, NULL));











	TEST_OK_LABEL(done, retcode,
		template_actions(&cx, template, REPLACE_ATOM, cx.l->tcl_empty)
	);




	if (cx.slots_used > 1) { // Prepend the template action to allocate the slots
		Tcl_Obj*	actions_tail=NULL;
		int			maxdepth=0;




		// Save the current actions (containing the interpolate and traversal
		// actions), and swap in a new one that we will populate with some
		// prefix actions (allocation and fetching)
		replace_tclobj(&actions_tail, cx.actions);
		replace_tclobj(&cx.actions, Tcl_NewListObj(0, NULL));

		{ // Find max cx stack depth
			int			depth=0, actionc, i;
			Tcl_Obj**	actionv;


			TEST_OK_LABEL(actions_done, retcode,
				Tcl_ListObjGetElements(interp, actions_tail, &actionc, &actionv)
			);

			for (i=0; i<actionc; i+=3) {
				int			opcode;

				TEST_OK_LABEL(actions_done, retcode,
					Tcl_GetIndexFromObj(interp, actionv[i], action_opcode_str, "opcode", TCL_EXACT, &opcode)
				);
				switch (opcode) {


					case PUSH_TARGET:
						if (++depth > maxdepth) maxdepth = depth;
						break;

					case POP_TARGET:

						depth--;
						break;
				}
			}
		}


		TEST_OK_LABEL(actions_done, retcode,
			emit_action(&cx, ALLOCATE, Tcl_NewIntObj(maxdepth), Tcl_NewIntObj(cx.slots_used))
		);

		TEST_OK_LABEL(actions_done, retcode,
			emit_fetches(&cx)
		);

		// Add back on the actions tail
		TEST_OK_LABEL(actions_done, retcode,
			Tcl_ListObjAppendList(interp, cx.actions, actions_tail)
		);

actions_done:
		release_tclobj(&actions_tail);
		if (retcode != TCL_OK) goto done;
	}

	replace_tclobj(actions, cx.actions);
	Tcl_IncrRefCount(*actions);	// DEBUG: trigger obj leak


done:
	release_tclobj(&cx.map);
	release_tclobj(&cx.actions);

	return retcode;
}

//}}}

int lookup_type(Tcl_Interp* interp, Tcl_Obj* typeobj, int* type) //{{{
{


















	return Tcl_GetIndexFromObj(interp, typeobj, type_names_int, "type", TCL_EXACT, type);
}



//}}}


static inline void fill_slot(Tcl_Obj** slots, int slot, Tcl_Obj* value) //{{{
{


	replace_tclobj(&slots[slot], value);
}


























//}}}
int apply_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* actions, Tcl_Obj* dict, Tcl_Obj** res) // dict may be null, which means lookup vars {{{
{
	struct interp_cx* l = NULL;
#define STATIC_SLOTS	10
	Tcl_Obj*	stackslots[STATIC_SLOTS];
	Tcl_Obj**	slots = NULL;
	int			slotslen = 0;
	int			retcode = TCL_OK;
	Tcl_Obj**	actionv;
	int			actionc, i;
#define STATIC_STACK	8
	Tcl_Obj*	stackstack[STATIC_STACK];
	Tcl_Obj**	stack = NULL;
	int			stacklevel = 0;
	Tcl_Obj*	subst_val = NULL;

	Tcl_Obj*	key = NULL;
	int			slot, stacklevels=0;
	Tcl_Obj*	target = NULL;




	TEST_OK_LABEL(finally, retcode, Tcl_ListObjGetElements(interp, actions, &actionc, &actionv));
	if (actionc == 0) {

		replace_tclobj(res, Tcl_DuplicateObj(template));
		Tcl_InvalidateStringRep(*res);		// Some code relies on the fact that the result of the template command is a normalized json doc (no unnecessary whitespace / newlines)
		return TCL_OK;
	}

	if (actionc % 3 != 0)
		THROW_ERROR_LABEL(finally, retcode, "Invalid actions (odd number of elements)");

	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	for (i=0; i<actionc; i+=3) {
		int					tmp;
		enum action_opcode	opcode;
		Tcl_Obj*			a = actionv[i+1];
		Tcl_Obj*			b = actionv[i+2];

		TEST_OK_LABEL(finally, retcode, Tcl_GetIndexFromObj(interp, actionv[i], action_opcode_str, "opcode", TCL_EXACT, &tmp));
		opcode = tmp;
		//fprintf(stderr, "%s (%s) (%s)\n", Tcl_GetString(actionv[i]), Tcl_GetString(a), Tcl_GetString(b));
		switch (opcode) {
			case ALLOCATE: //{{{
				{
					// slots is in b, stack is in a
					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slotslen));
					if (slotslen > STATIC_SLOTS) {
						slots = ckalloc(sizeof(Tcl_Obj*) * slotslen);
					} else {
						slots = stackslots;
					}
					if (slotslen > 0)
						memset(slots, 0, sizeof(Tcl_Obj*) * slotslen);





					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, a, &stacklevels));
					if (stacklevels > STATIC_STACK) {
						stack = ckalloc(sizeof(struct Tcl_Obj*) * stacklevels);
					} else {
						stack = stackstack;	// Use the space allocated on the c stack
					}

					if (stacklevels > 0)
						memset(stack, 0, sizeof(Tcl_Obj*) * stacklevels);
				}
				break;
				//}}}
			case FETCH_VALUE: //{{{
				replace_tclobj(&key, a);	// Keep a reference in case we need it for an error message shortly
				if (dict) {
					Tcl_Obj*	new = NULL;
					TEST_OK_LABEL(finally, retcode, Tcl_DictObjGet(interp, dict, a, &new));
					replace_tclobj(&subst_val, new);
				} else {
					replace_tclobj(&subst_val, Tcl_ObjGetVar2(interp, a, NULL, 0));
				}
				break;
				//}}}
			case DECLARE_LITERAL: //{{{

				replace_tclobj(&subst_val, a);
				break;
				//}}}
			case STORE_STRING: //{{{
				TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));
				if (subst_val == NULL) {
					fill_slot(slots, slot, l->json_null);
				} else {
					const char*	str;
					int			len;
					Tcl_Obj*	jval=NULL;

					str = Tcl_GetStringFromObj(subst_val, &len);
					if (len == 0) {
						replace_tclobj(&jval, l->json_empty_string);
					} else if (len < 3) {
						replace_tclobj(&jval, JSON_NewJvalObj(JSON_STRING, subst_val));
					} else {
						enum json_types	type;


						TEMPLATE_TYPE(str, len, type);	// str is advanced to after the prefix







						if (type == JSON_STRING) {
							replace_tclobj(&jval, JSON_NewJvalObj(JSON_STRING, subst_val));
						} else {

							replace_tclobj(&jval, JSON_NewJvalObj(type, get_string(l, str, len-3)));
						}
					}
					fill_slot(slots, slot, jval);
					release_tclobj(&jval);
				}
				break;
				//}}}
			case STORE_NUMBER: //{{{
				TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));
				if (subst_val == NULL) {
					fill_slot(slots, slot, l->json_null);
				} else {
					Tcl_Obj* forced = NULL;
					
					if (likely((retcode = force_json_number(interp, l, subst_val, &forced)) == TCL_OK))

						fill_slot(slots, slot, JSON_NewJvalObj(JSON_NUMBER, forced));

					release_tclobj(&forced);

					if (unlikely(retcode != TCL_OK)) {
						Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error substituting value from \"%s\" into template, not a number: \"%s\"", Tcl_GetString(key), Tcl_GetString(subst_val)));
						retcode = TCL_ERROR;
						goto finally;
					}



				}
				break;
				//}}}
			case STORE_BOOLEAN: //{{{
				TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));
				if (subst_val == NULL) {
					fill_slot(slots, slot, l->json_null);
				} else {
					int is_true;

					TEST_OK_LABEL(finally, retcode, Tcl_GetBooleanFromObj(interp, subst_val, &is_true));

					fill_slot(slots, slot, is_true ? l->json_true : l->json_false);
				}
				break;
				//}}}
			case STORE_JSON: //{{{
				TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));
				if (subst_val == NULL) {
					fill_slot(slots, slot, l->json_null);
				} else {



					TEST_OK_LABEL(finally, retcode, JSON_ForceJSON(interp, subst_val));

					fill_slot(slots, slot, subst_val);
				}
				break;
				//}}}





			case STORE_TEMPLATE: //{{{
				{
					Tcl_Obj*	sub_template_actions = NULL;
					Tcl_Obj*	new = NULL;
					int			slot;

					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));
					if (subst_val == NULL) {
						fill_slot(slots, slot, l->json_null);
					} else {
						// recursively fill out sub template

						if (
							TCL_OK == (retcode = build_template_actions(interp, subst_val, &sub_template_actions)) &&
							TCL_OK == (retcode = apply_template_actions(interp, subst_val, sub_template_actions, dict, &new))
						) {
							// Result of a template substitution is guaranteed to be JSON if the return was TCL_OK
							//TEST_OK_LABEL(finally, retcode, JSON_ForceJSON(interp, new));
							fill_slot(slots, slot, new);
							release_tclobj(&new);
						}
						release_tclobj(&sub_template_actions);
						if (retcode != TCL_OK) goto finally;
					}
					break;
				}
				//}}}





			case PUSH_TARGET:
				if (target) Tcl_IncrRefCount(stack[stacklevel++] = target);
				/*
				if (Tcl_IsShared(a))
					a = Tcl_DuplicateObj(a);



				replace_tclobj(&target, a);
					*/
				replace_tclobj(&target, Tcl_DuplicateObj(a));
				break;

			case POP_TARGET:	// save target to slot[0] and pop the parent target off the stack
				fill_slot(slots, 0, target);
				if (stacklevel > 0) {

					Tcl_Obj*	popped = stack[--stacklevel];



					replace_tclobj(&target, popped);
					release_tclobj(&stack[stacklevel]);
				} else {
					release_tclobj(&target);
				}



				break;





			case REPLACE_ARR:
				{
					int				slot, idx;
					Tcl_ObjIntRep*	ir = NULL;
					Tcl_Obj*		ir_obj = NULL;

					// a is idx, b is slot
					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));
					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, a, &idx));
					if (Tcl_IsShared(target)) {


						THROW_ERROR_LABEL(finally, retcode, "target is shared for REPLACE_ARR");
					}
					ir = Tcl_FetchIntRep(target, g_objtype_for_type[JSON_ARRAY]);
					if (ir == NULL) {
						Tcl_SetObjResult(interp, Tcl_ObjPrintf("Could not fetch array intrep for target array %s", Tcl_GetString(target)));
						retcode = TCL_ERROR;
						goto finally;
					}








					ir_obj = get_unshared_val(ir);
					TEST_OK_LABEL(finally, retcode, Tcl_ListObjReplace(interp, ir_obj, idx, 1, 1, &slots[slot]));
					Tcl_InvalidateStringRep(target);
					release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);
				}
				break;



			case REPLACE_VAL:
				{
					int				slot;
					Tcl_ObjIntRep*	ir = NULL;
					Tcl_Obj*		ir_obj = NULL;

					// a is key, b is slot
					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));
					ir = Tcl_FetchIntRep(target, g_objtype_for_type[JSON_OBJECT]);
					if (ir == NULL) {
						Tcl_SetObjResult(interp, Tcl_ObjPrintf("Could not fetch array intrep for target object %s", Tcl_GetString(target)));
						retcode = TCL_ERROR;
						goto finally;
					}




					ir_obj = get_unshared_val(ir);
					TEST_OK_LABEL(finally, retcode, Tcl_DictObjPut(interp, ir_obj, a, slots[slot]));
					Tcl_InvalidateStringRep(target);
					release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);
				}
				break;


			case REPLACE_ATOM:
				{
					int		slot;

					// b is slot
					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));

					replace_tclobj(&target, slots[slot]);
				}
				break;


			case REPLACE_KEY:
				{
					int				slot;
					Tcl_ObjIntRep*	ir = NULL;
					Tcl_Obj*		ir_obj = NULL;

					Tcl_Obj*		hold = NULL;




					// a is key, b is slot (which holds the new key name)
					TEST_OK_LABEL(finally, retcode, Tcl_GetIntFromObj(interp, b, &slot));

					ir = Tcl_FetchIntRep(target, g_objtype_for_type[JSON_OBJECT]);
					if (ir == NULL) {
						Tcl_SetObjResult(interp, Tcl_ObjPrintf("Could not fetch array intrep for target object %s", Tcl_GetString(target)));
						retcode = TCL_ERROR;
						goto finally;
					}
					ir_obj = get_unshared_val(ir);
					TEST_OK_LABEL(finally, retcode, Tcl_DictObjGet(interp, ir_obj, a, &hold));
					Tcl_IncrRefCount(hold);
					TEST_OK_LABEL(finally, retcode, Tcl_DictObjRemove(interp, ir_obj, a));
					{
						Tcl_Obj*		key_ir_obj = NULL;
						enum json_types	key_type;

						// The value in the slot is a JSON value (JSON_STRING or JSON_DYN_LITERAL), so we need to
						// fetch it's Tcl string (from its intrep)
						TEST_OK_LABEL(finally, retcode, JSON_GetJvalFromObj(interp, slots[slot], &key_type, &key_ir_obj));

						switch (key_type) {
							case JSON_STRING:
								TEST_OK_LABEL(finally, retcode, Tcl_DictObjPut(interp, ir_obj, key_ir_obj, hold));
								break;

							case JSON_DYN_STRING:
							case JSON_DYN_NUMBER:
							case JSON_DYN_BOOL:
							case JSON_DYN_JSON:
							case JSON_DYN_TEMPLATE:
							case JSON_DYN_LITERAL:
									TEST_OK_LABEL(finally, retcode, Tcl_DictObjPut(interp, ir_obj,

												Tcl_ObjPrintf("%s%s", dyn_prefix[key_type], Tcl_GetString(key_ir_obj)), hold));
									break;

							default:
								Tcl_SetObjResult(interp, Tcl_ObjPrintf(
											"Only strings allowed as object keys, got: %s for key \"%s\"",
											Tcl_GetString(slots[slot]),
											Tcl_GetString(a) ));
								//Tcl_SetObjErrorCode(interp, actions);
								retcode = TCL_ERROR;
								goto finally;
						}
					}
					release_tclobj(&hold);
					Tcl_InvalidateStringRep(target);
					release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);
				}
				break;


			default:

				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Unhandled opcode: %s", Tcl_GetString(actionv[i])));
				retcode = TCL_ERROR;
				goto finally;
		}
	}

	replace_tclobj(res, target);

finally:
	if (slots) {
		for (i=0; i<slotslen; i++) release_tclobj(&slots[i]);
		if (slots != stackslots) ckfree(slots);
		slots = NULL;
	}

	release_tclobj(&key);
	release_tclobj(&subst_val);

	if (stack) {
		for (i=0; i<stacklevel; i++) release_tclobj(&stack[i]);
		if (stack != stackstack) ckfree(stack);
		stack = NULL;
	}

	return retcode;
}

//}}}

// Ensemble subcommands
static int jsonParse(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*		res = NULL;

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_val");
		return TCL_ERROR;
	}

	TEST_OK(JSON_ForceJSON(interp, objv[1]));	// Force parsing objv[1] as JSON
	TEST_OK(convert_to_tcl(interp, objv[1], &res));
	Tcl_SetObjResult(interp, res);
	release_tclobj(&res);

	return TCL_OK;
}

//}}}
static int jsonNormalize(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*		json = NULL;

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_val");
		return TCL_ERROR;
	}

	json = objv[1];

	if (Tcl_IsShared(json))
		json = Tcl_DuplicateObj(json);

	TEST_OK(JSON_ForceJSON(interp, json));
	Tcl_InvalidateStringRep(json);

	// Defer string rep generation to our caller
	Tcl_SetObjResult(interp, json);

	return TCL_OK;
}

//}}}
static int jsonType(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	enum json_types		type;
	Tcl_Obj*			val;
	Tcl_Obj*			target = NULL;
	int					retval = TCL_OK;
	struct interp_cx*	l = (struct interp_cx*)cdata;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_val ?path ...?");
		return TCL_ERROR;
	}

	if (objc >= 3) {
		TEST_OK(resolve_path(interp, objv[1], objv+2, objc-2, &target, 0, 0));
	} else {
		replace_tclobj(&target, objv[1]);
	}

	retval = JSON_GetJvalFromObj(interp, target, &type, &val);
	release_tclobj(&target);

	if (retval == TCL_OK)
		Tcl_SetObjResult(interp, l->type[type]);

	return retval;
}

//}}}
static int jsonLength(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	struct interp_cx*	l = (struct interp_cx*)cdata;
	int					length;
	int					retval = TCL_OK;
	Tcl_Obj*			target = NULL;
	Tcl_Obj*			path = NULL;

	if (objc < 2) CHECK_ARGS(2, "length json_val ?path ...?");

	replace_tclobj(&path,
			objc >= 3 ?  Tcl_NewListObj(objc-2, objv+2)  :  l->tcl_empty_list
	);

	retval = JSON_Length(interp, objv[1], path, &length);

	if (retval == TCL_OK) {
		switch (length) {
			case 0:  Tcl_SetObjResult(interp, l->tcl_zero);           break;
			case 1:  Tcl_SetObjResult(interp, l->tcl_one);            break;
			default: Tcl_SetObjResult(interp, Tcl_NewIntObj(length)); break;
		}
	}

	release_tclobj(&target);

	return retval;
}

//}}}
static int jsonKeys(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	struct interp_cx*	l = (struct interp_cx*)cdata;
	Tcl_Obj*			path = NULL;
	Tcl_Obj*			keylist = NULL;
	int					retval = TCL_OK;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_val ?path ...?");
		return TCL_ERROR;
	}

	if (objc >= 3) {
		replace_tclobj(&path, Tcl_NewListObj(objc-2, objv+2));
	} else {
		replace_tclobj(&path, l->tcl_empty_list);
	}

	retval = JSON_Keys(interp, objv[1], path, &keylist);
	
	if (retval == TCL_OK)
		Tcl_SetObjResult(interp, keylist);
	
	release_tclobj(&keylist);
	
	return retval;
}

//}}}
static int jsonExists(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*		target = NULL;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_val ?path ...?");
		return TCL_ERROR;
	}

	if (objc >= 3) {
		TEST_OK(resolve_path(interp, objv[1], objv+2, objc-2, &target, 1, 1));
		release_tclobj(&target);
		// resolve_path sets the interp result in exists mode
	} else {
		enum json_types	type;
		Tcl_Obj*		val;
		TEST_OK(JSON_GetJvalFromObj(interp, objv[1], &type, &val));
		Tcl_SetObjResult(interp, Tcl_NewBooleanObj(type != JSON_NULL));
	}

	return TCL_OK;
}

//}}}
static int jsonGet(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*	target = NULL;
	Tcl_Obj*	res = NULL;
	int			convert=1, retval=TCL_OK;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_val ?path ...?");
		return TCL_ERROR;
	}

	if (objc >= 3) {
		const char*		s = NULL;
		int				l;

		TEST_OK(resolve_path(interp, objv[1], objv+2, objc-2, &target, 0, 1));
		s = Tcl_GetStringFromObj(objv[objc-1], &l);
		if (s[0] == '?' && s[1] != '?') {
			// If the last element of the path is an unquoted
			// modifier, we need to skip the conversion from JSON
			// (it won't be json, but the modifier result)
			convert = 0;
		}
	} else {
		enum json_types	type;
		Tcl_ObjIntRep*	ir;
		replace_tclobj(&target, objv[1]);
		TEST_OK_LABEL(finally, retval, JSON_GetIntrepFromObj(interp, target, &type, &ir));	// Force parsing objv[2] as JSON
	}

	if (convert) {

		TEST_OK_LABEL(finally, retval, convert_to_tcl(interp, target, &res));
	} else {
		replace_tclobj(&res, target);
	}

	if (retval == TCL_OK)
		Tcl_SetObjResult(interp, res);

finally:
	release_tclobj(&target);
	release_tclobj(&res);

	return retval;
}

//}}}
static int jsonExtract(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*		target = NULL;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_val ?path ...?");
		return TCL_ERROR;
	}

	if (objc >= 3) {
		TEST_OK(resolve_path(interp, objv[1], objv+2, objc-2, &target, 0, 0));
	} else {
		enum json_types	type;
		Tcl_Obj*		val;
		TEST_OK(JSON_GetJvalFromObj(interp, objv[1], &type, &val));	// Just a validation, keeps the contract that we return JSON
		replace_tclobj(&target, objv[1]);
	}

	Tcl_SetObjResult(interp, target);
	release_tclobj(&target);

	return TCL_OK;
}

//}}}
static int jsonSet(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*	path = NULL;

	if (objc < 3) {
		Tcl_WrongNumArgs(interp, 1, objv, "varname ?path ...? json_val");
		return TCL_ERROR;
	}

	// -3, +2: last element of objv is the replacement, not part of the path
	replace_tclobj(&path, Tcl_NewListObj(objc-3, objv+2));
	TEST_OK(JSON_Set(interp, objv[1], path, objv[objc-1]));
	release_tclobj(&path);

	return TCL_OK;
}

//}}}
static int jsonUnset(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*	path = NULL;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "varname ?path ...?");
		return TCL_ERROR;
	}

	replace_tclobj(&path, Tcl_NewListObj(objc-2, objv+2));
	TEST_OK(JSON_Unset(interp, objv[1], path));
	release_tclobj(&path);

	return TCL_OK;
}

//}}}
static int jsonNew(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "type ?val?");
		return TCL_ERROR;
	}

	Tcl_Obj*	res = NULL;

	TEST_OK(new_json_value_from_list(interp, objc-1, objv+1, &res));
	Tcl_SetObjResult(interp, res);
	release_tclobj(&res);

	return TCL_OK;
}

//}}}
static int jsonString(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
#if DEDUP
	struct interp_cx*	l = (struct interp_cx*)cdata;
#endif
	int					len;
	const char*			s;
	enum json_types		type;

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "value");
		return TCL_ERROR;
	}

	s = Tcl_GetStringFromObj(objv[1], &len);
	TEMPLATE_TYPE(s, len, type);	// s is advanced past prefix

	if (type == JSON_STRING) {
		Tcl_SetObjResult(interp, JSON_NewJvalObj(JSON_STRING, get_string(l, s, len)));
	} else {
		Tcl_SetObjResult(interp, JSON_NewJvalObj(type, get_string(l, s, len-3)));
	}

	return TCL_OK;
}

//}}}
static int jsonNumber(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*			forced = NULL;
	struct interp_cx*	l = (struct interp_cx*)cdata;
	int					res = TCL_OK;

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "value");
		return TCL_ERROR;
	}

	if (likely((res = force_json_number(interp, l, objv[1], &forced)) == TCL_OK)) {
		Tcl_SetObjResult(interp, JSON_NewJvalObj(JSON_NUMBER, forced));
	}
	release_tclobj(&forced);

	return res;
}

//}}}
static int jsonBoolean(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	int b;

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "value");
		return TCL_ERROR;
	}

	TEST_OK(Tcl_GetBooleanFromObj(interp, objv[1], &b));
	Tcl_SetObjResult(interp, JSON_NewJvalObj(JSON_BOOL, Tcl_NewBooleanObj(b)));

	return TCL_OK;
}

//}}}
static int jsonObject(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	int			oc;
	Tcl_Obj**	ov;
	Tcl_Obj*	res = NULL;

	if (objc == 2) {
		TEST_OK(Tcl_ListObjGetElements(interp, objv[1], &oc, &ov));
		TEST_OK(_new_object(interp, oc, ov, &res));
	} else {
		TEST_OK(_new_object(interp, objc-1, objv+1, &res));
	}
	Tcl_SetObjResult(interp, res);
	release_tclobj(&res);

	return TCL_OK;
}

//}}}
static int jsonArray(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	int			i, ac, retval = TCL_OK;;
	Tcl_Obj**	av;
	Tcl_Obj*	elem = NULL;
	Tcl_Obj*	val = NULL;

	Tcl_IncrRefCount(val = Tcl_NewListObj(0, NULL));

	for (i=1; i<objc; i++) {
		TEST_OK_LABEL(end_new_array, retval, Tcl_ListObjGetElements(interp, objv[i], &ac, &av));
		TEST_OK_LABEL(end_new_array, retval, new_json_value_from_list(interp, ac, av, &elem));
		TEST_OK_LABEL(end_new_array, retval, Tcl_ListObjAppendElement(interp, val, elem));
	}
	Tcl_SetObjResult(interp, JSON_NewJvalObj(JSON_ARRAY, val));

end_new_array:
	release_tclobj(&val);

	return retval;
}

//}}}

static int jsonDecode(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*	encoding = NULL;
	Tcl_Obj*	res = NULL;
	int			retval = TCL_OK;

	if (objc < 2 || objc > 3) {
		Tcl_WrongNumArgs(interp, 1, objv, "bytes ?encoding?");
		return TCL_ERROR;
	}

	if (objc >= 3)
		replace_tclobj(&encoding, objv[2]);

	retval = JSON_Decode(interp, objv[1], encoding, &res);

	if (retval == TCL_OK)
		Tcl_SetObjResult(interp, res);

	release_tclobj(&res);
	release_tclobj(&encoding);

	return retval;
}

//}}}
static int jsonIsNull(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*		target = NULL;
	Tcl_Obj*		val;
	enum json_types	type;
	int				retval = TCL_OK;

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_val ?path ...?");
		return TCL_ERROR;
	}

	if (objc >= 3) {
		TEST_OK(resolve_path(interp, objv[1], objv+2, objc-2, &target, 0, 0));
	} else {
		replace_tclobj(&target, objv[1]);
	}

	retval = JSON_GetJvalFromObj(interp, target, &type, &val);

	if (retval == TCL_OK)
		Tcl_SetObjResult(interp, Tcl_NewBooleanObj(type == JSON_NULL));

	release_tclobj(&target);
	
	return retval;
}

//}}}
static int jsonTemplateString(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	int							res;
	struct serialize_context	scx;
	Tcl_DString					ds;

	if (objc < 2 || objc > 3) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_template ?source_dict?");
		return TCL_ERROR;
	}

	Tcl_DStringInit(&ds);

	scx.ds = &ds;
	scx.serialize_mode = SERIALIZE_TEMPLATE;
	scx.fromdict = NULL;
	scx.l = (struct interp_cx*)cdata;
	scx.allow_null = 1;

	if (objc >= 3)
		Tcl_IncrRefCount(scx.fromdict = objv[2]);

	res = serialize(interp, &scx, objv[1]);

	release_tclobj(&scx.fromdict);

	if (res == TCL_OK)
		Tcl_DStringResult(interp, scx.ds);

	Tcl_DStringFree(scx.ds); scx.ds = NULL;

	return res == TCL_OK ? TCL_OK : TCL_ERROR;
}

//}}}
static int jsonTemplate(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*	res = NULL;

	if (objc < 2 || objc > 3) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_template ?source_dict?");
		return TCL_ERROR;
	}

	TEST_OK(JSON_Template(interp, objv[1], objc >= 3 ? objv[2] : NULL, &res));

	if (res == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("res is NULL from JSON_Template!"));
		return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, res);
	release_tclobj(&res);

	return TCL_OK;
}

//}}}
static int _foreach(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], enum collecting_mode mode) //{{{
{
	if (objc < 4 || (objc-4) % 2 != 0) {
		Tcl_WrongNumArgs(interp, 1, objv, "?varlist datalist ...? script");
		return TCL_ERROR;
	}

	return foreach(interp, objc-1, objv+1, mode);
}

//}}}
static int jsonNRForeach(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return _foreach(cdata, interp, objc, objv, COLLECT_NONE);
}

//}}}
static int jsonForeach(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return Tcl_NRCallObjProc(interp, jsonNRForeach, cdata, objc, objv);
}

//}}}
static int jsonNRLmap(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return _foreach(cdata, interp, objc, objv, COLLECT_LIST);
}

//}}}
static int jsonLmap(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return Tcl_NRCallObjProc(interp, jsonNRLmap, cdata, objc, objv);
}

//}}}
static int jsonNRAmap(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return _foreach(cdata, interp, objc, objv, COLLECT_ARRAY);
}

//}}}
static int jsonAmap(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return Tcl_NRCallObjProc(interp, jsonNRAmap, cdata, objc, objv);
}

//}}}
static int jsonNROmap(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return _foreach(cdata, interp, objc, objv, COLLECT_OBJECT);
}

//}}}
static int jsonOmap(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return Tcl_NRCallObjProc(interp, jsonNROmap, cdata, objc, objv);
}

//}}}
static int jsonFreeCache(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
#if DEDUP
	struct interp_cx*	l = (struct interp_cx*)cdata;
#endif

	if (objc != 1) {
		Tcl_WrongNumArgs(interp, 1, objv, "");
		return TCL_ERROR;
	}

	free_cache(l);

	return TCL_OK;
}

//}}}
static int jsonNop(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	return TCL_OK;
}

//}}}
static int jsonPretty(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*	pretty = NULL;
	int			retval = TCL_OK;
	Tcl_Obj*	indent = NULL;

	if (objc < 2 || objc > 3)
		CHECK_ARGS(2, "pretty json_val ?indent?");

	if (objc >= 3)
		replace_tclobj(&indent, objv[2]);

	retval = JSON_Pretty(interp, objv[1], indent, &pretty);

	if (retval == TCL_OK)
		Tcl_SetObjResult(interp, pretty);

	release_tclobj(&pretty);

	return retval;
}

//}}}
static int jsonValid(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	struct interp_cx*	l = (struct interp_cx*)cdata;
	int					i, valid, retval=TCL_OK;
	struct parse_error	details = {};
	Tcl_Obj*			detailsvar = NULL;
	enum extensions	extensions = EXT_COMMENTS;		// By default, use the default set of extensions we accept
	static const char *options[] = {
		"-extensions",
		"-details",
		(char*)NULL
	};
	enum {
		O_EXTENSIONS,
		O_DETAILS
	};

	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "?-extensions extensionslist -details detailsvar? json_val");
		return TCL_ERROR;
	}

	for (i=1; i<objc-1; i++) {
		int		option;
		TEST_OK(Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT, &option));
		switch (option) {
			case O_EXTENSIONS:
				{
					Tcl_Obj**		ov;
					int				oc, idx;

					extensions = 0;		// An explicit list was supplied, reset the extensions

					if (i >= objc-2) {
						// Missing value for -extensions
						Tcl_WrongNumArgs(interp, i+1, objv, "extensionslist json_val");
						return TCL_ERROR;
					}

					i++;	// Point at the next arg: the extensionslist

					TEST_OK(Tcl_ListObjGetElements(interp, objv[i], &oc, &ov));
					for (idx=0; idx<oc; idx++) {
						int	ext;
						TEST_OK(Tcl_GetIndexFromObj(interp, ov[idx], extension_str, "extension", TCL_EXACT, &ext));
						extensions |= ext;
					}
				}
				break;

			case O_DETAILS:
				{
					if (i >= objc-2) {
						// Missing value for -extensions
						Tcl_WrongNumArgs(interp, i+1, objv, "detailsvar json_val");
						return TCL_ERROR;
					}

					i++;	// Point at the next arg: the extensionslist
					detailsvar = objv[i];
				}
				break;

			default:
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Unexpected option %d", option));
				return TCL_ERROR;
		}
	}

	TEST_OK(JSON_Valid(interp, objv[objc-1], &valid, extensions, &details));
	Tcl_SetObjResult(interp, valid ? l->tcl_true : l->tcl_false);

	if (!valid && detailsvar) {
		Tcl_Obj*	details_obj = NULL;
		Tcl_Obj*	k = NULL;
		Tcl_Obj*	v = NULL;

		replace_tclobj(&details_obj, Tcl_NewDictObj());

		replace_tclobj(&k, get_string(l, "errmsg", 6));
		replace_tclobj(&v, Tcl_NewStringObj(details.errmsg, -1));
		TEST_OK_LABEL(finally, retval, Tcl_DictObjPut(interp, details_obj, k, v));

		replace_tclobj(&k, get_string(l, "doc", 3));
		replace_tclobj(&v, Tcl_NewStringObj(details.doc, -1));
		TEST_OK_LABEL(finally, retval, Tcl_DictObjPut(interp, details_obj, k, v));

		replace_tclobj(&k, get_string(l, "char_ofs", 8));
		replace_tclobj(&v, Tcl_NewIntObj(details.char_ofs));
		TEST_OK_LABEL(finally, retval, Tcl_DictObjPut(interp, details_obj, k, v));

		if (NULL == Tcl_ObjSetVar2(interp, detailsvar, NULL, details_obj, TCL_LEAVE_ERR_MSG))
			retval = TCL_ERROR;
finally:
		release_tclobj(&details_obj);
		release_tclobj(&k);
		release_tclobj(&v);
	}

	return retval;
}

//}}}
static int jsonDebug(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	struct interp_cx*	l = (struct interp_cx*)cdata;
	int					retval = TCL_OK;
	Tcl_DString			ds;
	Tcl_Obj*			indent = NULL;
	Tcl_Obj*			pad = NULL;

	if (objc < 2 || objc > 3)
		CHECK_ARGS(2, "pretty json_val ?indent?");

	if (objc >= 3) {
		indent = objv[2];
	} else {
		indent = get_string(l, "    ", 4);
	}
	Tcl_IncrRefCount(indent);

	Tcl_IncrRefCount(pad = l->tcl_empty);
	Tcl_DStringInit(&ds);
	if ((retval = json_pretty_dbg(interp, objv[1], indent, pad, &ds)) == TCL_OK)
		Tcl_DStringResult(interp, &ds);

	release_tclobj(&pad);
	release_tclobj(&indent);
	Tcl_DStringFree(&ds);

	return retval;
}

//}}}
static int jsonTemplateActions(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	Tcl_Obj*		actions = NULL;
	Tcl_ObjIntRep*	ir;
	enum json_types	type;


	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "json_template");
		return TCL_ERROR;
	}

	TEST_OK(JSON_GetIntrepFromObj(interp, objv[1], &type, &ir));

	replace_tclobj(&actions, ir->twoPtrValue.ptr2);
	if (actions == NULL) {
		TEST_OK(build_template_actions(interp, objv[1], &actions));

		replace_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2, actions);
	}


	Tcl_SetObjResult(interp, actions);
	release_tclobj(&actions);

	return TCL_OK;
}

//}}}
#if 0
static int jsonMerge(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{

	int		i=2, deep=0, checking_flags=1, str_len;
	const char*	str;
	Tcl_Obj*	res = NULL;
	Tcl_Obj*	patch;
	Tcl_Obj*	new;
	static const char* flags[] = {
		"--",
		"-deep",
		(char*)NULL
	};
	enum {
		FLAG_ENDARGS,
		FLAG_DEEP
	};
	int	index;

	THROW_ERROR("merge method is not functional yet, sorry");

	if (objc < 1) CHECK_ARGS(0, "?flag ...? ?json_val ...?");

	while (i < objc) {
		patch = objv[i++];

		// Nasty optimization - prevent generating string rep of
		// a pure JSON value to check if it is a flag (can never
		// be: "-" isn't valid as the first char of a JSON value)
		if (patch->typePtr == &json_type)
			checking_flags = 0;

		if (checking_flags) {
			str = Tcl_GetStringFromObj(patch, &str_len);
			if (str_len > 0 && str[0] == '-') {
				TEST_OK(Tcl_GetIndexFromObj(interp, patch, flags,
							"flag", TCL_EXACT, &index));
				switch (index) {
					case FLAG_ENDARGS: checking_flags = 0; break;
					case FLAG_DEEP:    deep = 1;           break;
					default: THROW_ERROR("Invalid flag");
				}
				continue;
			}
		}

		if (res == NULL) {
			res = patch;
		} else {
			TEST_OK(merge(interp, deep, res, patch, &new));
			if (new != res)
				res = new;
		}
	}

	if (res != NULL)
		Tcl_SetObjResult(interp, res);
}

//}}}
#endif

static int new_json_value_from_list(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	int		new_type, retval=TCL_OK;
	static const char* types[] = {
		"string",
		"object",
		"array",
		"number",
		"true",
		"false",
		"null",
		"boolean",
		"json",
		(char*)NULL
	};
	enum {
		NEW_STRING,
		NEW_OBJECT,
		NEW_ARRAY,
		NEW_NUMBER,
		NEW_TRUE,
		NEW_FALSE,
		NEW_NULL,
		NEW_BOOL,
		NEW_JSON
	};

	if (objc < 1) CHECK_ARGS(0, "type ?val?");

	TEST_OK(Tcl_GetIndexFromObj(interp, objv[0], types, "type", 0, &new_type));

	switch (new_type) {
		case NEW_STRING:	retval = jsonString(l, interp, objc, objv); break;
		case NEW_OBJECT:	retval = jsonObject(l, interp, objc, objv); break;
		case NEW_ARRAY:		retval = jsonArray( l, interp, objc, objv); break;
		case NEW_NUMBER:	retval = jsonNumber(l, interp, objc, objv); break;
		case NEW_TRUE: //{{{
			CHECK_ARGS(0, "true");
			Tcl_IncrRefCount(*res = l->json_true);
			return TCL_OK;
			//}}}
		case NEW_FALSE: //{{{
			CHECK_ARGS(0, "false");
			Tcl_IncrRefCount(*res = l->json_false);
			return TCL_OK;
			//}}}
		case NEW_NULL: //{{{
			CHECK_ARGS(0, "null");
			Tcl_IncrRefCount(*res = l->json_null);
			return TCL_OK;
			//}}}
		case NEW_BOOL: //{{{
			{
				int b;

				CHECK_ARGS(1, "boolean val");
				TEST_OK(Tcl_GetBooleanFromObj(interp, objv[1], &b));
				Tcl_IncrRefCount(*res = b ? l->json_true : l->json_false);
			}
			return TCL_OK;
			//}}}
		case NEW_JSON: //{{{
			CHECK_ARGS(1, "json val");
			TEST_OK(JSON_ForceJSON(interp, objv[1]));
			Tcl_IncrRefCount(*res = objv[1]);
			return TCL_OK;
			//}}}
		default:
			THROW_ERROR("Invalid new_type: ", Tcl_GetString(Tcl_NewIntObj(new_type)));
	}

	if (retval == TCL_OK) {
		Tcl_IncrRefCount(*res = Tcl_GetObjResult(interp));
		Tcl_ResetResult(interp);
	}
	return retval;
}

//}}}
static int jsonNRObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	int subcommand;
	static const char *subcommands[] = {
		"parse",		// DEPRECATED
		"normalize",
		"extract",
		"type",
		"length",
		"keys",
		"exists",
		"get",

		"set",
		"unset",
		"new",			// DEPRECATED
		"fmt",			// DEPRECATED
		"isnull",
		"template",
		"template_string",
		"foreach",
		"lmap",
		"amap",
		"omap",
		"pretty",
		"valid",
		"debug",
//		"merge",

		// Create json types
		"string",
		"number",
		"boolean",
		"object",
		"array",

		"decode",

		// Debugging
		"free_cache",
		"nop",
		"_leak_obj",
		"_leak_info",
		"template_actions",
		(char*)NULL
	};
	enum {
		M_PARSE,
		M_NORMALIZE,
		M_EXTRACT,
		M_TYPE,
		M_LENGTH,
		M_KEYS,
		M_EXISTS,
		M_GET,

		M_SET,
		M_UNSET,
		M_NEW,
		M_FMT,
		M_ISNULL,
		M_TEMPLATE,
		M_TEMPLATE_STRING,
		M_FOREACH,
		M_LMAP,
		M_AMAP,
		M_OMAP,
		M_PRETTY,
		M_VALID,
		M_DEBUG,
//		M_MERGE,

		M_STRING,
		M_NUMBER,
		M_BOOLEAN,
		M_OBJECT,
		M_ARRAY,
		M_DECODE,
		// Debugging
		M_FREE_CACHE,
		M_NOP,
		M_LEAK_OBJ,
		M_LEAK_INFO,
		M_TEMPLATE_ACTIONS
	};

	if (objc < 2) {

		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
		return TCL_ERROR;
	}





	TEST_OK(Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand", TCL_EXACT, &subcommand));







	switch (subcommand) {
		case M_PARSE:		return jsonParse(cdata, interp, objc-1, objv+1);
		case M_NORMALIZE:	return jsonNormalize(cdata, interp, objc-1, objv+1);







		case M_TYPE:		return jsonType(cdata, interp, objc-1, objv+1);

		case M_LENGTH:		return jsonLength(cdata, interp, objc-1, objv+1);
		case M_KEYS:		return jsonKeys(cdata, interp, objc-1, objv+1);
		case M_EXISTS:		return jsonExists(cdata, interp, objc-1, objv+1);

		case M_GET:			return jsonGet(cdata, interp, objc-1, objv+1);
		case M_EXTRACT:		return jsonExtract(cdata, interp, objc-1, objv+1);
		case M_SET:			return jsonSet(cdata, interp, objc-1, objv+1);



		case M_UNSET:		return jsonUnset(cdata, interp, objc-1, objv+1);
		case M_FMT:

		case M_NEW:			return jsonNew(cdata, interp, objc-1, objv+1);
		case M_STRING:		return jsonString(cdata, interp, objc-1, objv+1);
		case M_NUMBER:		return jsonNumber(cdata, interp, objc-1, objv+1);
		case M_BOOLEAN:		return jsonBoolean(cdata, interp, objc-1, objv+1);
		case M_OBJECT:		return jsonObject(cdata, interp, objc-1, objv+1);
		case M_ARRAY:		return jsonArray(cdata, interp, objc-1, objv+1);

		case M_DECODE:		return jsonDecode(cdata, interp, objc-1, objv+1);
		case M_ISNULL:		return jsonIsNull(cdata, interp, objc-1, objv+1);

		case M_TEMPLATE:	return jsonTemplate(cdata, interp, objc-1, objv+1);
		case M_TEMPLATE_STRING:	return jsonTemplateString(cdata, interp, objc-1, objv+1);
		case M_FOREACH:		return jsonForeach(cdata, interp, objc-1, objv+1);
		case M_LMAP:		return jsonLmap(cdata, interp, objc-1, objv+1);
		case M_AMAP:		return jsonAmap(cdata, interp, objc-1, objv+1);
		case M_OMAP:		return jsonOmap(cdata, interp, objc-1, objv+1);
		case M_FREE_CACHE:	return jsonFreeCache(cdata, interp, objc-1, objv+1);
		case M_NOP:			return jsonNop(cdata, interp, objc-1, objv+1);


		case M_PRETTY:		return jsonPretty(cdata, interp, objc-1, objv+1);
		case M_VALID:		return jsonValid(cdata, interp, objc-1, objv+1);
		case M_DEBUG:		return jsonDebug(cdata, interp, objc-1, objv+1);
	//	case M_MERGE:		return jsonMerge(cdata, interp, objc-1, objv+1);

		case M_TEMPLATE_ACTIONS:	return jsonTemplateActions(cdata, interp, objc-1, objv+1);
		case M_LEAK_OBJ:	Tcl_NewObj(); break;

		case M_LEAK_INFO:
			{
				unsigned long	addr;
				Tcl_Obj*		obj = NULL;
				const char*		s;
				int				len;

				CHECK_ARGS(2, "addr");


				TEST_OK(Tcl_GetLongFromObj(interp, objv[2], (long*)&addr));



				obj = (Tcl_Obj*)addr;


				s = Tcl_GetStringFromObj(obj, &len);
				fprintf(stderr, "\tLeaked obj: %p[%d] len %d: \"%s\"\n", obj, obj->refCount, len, len < 256 ? s : "<too long>");


				break;





			}









		default:
			// Should be impossible to reach
			THROW_ERROR("Invalid subcommand");
	}





	return TCL_OK;
}




//}}}

static int jsonObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{



	return Tcl_NRCallObjProc(interp, jsonNRObj, cdata, objc, objv);
}





























//}}}



void free_interp_cx(ClientData cdata, Tcl_Interp* interp) //{{{
{





	struct interp_cx* l = cdata;
	int					i;






















	l->interp = NULL;


	release_tclobj(&l->tcl_true);
	release_tclobj(&l->tcl_false);
	release_tclobj(&l->tcl_one);
	release_tclobj(&l->tcl_zero);


	Tcl_DecrRefCount(l->tcl_empty);
	release_tclobj(&l->tcl_empty);


	release_tclobj(&l->json_true);
	release_tclobj(&l->json_false);
	release_tclobj(&l->json_null);
	release_tclobj(&l->json_empty_string);
	release_tclobj(&l->tcl_empty_dict);
	release_tclobj(&l->tcl_empty_list);




	for (i=0; i<2; i++)
		release_tclobj(&l->force_num_cmd[i]);




	for (i=0; i<JSON_TYPE_MAX; i++) {
		release_tclobj(&l->type_int[i]);
		release_tclobj(&l->type[i]);
	}









	for (i=0; i<TEMPLATE_ACTIONS_END; i++)
		release_tclobj(&l->action[i]);

#if DEDUP
	free_cache(l);
	Tcl_DeleteHashTable(&l->kc);
#endif


	release_tclobj(&l->apply);
	release_tclobj(&l->decode_bytes);


















	free(l); l = NULL;

}


















//}}}

static int checkmem(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{
{
	int					retcode = TCL_OK;
	FILE*				h_before = NULL;
	FILE*				h_after = NULL;
	char				linebuf[1024];
	char*				line = NULL;































	Tcl_HashTable		seen;
	Tcl_Obj*			res = NULL;

#define TEMP_TEMPLATE	"/tmp/rl_json_XXXXXX"
	char				temp[sizeof(TEMP_TEMPLATE)];
	int					fd;
#if DEDUP
	struct interp_cx*	l = (struct interp_cx*)cdata;
#endif


	CHECK_ARGS(2, "cmd newactive");






	memcpy(temp, TEMP_TEMPLATE, sizeof(TEMP_TEMPLATE));
	fd = mkstemp(temp);
	h_before = fdopen(fd, "r");




#if DEDUP
	free_cache(l);
#endif
	Tcl_DumpActiveMemory(temp);
	if (unlink(temp) != 0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error removing before tmp file: %s", Tcl_ErrnoMsg(Tcl_GetErrno())));
		retcode = TCL_ERROR;
		goto finally;
	}
























	retcode = Tcl_EvalEx(interp, Tcl_GetString(objv[1]), -1, TCL_EVAL_DIRECT);
#if DEDUP
	free_cache(l);
#endif
	memcpy(temp, TEMP_TEMPLATE, sizeof(TEMP_TEMPLATE));
	fd = mkstemp(temp);
	h_after = fdopen(fd, "r");
	Tcl_DumpActiveMemory(temp);
	if (unlink(temp) != 0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error removing after tmp file: %s", Tcl_ErrnoMsg(Tcl_GetErrno())));
		retcode = TCL_ERROR;
		goto finally;
	}




	Tcl_InitHashTable(&seen, TCL_STRING_KEYS);
	while (!feof(h_before)) {
		int		new, len;






		line = fgets(linebuf, 1024, h_before);
		if (line == NULL || strstr(line, " @ ./") == NULL) continue;
		len = strnlen(line, 1024);
		if (line[len-1] == '\n') len--;
		Tcl_CreateHashEntry(&seen, line, &new);
	}









	fclose(h_before); h_before = NULL;


	replace_tclobj(&res, Tcl_NewListObj(0, NULL));

	while (!feof(h_after)) {
		int		new, len;






		line = fgets(linebuf, 1024, h_after);
		if (line == NULL || strstr(line, " @ ./") == NULL) continue;
		len = strnlen(line, 1024);
		if (line[len-1] == '\n') len--;
		Tcl_CreateHashEntry(&seen, line, &new);
		if (new) {

			retcode = Tcl_ListObjAppendElement(interp, res, Tcl_NewStringObj(line, len));
			if (retcode != TCL_OK) break;
		}
	}
	fclose(h_after); h_after = NULL;



	if (retcode == TCL_OK)
		if (Tcl_ObjSetVar2(interp, objv[2], NULL, res, TCL_LEAVE_ERR_MSG) == NULL)
			retcode = TCL_ERROR;









finally:
	release_tclobj(&res);
	if (h_before) {fclose(h_before); h_before = NULL;}
	if (h_after)  {fclose(h_after);  h_after = NULL;}
	Tcl_DeleteHashTable(&seen);

	return retcode;
}

//}}}


#ifdef __cplusplus
extern "C" {







































































#endif  /* __cplusplus */
DLLEXPORT int Rl_json_Init(Tcl_Interp* interp) //{{{
{
	int					i;
	struct interp_cx*	l = NULL;

#ifdef USE_TCL_STUBS
	if (Tcl_InitStubs(interp, "8.6", 0) == NULL)
		return TCL_ERROR;
#endif // USE_TCL_STUBS

	TEST_OK(init_types(interp));

	l = (struct interp_cx*)malloc(sizeof *l);
	l->interp = interp;
	Tcl_IncrRefCount(l->tcl_true   = Tcl_NewStringObj("1", 1));
	Tcl_IncrRefCount(l->tcl_false  = Tcl_NewStringObj("0", 1));

	Tcl_IncrRefCount(l->tcl_empty  = Tcl_NewStringObj("", 0));
	// Ensure the empty string rep is considered "shared"
	Tcl_IncrRefCount(l->tcl_empty);

	Tcl_IncrRefCount(l->tcl_one    = Tcl_NewIntObj(1));
	Tcl_IncrRefCount(l->tcl_zero   = Tcl_NewIntObj(0));
	Tcl_IncrRefCount(l->json_true  = JSON_NewJvalObj(JSON_BOOL, l->tcl_true));
	Tcl_IncrRefCount(l->json_false = JSON_NewJvalObj(JSON_BOOL, l->tcl_false));
	Tcl_IncrRefCount(l->json_null  = JSON_NewJvalObj(JSON_NULL, NULL));
	Tcl_IncrRefCount(l->json_empty_string  = JSON_NewJvalObj(JSON_STRING, l->tcl_empty));
	Tcl_IncrRefCount(l->tcl_empty_dict  = Tcl_NewDictObj());
	Tcl_IncrRefCount(l->tcl_empty_list  = Tcl_NewListObj(0, NULL));

	// Hack to ensure a value is a number (could be any of the Tcl number types: double, int, wide, bignum)
	Tcl_IncrRefCount(l->force_num_cmd[0] = Tcl_NewStringObj("::tcl::mathop::+", -1));
	Tcl_IncrRefCount(l->force_num_cmd[1] = Tcl_NewIntObj(0));
	l->force_num_cmd[2] = NULL;

	// Const type name objects
	for (i=0; i<JSON_TYPE_MAX; i++) {
		Tcl_IncrRefCount(l->type_int[i] = Tcl_NewStringObj(type_names_int[i], -1));
		Tcl_IncrRefCount(l->type[i]     = Tcl_NewStringObj(type_names[i], -1));










	}

	// Const template action objects
	for (i=0; i<TEMPLATE_ACTIONS_END; i++)
		Tcl_IncrRefCount(l->action[i] = Tcl_NewStringObj(action_opcode_str[i], -1));

#if DEDUP

	Tcl_InitHashTable(&l->kc, TCL_STRING_KEYS);
	l->kc_count = 0;
	memset(&l->freemap, 0xFF, sizeof(l->freemap));
#endif

	l->typeDict   = Tcl_GetObjType("dict");
	l->typeInt    = Tcl_GetObjType("int");
	l->typeDouble = Tcl_GetObjType("double");
	l->typeBignum = Tcl_GetObjType("bignum");
	if (l->typeDict == NULL) THROW_ERROR("Can't retrieve objType for dict");
	if (l->typeInt == NULL) THROW_ERROR("Can't retrieve objType for int");
	if (l->typeDouble == NULL) THROW_ERROR("Can't retrieve objType for double");
	//if (l->typeBignum == NULL) THROW_ERROR("Can't retrieve objType for bignum");

	Tcl_IncrRefCount(l->apply = Tcl_NewStringObj("apply", 5));
	Tcl_IncrRefCount(l->decode_bytes = Tcl_NewStringObj( // Tcl lambda to decode raw bytes to a unicode string {{{
		"{bytes {encoding auto}} {\n"
		//"		puts \"Decoding using $encoding: [regexp -all -inline .. [binary encode hex $bytes]]\"\n"
		"	set decode_utf16 {{bytes encoding} {\n"
		//"		puts \"Decoding using $encoding: [regexp -all -inline .. [binary encode hex $bytes]]\"\n"
		"		set process_utf16_word {char {\n"
		"			upvar 1 w1 w1  w2 w2\n"
		"\n"
		"			set t	[expr {$char & 0b1111110000000000}]\n"
		"			if {$t == 0b1101100000000000} { # high surrogate\n"
		"				set w1	[expr {$char & 0b0000001111111111}]\n"
		"			} elseif {$t == 0b1101110000000000} { # low surrogate\n"
		"				set w2	[expr {$char & 0b0000001111111111}]\n"
		"			} else {\n"
		//"puts \"emitting [format %x $char]: ([format %c $char])\"\n"
		"				return [format %c $char]\n"
		"			}\n"
		"\n"
		"			if {[info exists w1] && [info exists w2]} {\n"
		"				set char	[expr {($w1 << 10) | $w2 | 0x10000}]\n"
		//"puts [format {W1: %04x, W2: %04x, char: %x} $w1 $w2 $char]\n"
		"				unset -nocomplain w1 w2\n"
		//"puts \"emitting [format %x $char]: ([format %c $char])\"\n"
		"				return [format %c $char]\n"
		"			}\n"
		"\n"
		"			return\n"
		"		}}\n"
		"\n"
		"		if {[string range $encoding 0 1] eq {x }} {\n"
		"			set encoding [string range $encoding 2 end]\n"	// Hack to allow the test suite to force manual decoding
		"		} elseif {$encoding in [encoding names]} {\n"
		"			return [encoding convertfrom $encoding $bytes]\n"
		"		}\n"
		//"		puts \"Manual $encoding decode\"\n"
		"		binary scan $bytes [expr {$encoding eq {utf-16le} ? {su*} : {Su*}}] chars\n"
		//"		puts \"chars:\n\t[join [lmap e $chars {format %04x $e}] \\n\\t]\"\n"
		"		set res	{}\n"
		"		foreach char $chars {\n"
		"			append res [apply $process_utf16_word $char]\n"
		"		}\n"
		"		set res\n"
		"	}}\n"
		"\n"
		"	set decode_utf32 {{bytes encoding} {\n"
		//"		puts \"Decoding using $encoding: [regexp -all -inline .. [binary encode hex $bytes]]\"\n"
		"		if {[string range $encoding 0 1] eq {x }} {\n"
		"			set encoding [string range $encoding 2 end]\n"	// Hack to allow the test suite to force manual decoding
		"		} elseif {$encoding in [encoding names]} {\n"
		"			puts \"$encoding is in \\[encoding names\\], using native\"\n"
		"			return [encoding convertfrom $encoding $bytes]\n"
		"		}\n"
		//"		puts \"Manual $encoding decode\"\n"
		"		binary scan $bytes [expr {$encoding eq {utf-32le} ? {iu*} : {Iu*}}] chars\n"
		//"		puts \"chars:\n\t[join [lmap e $chars {format %04x $e}] \\n\\t]\"\n"
		"		set res	{}\n"
		"		foreach char $chars {\n"
		"			append res [format %c $char]\n"
		"		}\n"
		"		set res\n"
		"	}}\n"
		"\n"
		"	if {$encoding eq {auto}} {\n"
		"		set bom	[binary encode hex [string range $bytes 0 3]]\n"
		"		switch -glob -- $bom {\n"
		"			0000feff { set encoding utf-32be }\n"
		"			fffe0000 { set encoding utf-32le }\n"
		"			feff*    { set encoding utf-16be }\n"
		"			fffe*    { set encoding utf-16le }\n"
		"\n"
		"			efbbbf -\n"
		"			default { # No BOM, or UTF-8 BOM\n"
		"				set encoding utf-8\n"
		"			}\n"
		"		}\n"
		"	}\n"
		"\n"
		"	switch -- $encoding {\n"
		"		utf-8 {\n"
		"			encoding convertfrom utf-8 $bytes\n"
		"		}\n"
		"\n"
		"		{x utf-16le} -\n"
		"		{x utf-16be} -\n"
		"		utf-16le -\n"
		"		utf-16be { apply $decode_utf16 $bytes $encoding }\n"
		"\n"
		"		{x utf-32le} -\n"
		"		{x utf-32be} -\n"
		"		utf-32le -\n"
		"		utf-32be { apply $decode_utf32 $bytes $encoding }\n"
		"\n"
		"		default {\n"
		"			error \"Unsupported encoding \\\"$encoding\\\"\"\n"
		"		}\n"
		"	}\n"
		"}\n" , -1));
	//}}}

	Tcl_SetAssocData(interp, "rl_json", free_interp_cx, l);

	{
		Tcl_Namespace*	ns = NULL;
#if ENSEMBLE
		Tcl_Namespace*	ns_cmd = NULL;
		Tcl_Command		ens_cmd = NULL;
#endif

#define NS	"::rl_json"

		ns = Tcl_CreateNamespace(interp, NS, NULL, NULL);
		TEST_OK(Tcl_Export(interp, ns, "*", 0));

#if ENSEMBLE
#define ENS	NS "::json::"
		ns_cmd = Tcl_CreateNamespace(interp, NS "::json", NULL, NULL);
		ens_cmd = Tcl_CreateEnsemble(interp, NS "::json", ns_cmd, 0);
#if 1
		{
			Tcl_Obj*		subcommands = Tcl_NewListObj(0, NULL);

			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("parse",      -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("normalize",  -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("type",       -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("length",     -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("keys",       -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("exists",     -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("get",        -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("extract",    -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("set",        -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("unset",      -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("fmt",        -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("new",        -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("string",     -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("number",     -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("boolean",    -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("object",     -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("array",      -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("decode",     -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("isnull",     -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("template",   -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("_template",  -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("foreach",    -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("lmap",       -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("amap",       -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("omap",       -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("free_cache", -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("nop",        -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("pretty",     -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("valid",      -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("debug",      -1));
			Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("template_actions", -1));
			Tcl_SetEnsembleSubcommandList(interp, ens_cmd, subcommands);
		}
#endif
		TEST_OK(Tcl_Export(interp, ns_cmd, "*", 0));

		Tcl_CreateObjCommand(interp, ENS "parse",      jsonParse, l, NULL);		// Deprecated
		Tcl_CreateObjCommand(interp, ENS "normalize",  jsonNormalize, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "type",       jsonType, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "length",     jsonLength, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "keys",       jsonKeys, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "exists",     jsonExists, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "get",        jsonGet, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "extract",    jsonExtract, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "set",        jsonSet, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "unset",      jsonUnset, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "fmt",        jsonNew, l, NULL);		// Deprecated
		Tcl_CreateObjCommand(interp, ENS "new",        jsonNew, l, NULL);		// Deprecated
		Tcl_CreateObjCommand(interp, ENS "string",     jsonString, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "number",     jsonNumber, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "boolean",    jsonBoolean, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "object",     jsonObject, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "array",      jsonArray, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "decode",     jsonDecode, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "isnull",     jsonIsNull, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "template",   jsonTemplate, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "template_string", jsonTemplateString, l, NULL);
		Tcl_NRCreateCommand(interp,  ENS "foreach",    jsonForeach, jsonNRForeach, l, NULL);
		Tcl_NRCreateCommand(interp,  ENS "lmap",       jsonLmap,    jsonNRLmap,    l, NULL);
		Tcl_NRCreateCommand(interp,  ENS "amap",       jsonAmap,    jsonNRAmap,    l, NULL);
		Tcl_NRCreateCommand(interp,  ENS "omap",       jsonOmap,    jsonNROmap,    l, NULL);
		Tcl_CreateObjCommand(interp, ENS "free_cache", jsonFreeCache, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "nop",        jsonNop, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "pretty",     jsonPretty, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "valid",      jsonValid, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "debug",      jsonDebug, l, NULL);
		Tcl_CreateObjCommand(interp, ENS "template_actions",      jsonTemplateActions, l, NULL);
		//Tcl_CreateObjCommand(interp, ENS "merge",      jsonMerge, l, NULL);
#else
		Tcl_NRCreateCommand(interp, "::rl_json::json", jsonObj, jsonNRObj, l, NULL);

#endif

		Tcl_CreateObjCommand(interp, NS "::checkmem", checkmem, l, NULL);
	}

	TEST_OK(Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION));

	return TCL_OK;
}

//}}}

DLLEXPORT int Rl_json_SafeInit(Tcl_Interp* interp) //{{{
{
	// No unsafe features
	return Rl_json_Init(interp);
}

//}}}
DLLEXPORT int Rl_json_Unload(Tcl_Interp* interp, int flags) //{{{
{
	Tcl_Namespace*		ns;

	switch (flags) {
		case TCL_UNLOAD_DETACH_FROM_INTERPRETER:
			//fprintf(stderr, "rl_json detach from interpreter\n");
			Tcl_DeleteAssocData(interp, "rl_json");
			ns = Tcl_FindNamespace(interp, "::rl_json", NULL, TCL_GLOBAL_ONLY);
			if (ns) {
				Tcl_DeleteNamespace(ns);
				ns = NULL;
			}
			break;
		case TCL_UNLOAD_DETACH_FROM_PROCESS:
			//fprintf(stderr, "rl_json detach from process\n");
			Tcl_DeleteAssocData(interp, "rl_json");
			ns = Tcl_FindNamespace(interp, "::rl_json", NULL, TCL_GLOBAL_ONLY);
			if (ns) {
				Tcl_DeleteNamespace(ns);
				ns = NULL;
			}
			break;
		default:
			THROW_ERROR("Unhandled flags");
	}

	return TCL_OK;
}

//}}}
DLLEXPORT int Rl_json_SafeUnload(Tcl_Interp* interp, int flags) //{{{
{
	// No unsafe features
	return Rl_json_Unload(interp, flags);
}

//}}}

#ifdef __cplusplus
}
#endif  /* __cplusplus */

/* Local Variables: */
/* tab-width: 4 */
/* c-basic-offset: 4 */
/* End: */
// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4

Changes to jni/rl_json/generic/rl_json.decls.

1
2

3
4

5
6
7

8
9





































































10
11
12










13
14























library rl_json
interface rl_json

declare 0 generic {
	Tcl_Obj *JSON_NewJvalObj(int type, Tcl_Obj *val)

}
declare 1 generic {
	int JSON_GetJvalFromObj(Tcl_Interp *interp, Tcl_Obj *obj, int *type, Tcl_Obj **val)

}
declare 2 generic {





































































	int JSON_Set(Tcl_Interp* interp, Tcl_Obj* srcvar, Tcl_Obj *const pathv[], int pathc, Tcl_Obj* replacement)
}
declare 3 generic {










	int JSON_Template(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* dict, Tcl_Obj** res)
}

























>

<
>


<
>


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

|
>
>
>
>
>
>
>
>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
library rl_json
interface rl_json

declare 0 generic {

    Tcl_Obj* JSON_NewJSONObj(Tcl_Interp* interp, Tcl_Obj* from)
}
declare 1 generic {

	int JSON_NewJStringObj(Tcl_Interp* interp, Tcl_Obj* string, Tcl_Obj** new)
}
declare 2 generic {
	int JSON_NewJNumberObj(Tcl_Interp* interp, Tcl_Obj* number, Tcl_Obj** new)
}
declare 3 generic {
	int JSON_NewJBooleanObj(Tcl_Interp* interp, Tcl_Obj* boolean, Tcl_Obj** new)
}
declare 4 generic {
	int JSON_NewJNullObj(Tcl_Interp* interp, Tcl_Obj** new)
}
declare 5 generic {
	int JSON_NewJObjectObj(Tcl_Interp* interp, Tcl_Obj** new)
}
declare 6 generic {
	int JSON_NewJArrayObj(Tcl_Interp*, int objc, Tcl_Obj* objv[], Tcl_Obj** new)
}
# type is one of the DYN types, key is the variable name the template is replaced with
declare 7 generic {
	int JSON_NewTemplateObj(Tcl_Interp* interp, enum json_types type, Tcl_Obj* key, Tcl_Obj** new)
}

declare 8 generic {
	int JSON_ForceJSON(Tcl_Interp* interp, Tcl_Obj* obj)
}
declare 9 generic {
	enum json_types JSON_GetJSONType(Tcl_Obj* obj)
}
declare 10 generic {
	int JSON_GetObjFromJStringObj(Tcl_Interp* interp, Tcl_Obj* jstringObj, Tcl_Obj** stringObj)
}
# Return a native Tcl number type object
declare 11 generic {
	int JSON_GetObjFromJNumberObj(Tcl_Interp* interp, Tcl_Obj* jnumberObj, Tcl_Obj** numberObj)
}
# Return a native Tcl number type object
declare 12 generic {
	int JSON_GetObjFromJBooleanObj(Tcl_Interp* interp, Tcl_Obj* jbooleanObj, Tcl_Obj** booleanObj)
}

declare 13 generic {
	int JSON_JArrayObjAppendElement(Tcl_Interp* interp, Tcl_Obj* arrayObj, Tcl_Obj* elem)
}
declare 14 generic {
	int JSON_JArrayObjAppendList(Tcl_Interp* interp, Tcl_Obj* arrayObj, Tcl_Obj* elems /* a JArrayObj or ListObj */ )
}
declare 15 generic {
	int JSON_SetJArrayObj(Tcl_Interp* interp, Tcl_Obj* obj, int objc, Tcl_Obj* objv[])
}
declare 16 generic {
	int JSON_JArrayObjGetElements(Tcl_Interp* interp, Tcl_Obj* arrayObj, int* objc, Tcl_Obj*** objv)
}
declare 17 generic {
	int JSON_JArrayObjIndex(Tcl_Interp* interp, Tcl_Obj* arrayObj, int index, Tcl_Obj** elem)
}
declare 18 generic {
	int JSON_JArrayObjReplace(Tcl_Interp* interp, Tcl_Obj* arrayObj, int first, int count, int objc, Tcl_Obj* objv[])
}

# TODO: JObject interface, similar to DictObj
#

declare 19 generic {
	int JSON_Get(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** res)
}
declare 20 generic {
	int JSON_Extract(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** res)
}
declare 21 generic {
	int JSON_Exists(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* exists)
}
declare 22 generic {
	int JSON_Set(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj* replacement)
}
declare 23 generic {
	int JSON_Unset(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path)
}

declare 24 generic {
	int JSON_Normalize(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** normalized)
}
declare 25 generic {
	int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, Tcl_Obj** prettyString)
}
declare 26 generic {
	int JSON_Template(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* dict, Tcl_Obj** res)
}

declare 27 generic {
	int JSON_IsNULL(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* isnull)
}
declare 28 generic {
	int JSON_Type(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, enum json_types* type)
}
declare 29 generic {
	int JSON_Length(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* length)
}
declare 30 generic {
	int JSON_Keys(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** keyslist)
}
declare 31 generic {
	int JSON_Decode(Tcl_Interp* interp, Tcl_Obj* bytes, Tcl_Obj* encoding, Tcl_Obj** decodedstring)
}

declare 32 generic {
	int JSON_Foreach(Tcl_Interp* interp, Tcl_Obj* iterators, int* body, enum collecting_mode collect, Tcl_Obj** res, ClientData cdata)
}
declare 33 generic {
	int JSON_Valid(Tcl_Interp* interp, Tcl_Obj* json, int* valid, enum extensions extensions, struct parse_error* details)
}

Changes to jni/rl_json/generic/rl_json.h.

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
#ifndef _JSON_MAIN_H
#define _JSON_MAIN_H

#define _GNU_SOURCE

#include <tcl.h>
#include "tclstuff.h"
#include <string.h>
#include <errno.h>
#include <stdlib.h>
#include <math.h>
#include <stddef.h>
#include <stdint.h>
#include "parser.h"

#define STRING_DEDUP_MAX	16












#ifdef __builtin_expect
#	define likely(exp)   __builtin_expect(!!(exp), 1)
#	define unlikely(exp) __builtin_expect(!!(exp), 0)
#else
#	define likely(exp)   (exp)
#	define unlikely(exp) (exp)
#endif







extern Tcl_ObjType json_type;
extern const char* type_names_dbg[];

struct parse_context {
	struct parse_context*	last;		// Only valid for the first entry
	struct parse_context*	prev;





	Tcl_Obj*	val;
	Tcl_Obj*	hold_key;
	size_t		char_ofs;
	int			container;
	int			closed;
};



struct foreach_iterator {
	int				data_c;
	Tcl_Obj**		data_v;
	int				data_i;
	Tcl_Obj*		varlist;
	int				var_c;
	Tcl_Obj**		var_v;
	int				is_array;

	// Dict search related state - when iterating over JSON objects
	Tcl_DictSearch	search;
	Tcl_Obj*		k;
	Tcl_Obj*		v;
	int				done;
};

struct foreach_state {
	unsigned int				loop_num;
	unsigned int				max_loops;
	unsigned int				iterators;
	struct foreach_iterator*	it;
	Tcl_Obj*					script;
	Tcl_Obj*					res;




};

void append_to_cx(struct parse_context *cx, Tcl_Obj *val);



Tcl_Obj* new_stringobj_dedup(struct interp_cx *l, const char *bytes, int length);


// Taken from tclInt.h:
#if !defined(INT2PTR) && !defined(PTR2INT)
#   if defined(HAVE_INTPTR_T) || defined(intptr_t)
#       define INT2PTR(p) ((void *)(intptr_t)(p))
#       define PTR2INT(p) ((int)(intptr_t)(p))
#   else
#       define INT2PTR(p) ((void *)(p))
#       define PTR2INT(p) ((int)(p))
#   endif



#endif
#if !defined(UINT2PTR) && !defined(PTR2UINT)
#   if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
#       define UINT2PTR(p) ((void *)(uintptr_t)(p))
#       define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
#   else
#       define UINT2PTR(p) ((void *)(p))
#       define PTR2UINT(p) ((unsigned int)(p))
#   endif
#endif

#ifdef BUILD_rl_json
#   undef TCL_STORAGE_CLASS
#   define TCL_STORAGE_CLASS DLLEXPORT
#endif


#include "rl_jsonDecls.h"

#endif



<
<

<
<
<
<
<
<
<
<

<
>
>
>
>

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

>
>
>
>
>
>
|
<

<
<
<
>
>

>
>
|
|
|
<
<


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


<
<
<
<
<
<
<
>
>
>
>


<
>
>

<
<
<
<
<
<
<
<
<
<
<
<
>
>
>

<
<
<
<
<
<
<
<
<

<
<
<
<
>

<
<

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
#ifndef _JSON_MAIN_H
#define _JSON_MAIN_H



#include <tcl.h>










#ifdef BUILD_rl_json
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
#endif /* BUILD_rl_json */

enum json_types {		// Order must be preserved
	JSON_UNDEF = 0,
	JSON_OBJECT,
	JSON_ARRAY,
	JSON_STRING,
	JSON_NUMBER,
	JSON_BOOL,
	JSON_NULL,







	/* Dynamic types - placeholders for dynamic values in templates */
	JSON_DYN_STRING,	// ~S:
	JSON_DYN_NUMBER,	// ~N:
	JSON_DYN_BOOL,		// ~B:
	JSON_DYN_JSON,		// ~J:
	JSON_DYN_TEMPLATE,	// ~T:
	JSON_DYN_LITERAL,	// ~L:	literal escape - used to quote literal values that start with the above sequences





	JSON_TYPE_MAX		// Not an actual type - records the number of types
};

enum collecting_mode {
	COLLECT_NONE,
	COLLECT_LIST,
	COLLECT_ARRAY,
	COLLECT_OBJECT


};

enum extensions {
	EXT_NONE     = 0,
	EXT_COMMENTS = (1 << 0)













};








struct parse_error {
	const char*		errmsg;
	const char*		doc;
	size_t			char_ofs;	// Offset in chars, not bytes
};


// Stubs exported API
#include "rl_jsonDecls.h"













EXTERN CONST char* Rl_jsonInitStubs _ANSI_ARGS_((Tcl_Interp* interp, CONST char* version, int exact));
#ifndef USE_TCL_STUBS
#	define Rl_jsonInitStubs(interp, version, exact) Tcl_PkgRequire(interp, "rl_json", version, exact)
#endif














EXTERN int Rl_jsonInit _ANSI_ARGS_((Tcl_Interp* interp));



#endif

Changes to jni/rl_json/generic/rl_jsonDecls.h.

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
#endif

/*
 * Exported function declarations:
 */

/* 0 */
EXTERN Tcl_Obj *	JSON_NewJvalObj(int type, Tcl_Obj *val);
/* 1 */
EXTERN int		JSON_GetJvalFromObj(Tcl_Interp *interp, Tcl_Obj *obj,
				int *type, Tcl_Obj **val);
/* 2 */

























































EXTERN int		JSON_Set(Tcl_Interp*interp, Tcl_Obj*srcvar,
				Tcl_Obj *const pathv[], int pathc,
				Tcl_Obj*replacement);
/* 3 */









EXTERN int		JSON_Template(Tcl_Interp*interp, Tcl_Obj*template,
				Tcl_Obj*dict, Tcl_Obj**res);
























typedef struct Rl_jsonStubs {
    int magic;
    void *hooks;

    Tcl_Obj * (*jSON_NewJvalObj) (int type, Tcl_Obj *val); /* 0 */
    int (*jSON_GetJvalFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, int *type, Tcl_Obj **val); /* 1 */






















    int (*jSON_Set) (Tcl_Interp*interp, Tcl_Obj*srcvar, Tcl_Obj *const pathv[], int pathc, Tcl_Obj*replacement); /* 2 */



    int (*jSON_Template) (Tcl_Interp*interp, Tcl_Obj*template, Tcl_Obj*dict, Tcl_Obj**res); /* 3 */







} Rl_jsonStubs;

extern const Rl_jsonStubs *rl_jsonStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................

#if defined(USE_RL_JSON_STUBS)

/*
 * Inline function declarations:
 */

#define JSON_NewJvalObj \
	(rl_jsonStubsPtr->jSON_NewJvalObj) /* 0 */



































#define JSON_GetJvalFromObj \
	(rl_jsonStubsPtr->jSON_GetJvalFromObj) /* 1 */




#define JSON_Set \
	(rl_jsonStubsPtr->jSON_Set) /* 2 */






#define JSON_Template \
	(rl_jsonStubsPtr->jSON_Template) /* 3 */















#endif /* defined(USE_RL_JSON_STUBS) */

/* !END!: Do not edit above this line. */







|

|
|

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


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





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







 







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

|
>
>
>
>
>
>

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




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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
#endif

/*
 * Exported function declarations:
 */

/* 0 */
EXTERN Tcl_Obj*		JSON_NewJSONObj(Tcl_Interp*interp, Tcl_Obj*from);
/* 1 */
EXTERN int		JSON_NewJStringObj(Tcl_Interp*interp, Tcl_Obj*string,
				Tcl_Obj**new);
/* 2 */
EXTERN int		JSON_NewJNumberObj(Tcl_Interp*interp, Tcl_Obj*number,
				Tcl_Obj**new);
/* 3 */
EXTERN int		JSON_NewJBooleanObj(Tcl_Interp*interp,
				Tcl_Obj*boolean, Tcl_Obj**new);
/* 4 */
EXTERN int		JSON_NewJNullObj(Tcl_Interp*interp, Tcl_Obj**new);
/* 5 */
EXTERN int		JSON_NewJObjectObj(Tcl_Interp*interp, Tcl_Obj**new);
/* Slot 6 is reserved */
/* 7 */
EXTERN int		JSON_NewTemplateObj(Tcl_Interp*interp,
				enum json_types type, Tcl_Obj*key,
				Tcl_Obj**new);
/* 8 */
EXTERN int		JSON_ForceJSON(Tcl_Interp*interp, Tcl_Obj*obj);
/* 9 */
EXTERN enum json_types	JSON_GetJSONType(Tcl_Obj*obj);
/* 10 */
EXTERN int		JSON_GetObjFromJStringObj(Tcl_Interp*interp,
				Tcl_Obj*jstringObj, Tcl_Obj**stringObj);
/* 11 */
EXTERN int		JSON_GetObjFromJNumberObj(Tcl_Interp*interp,
				Tcl_Obj*jnumberObj, Tcl_Obj**numberObj);
/* 12 */
EXTERN int		JSON_GetObjFromJBooleanObj(Tcl_Interp*interp,
				Tcl_Obj*jbooleanObj, Tcl_Obj**booleanObj);
/* 13 */
EXTERN int		JSON_JArrayObjAppendElement(Tcl_Interp*interp,
				Tcl_Obj*arrayObj, Tcl_Obj*elem);
/* 14 */
EXTERN int		JSON_JArrayObjAppendList(Tcl_Interp*interp,
				Tcl_Obj*arrayObj,
				Tcl_Obj* elems /* a JArrayObj or ListObj */);
/* 15 */
EXTERN int		JSON_SetJArrayObj(Tcl_Interp*interp, Tcl_Obj*obj,
				int objc, Tcl_Obj*objv[]);
/* 16 */
EXTERN int		JSON_JArrayObjGetElements(Tcl_Interp*interp,
				Tcl_Obj*arrayObj, int*objc, Tcl_Obj***objv);
/* 17 */
EXTERN int		JSON_JArrayObjIndex(Tcl_Interp*interp,
				Tcl_Obj*arrayObj, int index, Tcl_Obj**elem);
/* 18 */
EXTERN int		JSON_JArrayObjReplace(Tcl_Interp*interp,
				Tcl_Obj*arrayObj, int first, int count,
				int objc, Tcl_Obj*objv[]);
/* 19 */
EXTERN int		JSON_Get(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*path, Tcl_Obj**res);
/* 20 */
EXTERN int		JSON_Extract(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*path, Tcl_Obj**res);
/* 21 */
EXTERN int		JSON_Exists(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*path, int*exists);
/* 22 */
EXTERN int		JSON_Set(Tcl_Interp*interp, Tcl_Obj*obj,

				Tcl_Obj*path, Tcl_Obj*replacement);
/* 23 */
EXTERN int		JSON_Unset(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*path);
/* 24 */
EXTERN int		JSON_Normalize(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj**normalized);
/* 25 */
EXTERN int		JSON_Pretty(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*indent, Tcl_Obj**prettyString);
/* 26 */
EXTERN int		JSON_Template(Tcl_Interp*interp, Tcl_Obj*template,
				Tcl_Obj*dict, Tcl_Obj**res);
/* 27 */
EXTERN int		JSON_IsNULL(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*path, int*isnull);
/* 28 */
EXTERN int		JSON_Type(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*path, enum json_types*type);
/* 29 */
EXTERN int		JSON_Length(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*path, int*length);
/* 30 */
EXTERN int		JSON_Keys(Tcl_Interp*interp, Tcl_Obj*obj,
				Tcl_Obj*path, Tcl_Obj**keyslist);
/* 31 */
EXTERN int		JSON_Decode(Tcl_Interp*interp, Tcl_Obj*bytes,
				Tcl_Obj*encoding, Tcl_Obj**decodedstring);
/* 32 */
EXTERN int		JSON_Foreach(Tcl_Interp*interp, Tcl_Obj*iterators,
				int*body, enum collecting_mode collect,
				Tcl_Obj**res, ClientData cdata);
/* 33 */
EXTERN int		JSON_Valid(Tcl_Interp*interp, Tcl_Obj*json,
				int*valid, enum extensions extensions,
				struct parse_error*details);

typedef struct Rl_jsonStubs {
    int magic;
    void *hooks;



    Tcl_Obj* (*jSON_NewJSONObj) (Tcl_Interp*interp, Tcl_Obj*from); /* 0 */
    int (*jSON_NewJStringObj) (Tcl_Interp*interp, Tcl_Obj*string, Tcl_Obj**new); /* 1 */
    int (*jSON_NewJNumberObj) (Tcl_Interp*interp, Tcl_Obj*number, Tcl_Obj**new); /* 2 */
    int (*jSON_NewJBooleanObj) (Tcl_Interp*interp, Tcl_Obj*boolean, Tcl_Obj**new); /* 3 */
    int (*jSON_NewJNullObj) (Tcl_Interp*interp, Tcl_Obj**new); /* 4 */
    int (*jSON_NewJObjectObj) (Tcl_Interp*interp, Tcl_Obj**new); /* 5 */
    void (*reserved6)(void);
    int (*jSON_NewTemplateObj) (Tcl_Interp*interp, enum json_types type, Tcl_Obj*key, Tcl_Obj**new); /* 7 */
    int (*jSON_ForceJSON) (Tcl_Interp*interp, Tcl_Obj*obj); /* 8 */
    enum json_types (*jSON_GetJSONType) (Tcl_Obj*obj); /* 9 */
    int (*jSON_GetObjFromJStringObj) (Tcl_Interp*interp, Tcl_Obj*jstringObj, Tcl_Obj**stringObj); /* 10 */
    int (*jSON_GetObjFromJNumberObj) (Tcl_Interp*interp, Tcl_Obj*jnumberObj, Tcl_Obj**numberObj); /* 11 */
    int (*jSON_GetObjFromJBooleanObj) (Tcl_Interp*interp, Tcl_Obj*jbooleanObj, Tcl_Obj**booleanObj); /* 12 */
    int (*jSON_JArrayObjAppendElement) (Tcl_Interp*interp, Tcl_Obj*arrayObj, Tcl_Obj*elem); /* 13 */
    int (*jSON_JArrayObjAppendList) (Tcl_Interp*interp, Tcl_Obj*arrayObj, Tcl_Obj* elems /* a JArrayObj or ListObj */); /* 14 */
    int (*jSON_SetJArrayObj) (Tcl_Interp*interp, Tcl_Obj*obj, int objc, Tcl_Obj*objv[]); /* 15 */
    int (*jSON_JArrayObjGetElements) (Tcl_Interp*interp, Tcl_Obj*arrayObj, int*objc, Tcl_Obj***objv); /* 16 */
    int (*jSON_JArrayObjIndex) (Tcl_Interp*interp, Tcl_Obj*arrayObj, int index, Tcl_Obj**elem); /* 17 */
    int (*jSON_JArrayObjReplace) (Tcl_Interp*interp, Tcl_Obj*arrayObj, int first, int count, int objc, Tcl_Obj*objv[]); /* 18 */
    int (*jSON_Get) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path, Tcl_Obj**res); /* 19 */
    int (*jSON_Extract) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path, Tcl_Obj**res); /* 20 */
    int (*jSON_Exists) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path, int*exists); /* 21 */
    int (*jSON_Set) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path, Tcl_Obj*replacement); /* 22 */
    int (*jSON_Unset) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path); /* 23 */
    int (*jSON_Normalize) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj**normalized); /* 24 */
    int (*jSON_Pretty) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*indent, Tcl_Obj**prettyString); /* 25 */
    int (*jSON_Template) (Tcl_Interp*interp, Tcl_Obj*template, Tcl_Obj*dict, Tcl_Obj**res); /* 26 */
    int (*jSON_IsNULL) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path, int*isnull); /* 27 */
    int (*jSON_Type) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path, enum json_types*type); /* 28 */
    int (*jSON_Length) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path, int*length); /* 29 */
    int (*jSON_Keys) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*path, Tcl_Obj**keyslist); /* 30 */
    int (*jSON_Decode) (Tcl_Interp*interp, Tcl_Obj*bytes, Tcl_Obj*encoding, Tcl_Obj**decodedstring); /* 31 */
    int (*jSON_Foreach) (Tcl_Interp*interp, Tcl_Obj*iterators, int*body, enum collecting_mode collect, Tcl_Obj**res, ClientData cdata); /* 32 */
    int (*jSON_Valid) (Tcl_Interp*interp, Tcl_Obj*json, int*valid, enum extensions extensions, struct parse_error*details); /* 33 */
} Rl_jsonStubs;

extern const Rl_jsonStubs *rl_jsonStubsPtr;

#ifdef __cplusplus
}
#endif
................................................................................

#if defined(USE_RL_JSON_STUBS)

/*
 * Inline function declarations:
 */

#define JSON_NewJSONObj \
	(rl_jsonStubsPtr->jSON_NewJSONObj) /* 0 */
#define JSON_NewJStringObj \
	(rl_jsonStubsPtr->jSON_NewJStringObj) /* 1 */
#define JSON_NewJNumberObj \
	(rl_jsonStubsPtr->jSON_NewJNumberObj) /* 2 */
#define JSON_NewJBooleanObj \
	(rl_jsonStubsPtr->jSON_NewJBooleanObj) /* 3 */
#define JSON_NewJNullObj \
	(rl_jsonStubsPtr->jSON_NewJNullObj) /* 4 */
#define JSON_NewJObjectObj \
	(rl_jsonStubsPtr->jSON_NewJObjectObj) /* 5 */
/* Slot 6 is reserved */
#define JSON_NewTemplateObj \
	(rl_jsonStubsPtr->jSON_NewTemplateObj) /* 7 */
#define JSON_ForceJSON \
	(rl_jsonStubsPtr->jSON_ForceJSON) /* 8 */
#define JSON_GetJSONType \
	(rl_jsonStubsPtr->jSON_GetJSONType) /* 9 */
#define JSON_GetObjFromJStringObj \
	(rl_jsonStubsPtr->jSON_GetObjFromJStringObj) /* 10 */
#define JSON_GetObjFromJNumberObj \
	(rl_jsonStubsPtr->jSON_GetObjFromJNumberObj) /* 11 */
#define JSON_GetObjFromJBooleanObj \
	(rl_jsonStubsPtr->jSON_GetObjFromJBooleanObj) /* 12 */
#define JSON_JArrayObjAppendElement \
	(rl_jsonStubsPtr->jSON_JArrayObjAppendElement) /* 13 */
#define JSON_JArrayObjAppendList \
	(rl_jsonStubsPtr->jSON_JArrayObjAppendList) /* 14 */
#define JSON_SetJArrayObj \
	(rl_jsonStubsPtr->jSON_SetJArrayObj) /* 15 */
#define JSON_JArrayObjGetElements \
	(rl_jsonStubsPtr->jSON_JArrayObjGetElements) /* 16 */
#define JSON_JArrayObjIndex \
	(rl_jsonStubsPtr->jSON_JArrayObjIndex) /* 17 */
#define JSON_JArrayObjReplace \
	(rl_jsonStubsPtr->jSON_JArrayObjReplace) /* 18 */
#define JSON_Get \
	(rl_jsonStubsPtr->jSON_Get) /* 19 */
#define JSON_Extract \
	(rl_jsonStubsPtr->jSON_Extract) /* 20 */
#define JSON_Exists \
	(rl_jsonStubsPtr->jSON_Exists) /* 21 */
#define JSON_Set \
	(rl_jsonStubsPtr->jSON_Set) /* 22 */
#define JSON_Unset \
	(rl_jsonStubsPtr->jSON_Unset) /* 23 */
#define JSON_Normalize \
	(rl_jsonStubsPtr->jSON_Normalize) /* 24 */
#define JSON_Pretty \
	(rl_jsonStubsPtr->jSON_Pretty) /* 25 */
#define JSON_Template \
	(rl_jsonStubsPtr->jSON_Template) /* 26 */
#define JSON_IsNULL \
	(rl_jsonStubsPtr->jSON_IsNULL) /* 27 */
#define JSON_Type \
	(rl_jsonStubsPtr->jSON_Type) /* 28 */
#define JSON_Length \
	(rl_jsonStubsPtr->jSON_Length) /* 29 */
#define JSON_Keys \
	(rl_jsonStubsPtr->jSON_Keys) /* 30 */
#define JSON_Decode \
	(rl_jsonStubsPtr->jSON_Decode) /* 31 */
#define JSON_Foreach \
	(rl_jsonStubsPtr->jSON_Foreach) /* 32 */
#define JSON_Valid \
	(rl_jsonStubsPtr->jSON_Valid) /* 33 */

#endif /* defined(USE_RL_JSON_STUBS) */

/* !END!: Do not edit above this line. */

Added jni/rl_json/generic/rl_jsonInt.h.















































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
#ifndef _RL_JSONINT
#define _RL_JSONINT

#include "rl_json.h"
#include "tclstuff.h"
#include <string.h>
#include <errno.h>
#include <stdlib.h>
#include <math.h>
#include <stddef.h>
#include <stdint.h>
#include <unistd.h>
#include <tclTomMath.h>
#include "tip445.h"

#define CX_STACK_SIZE	6

#ifdef __builtin_expect
#	define likely(exp)   __builtin_expect(!!(exp), 1)
#	define unlikely(exp) __builtin_expect(!!(exp), 0)
#else
#	define likely(exp)   (exp)
#	define unlikely(exp) (exp)
#endif

enum parse_mode {
	PARSE,
	VALIDATE
};

struct parse_context {
	struct parse_context*	last;		// Only valid for the first entry
	struct parse_context*	prev;

	Tcl_Obj*			val;
	Tcl_Obj*			hold_key;
	size_t				char_ofs;
	enum json_types		container;
	int					closed;
	Tcl_ObjType*		objtype;
	struct interp_cx*	l;
	enum parse_mode		mode;
};

struct foreach_iterator {
	int				data_c;
	Tcl_Obj**		data_v;
	int				data_i;
	Tcl_Obj*		varlist;
	int				var_c;
	Tcl_Obj**		var_v;
	int				is_array;

	// Dict search related state - when iterating over JSON objects
	Tcl_DictSearch	search;
	Tcl_Obj*		k;
	Tcl_Obj*		v;
	int				done;
};

struct foreach_state {
	unsigned int				loop_num;
	unsigned int				max_loops;
	unsigned int				iterators;
	struct foreach_iterator*	it;
	Tcl_Obj*					script;
	Tcl_Obj*					res;
	int							collecting;
};

enum serialize_modes {
	SERIALIZE_NORMAL,		// We're updating the string rep of a json value or template
	SERIALIZE_TEMPLATE		// We're interpolating values into a template
};

struct serialize_context {
	Tcl_DString*			ds;
	enum serialize_modes	serialize_mode;
	Tcl_Obj*				fromdict;	// NULL if no dict supplied
	struct interp_cx*		l;
	int						allow_null;
};

struct template_cx {
	Tcl_Interp*			interp;
	struct interp_cx*	l;
	Tcl_Obj*			map;
	Tcl_Obj*			actions;
	int					slots_used;
};

struct cx_stack {
	Tcl_Obj*		target;
	Tcl_Obj*		elem;
};

enum modifiers {
	MODIFIER_NONE,
	MODIFIER_LENGTH,	// for arrays and strings: return the length as an int
	MODIFIER_SIZE,		// for objects: return the number of keys as an int
	MODIFIER_TYPE,		// for all types: return the string name as Tcl_Obj
	MODIFIER_KEYS		// for objects: return the keys defined as Tcl_Obj
};

enum action_opcode {
	NOP,
	ALLOCATE,
	FETCH_VALUE,
	DECLARE_LITERAL,
	STORE_STRING,
	STORE_NUMBER,
	STORE_BOOLEAN,
	STORE_JSON,
	STORE_TEMPLATE,
	PUSH_TARGET,
	POP_TARGET,
	REPLACE_VAL,
	REPLACE_ARR,
	REPLACE_ATOM,
	REPLACE_KEY,

	TEMPLATE_ACTIONS_END
};

#if DEDUP
struct kc_entry {
	Tcl_Obj			*val;
	unsigned int	hits;
};

/* Find the best BSF (bit-scan-forward) implementation available:
 * In order of preference:
 *    - __builtin_ffsll     - provided by gcc >= 3.4 and clang >= 5.x
 *    - ffsll               - glibc extension, freebsd libc >= 7.1
 *    - ffs                 - POSIX, but only on int
 * TODO: possibly provide _BitScanForward implementation for Visual Studio >= 2005?
 */
#if defined(HAVE___BUILTIN_FFSLL) || defined(HAVE_FFSLL)
#	define FFS_TMP_STORAGE	/* nothing to declare */
#	if defined(HAVE___BUILTIN_FFSLL)
#		define FFS				__builtin_ffsll
#	else
#		define FFS				ffsll
#	endif
#	define FREEMAP_TYPE		long long
#elif defined(_MSC_VER) && defined(_WIN64) && _MSC_VER >= 1400
#	define FFS_TMP_STORAGE	unsigned long ix;
/* _BitScanForward64 numbers bits starting with 0, ffsll starts with 1 */
#	define FFS(x)			(_BitScanForward64(&ix, x) ? ix+1 : 0)
#	define FREEMAP_TYPE		long long
#else
#	define FFS_TMP_STORAGE	/* nothing to declare */
#	define FFS				ffs
#	define FREEMAP_TYPE		int
#endif


#define KC_ENTRIES		384		// Must be an integer multiple of 8*sizeof(FREEMAP_TYPE)

#endif

struct interp_cx {
	Tcl_Interp*		interp;
	Tcl_Obj*		tcl_true;
	Tcl_Obj*		tcl_false;
	Tcl_Obj*		tcl_empty;
	Tcl_Obj*		tcl_one;
	Tcl_Obj*		tcl_zero;
	Tcl_Obj*		json_true;
	Tcl_Obj*		json_false;
	Tcl_Obj*		json_null;
	Tcl_Obj*		json_empty_string;
	Tcl_Obj*		tcl_empty_dict;
	Tcl_Obj*		tcl_empty_list;
	Tcl_Obj*		action[TEMPLATE_ACTIONS_END];
	Tcl_Obj*		force_num_cmd[3];
	Tcl_Obj*		type_int[JSON_TYPE_MAX];	// Tcl_Obj for JSON_STRING, JSON_ARRAY, etc
	Tcl_Obj*		type[JSON_TYPE_MAX];		// Holds the Tcl_Obj values returned for [json type ...]
#if DEDUP
	Tcl_HashTable	kc;
	int				kc_count;
	FREEMAP_TYPE	freemap[(KC_ENTRIES / (8*sizeof(FREEMAP_TYPE)))+1];	// long long for ffsll
	struct kc_entry	kc_entries[KC_ENTRIES];
#endif
	const Tcl_ObjType*	typeDict;		// Evil hack to identify objects of type dict, used to choose whether to iterate over a list of pairs as a dict or a list, for efficiency

	const Tcl_ObjType*	typeInt;		// Evil hack to snoop on the type of a number, so that we don't have to add 0 to a candidate to know if it's a valid number
	const Tcl_ObjType*	typeDouble;
	const Tcl_ObjType*	typeBignum;
	Tcl_Obj*		apply;
	Tcl_Obj*		decode_bytes;
};

void append_to_cx(struct parse_context *cx, Tcl_Obj *val);
int serialize(Tcl_Interp* interp, struct serialize_context* scx, Tcl_Obj* obj);
int init_types(Tcl_Interp* interp);
Tcl_Obj* new_stringobj_dedup(struct interp_cx *l, const char *bytes, int length);
int lookup_type(Tcl_Interp* interp, Tcl_Obj* typeobj, int* type);
int is_template(const char* s, int len);

extern Tcl_ObjType* g_objtype_for_type[];
extern const char* type_names_int[];

#ifdef TCL_MEM_DEBUG
#	undef JSON_NewJvalObj
Tcl_Obj* JSON_DbNewJvalObj(enum json_types type, Tcl_Obj* val, const char* file, int line);
#	define JSON_NewJvalObj(type, val) JSON_DbNewJvalObj(type, val, __FILE__ " (JVAL)", __LINE__)
#endif

// Taken from tclInt.h:
#if !defined(INT2PTR) && !defined(PTR2INT)
#   if defined(HAVE_INTPTR_T) || defined(intptr_t)
#       define INT2PTR(p) ((void *)(intptr_t)(p))
#       define PTR2INT(p) ((int)(intptr_t)(p))
#   else
#       define INT2PTR(p) ((void *)(p))
#       define PTR2INT(p) ((int)(p))
#   endif
#endif
#if !defined(UINT2PTR) && !defined(PTR2UINT)
#   if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
#       define UINT2PTR(p) ((void *)(uintptr_t)(p))
#       define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
#   else
#       define UINT2PTR(p) ((void *)(p))
#       define PTR2UINT(p) ((unsigned int)(p))
#   endif
#endif

Tcl_Obj* JSON_NewJvalObj(enum json_types type, Tcl_Obj* val);
int JSON_SetIntRep(Tcl_Obj* target, enum json_types type, Tcl_Obj* replacement);
int JSON_GetIntrepFromObj(Tcl_Interp* interp, Tcl_Obj* obj, enum json_types* type, Tcl_ObjIntRep** ir);
int JSON_GetJvalFromObj(Tcl_Interp *interp, Tcl_Obj *obj, enum json_types *type, Tcl_Obj **val);
int JSON_IsJSON(Tcl_Obj* obj, enum json_types* type, Tcl_ObjIntRep** ir);
int type_is_dynamic(const enum json_types type);
int force_json_number(Tcl_Interp* interp, struct interp_cx* l, Tcl_Obj* obj, Tcl_Obj** forced);
Tcl_Obj* as_json(Tcl_Interp* interp, Tcl_Obj* from);
const char* get_dyn_prefix(enum json_types type);
const char* get_type_name(enum json_types type);
Tcl_Obj* get_unshared_val(Tcl_ObjIntRep* ir);
int apply_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* actions, Tcl_Obj* dict, Tcl_Obj** res);
int build_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj** actions);
int convert_to_tcl(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** out);
int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int pathc, Tcl_Obj** target, const int exists, const int modifiers);
int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds);

#define TEMPLATE_TYPE(s, len, out) \
	if (s[0] == '~' && (len) >= 3 && s[2] == ':') { \
		switch (s[1]) { \
			case 'S': out = JSON_DYN_STRING;    break; \
			case 'N': out = JSON_DYN_NUMBER;     break; \
			case 'B': out = JSON_DYN_BOOL;       break; \
			case 'J': out = JSON_DYN_JSON;       break; \
			case 'T': out = JSON_DYN_TEMPLATE;   break; \
			case 'L': out = JSON_DYN_LITERAL;    break; \
			default:  out = JSON_STRING; s -= 3; break; \
		} \
		s += 3; \
	} else {out = JSON_STRING;}

#include "dedup.h"

#endif

Changes to jni/rl_json/generic/rl_jsonStubInit.c.

1
2
3
4
5
6
7
8
9




















10



11







12
13
14
#include "rl_json.h"

/* !BEGIN!: Do not edit below this line. */

const Rl_jsonStubs rl_jsonStubs = {
    TCL_STUB_MAGIC,
    0,
    JSON_NewJvalObj, /* 0 */
    JSON_GetJvalFromObj, /* 1 */




















    JSON_Set, /* 2 */



    JSON_Template, /* 3 */







};

/* !END!: Do not edit above this line. */







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



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
#include "rl_json.h"

/* !BEGIN!: Do not edit below this line. */

const Rl_jsonStubs rl_jsonStubs = {
    TCL_STUB_MAGIC,
    0,
    JSON_NewJSONObj, /* 0 */
    JSON_NewJStringObj, /* 1 */
    JSON_NewJNumberObj, /* 2 */
    JSON_NewJBooleanObj, /* 3 */
    JSON_NewJNullObj, /* 4 */
    JSON_NewJObjectObj, /* 5 */
    0, /* 6 */
    JSON_NewTemplateObj, /* 7 */
    JSON_ForceJSON, /* 8 */
    JSON_GetJSONType, /* 9 */
    JSON_GetObjFromJStringObj, /* 10 */
    JSON_GetObjFromJNumberObj, /* 11 */
    JSON_GetObjFromJBooleanObj, /* 12 */
    JSON_JArrayObjAppendElement, /* 13 */
    JSON_JArrayObjAppendList, /* 14 */
    JSON_SetJArrayObj, /* 15 */
    JSON_JArrayObjGetElements, /* 16 */
    JSON_JArrayObjIndex, /* 17 */
    JSON_JArrayObjReplace, /* 18 */
    JSON_Get, /* 19 */
    JSON_Extract, /* 20 */
    JSON_Exists, /* 21 */
    JSON_Set, /* 22 */
    JSON_Unset, /* 23 */
    JSON_Normalize, /* 24 */
    JSON_Pretty, /* 25 */
    JSON_Template, /* 26 */
    JSON_IsNULL, /* 27 */
    JSON_Type, /* 28 */
    JSON_Length, /* 29 */
    JSON_Keys, /* 30 */
    JSON_Decode, /* 31 */
    JSON_Foreach, /* 32 */
    JSON_Valid, /* 33 */
};

/* !END!: Do not edit above this line. */

Changes to jni/rl_json/generic/rl_jsonStubLib.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
/*
 * Based on tclOOStubLib.c
 */

#include "rl_json.h"

MODULE_SCOPE const Rl_jsonStubs *rl_jsonStubsPtr;

const Rl_jsonStubs *Rl_jsonStubsPtr = NULL;

#undef rl_jsonInitializeStubs

MODULE_SCOPE const char* rl_jsonInitializeStubs(Tcl_Interp* interp, const char* version)
{
	int				exact = 0;
	const char*		packageName = "rl_json";
	const char* 	errMsg = NULL;
	Rl_jsonStubs*	stubsPtr = NULL;
	const char*		actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &stubsPtr);

	if (actualVersion == NULL) {
		return NULL;
<
<
<
<






|

|

<











1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17




#include "rl_json.h"

MODULE_SCOPE const Rl_jsonStubs *rl_jsonStubsPtr;

const Rl_jsonStubs *Rl_jsonStubsPtr = NULL;

#undef rl_jsonInitStubs

EXTERN CONST const char* Rl_jsonInitStubs(Tcl_Interp* interp, const char* version, int exact)
{

	const char*		packageName = "rl_json";
	const char* 	errMsg = NULL;
	Rl_jsonStubs*	stubsPtr = NULL;
	const char*		actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &stubsPtr);

	if (actualVersion == NULL) {
		return NULL;

Changes to jni/rl_json/generic/tclstuff.h.

11
12
13
14
15
16
17






18
19
20
21
22
23
24
..
49
50
51
52
53
54
55

56
57
58
59
60





























61
			(ClientData *) NULL, NULL );

#define THROW_ERROR( ... )								\
	{													\
		Tcl_AppendResult(interp, ##__VA_ARGS__, NULL);	\
		return TCL_ERROR;								\
	}







#define THROW_ERROR_LABEL( label, var, ... )				\
	{														\
		Tcl_AppendResult(interp, ##__VA_ARGS__, NULL);		\
		var = TCL_ERROR;									\
		goto label;											\
	}
................................................................................
		var = TCL_ERROR; \
		goto label; \
	}
#else
#define TEST_OK( cmd )		\
	if (cmd != TCL_OK) return TCL_ERROR;
#endif

#define TEST_OK_LABEL( label, var, cmd )		\
	if (cmd != TCL_OK) { \
		var = TCL_ERROR; \
		goto label; \
	}





























#endif







>
>
>
>
>
>







 







>





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

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
..
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
			(ClientData *) NULL, NULL );

#define THROW_ERROR( ... )								\
	{													\
		Tcl_AppendResult(interp, ##__VA_ARGS__, NULL);	\
		return TCL_ERROR;								\
	}

#define THROW_PRINTF( fmtstr, ... )											\
	{																		\
		Tcl_SetObjResult(interp, Tcl_ObjPrintf((fmtstr), ##__VA_ARGS__));	\
		return TCL_ERROR;													\
	}

#define THROW_ERROR_LABEL( label, var, ... )				\
	{														\
		Tcl_AppendResult(interp, ##__VA_ARGS__, NULL);		\
		var = TCL_ERROR;									\
		goto label;											\
	}
................................................................................
		var = TCL_ERROR; \
		goto label; \
	}
#else
#define TEST_OK( cmd )		\
	if (cmd != TCL_OK) return TCL_ERROR;
#endif

#define TEST_OK_LABEL( label, var, cmd )		\
	if (cmd != TCL_OK) { \
		var = TCL_ERROR; \
		goto label; \
	}

#define TEST_OK_BREAK(var, cmd) if (TCL_OK != (var=(cmd))) break;

static inline void release_tclobj(Tcl_Obj** obj)
{
	if (*obj) {
		Tcl_DecrRefCount(*obj);
		*obj = NULL;
	}
}
#define RELEASE_MACRO(obj)		if (obj) {Tcl_DecrRefCount(obj); obj=NULL;}
#define REPLACE_MACRO(target, replacement)	\
{ \
	release_tclobj(&target); \
	if (replacement) Tcl_IncrRefCount(target = replacement); \
}
static inline void replace_tclobj(Tcl_Obj** target, Tcl_Obj* replacement)
{
	if (*target) {
		Tcl_DecrRefCount(*target);
		*target = NULL;
	}
	*target = replacement;
	if (*target) Tcl_IncrRefCount(*target);
}

#include <signal.h>
#define DEBUGGER raise(SIGTRAP)

#endif

Added jni/rl_json/generic/tip445.h.

























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#ifndef _TIP445_H
#define _TIP445_H

#if TIP445_SHIM

/* Just enough of TIP445 to build rl_json on Tcl 8.6 */

#ifndef Tcl_ObjIntRep
typedef union Tcl_ObjIntRep {
	struct {
		void*	ptr1;
		void*	ptr2;
	} twoPtrValue;
} Tcl_ObjIntRep;
#endif

#ifndef Tcl_FetchIntRep
#define Tcl_FetchIntRep(obj, type)		(Tcl_ObjIntRep*)(((obj)->typePtr == (type)) ? &(obj)->internalRep : NULL)
#endif

#ifndef Tcl_FreeIntRep
static inline void Tcl_FreeIntRep(Tcl_Obj* obj)
{
	if (obj->typePtr && obj->typePtr->freeIntRepProc)
		obj->typePtr->freeIntRepProc(obj);
}
#endif

#ifndef Tcl_StoreIntRep
static inline void Tcl_StoreIntRep(Tcl_Obj* objPtr, const Tcl_ObjType* typePtr, const Tcl_ObjIntRep* irPtr)
{
	objPtr->typePtr = typePtr;
	objPtr->internalRep.twoPtrValue.ptr1 = irPtr->twoPtrValue.ptr1;
	objPtr->internalRep.twoPtrValue.ptr2 = irPtr->twoPtrValue.ptr2;
}
#endif

#ifndef Tcl_HasStringRep
#define Tcl_HasStringRep(obj)	((obj)->bytes != NULL)
#endif

#endif

#endif

Added jni/rl_json/get_tclconfig.tcl.





































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#!/usr/bin/env tclsh

package require http
try {
	package require tls
} on ok ver {
	puts "Have tls $ver"
	http::register https 443 ::tls::socket
} on error {} {}

cd [file dirname [file normalize [info script]]]
set url		https://core.tcl-lang.org/tclconfig/tarball/trunk/tclconfig.tar.gz
while {[incr tries] <= 5} {
	set token	[http::geturl $url]
	switch -glob -- [http::ncode $token] {
		30* {
			foreach {k v} [http::meta $token] {
				if {[string tolower $k] eq "location"} {
					set url	$v
					puts "Followed [http::ncode $token] redirect to $url"
					break
				}
			}
		}

		5* {
			puts stderr "Server error [http::ncode $token], delaying 1s and trying again"
			after 1000
		}

		2* {
			file delete -force -- tclconfig
			set h	[open |[list tar xzf -] wb+]
			try {
				puts -nonewline $h [http::data $token]
				chan close $h write
				read $h
				close $h
			} on ok {} {
				puts "Refreshed tclconfig with the latest version from core.tcl-lang.org"
				exit 0
			} trap CHILDSTATUS {errmsg options} {
				set status	[lindex [dict get $options -errorinfo] 2]
				puts stderr "tar exited with status $status"
				exit $status
			} trap CHILDKILLED {errmsg options} {
				set sig		[lindex [dict get $options -errorinfo] 2]
				puts stderr "tar killed by signal $sig"
				exit 1
			} finally {
				if {[info exists h] && $h in [chan names]} {
					close $h
				}
			}
		}

		default {
			puts stderr "Fetching tclconfig failed: [http::ncode $token] [http::error $token] [http::data $token]"
			parray $token
			exit 1
		}
	}
}

puts "Gave up after [expr {$tries-1}] attempts"
exit 1

Added jni/rl_json/support/urlencode-1.0.tm.



















































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
package require parse_args

namespace eval ::urlencode {
	namespace export *
	namespace ensemble create -prefixes no

	namespace eval _uri {
		variable uri_charmap

		# Set up classvar uri_charmap <<<
		# The reason that this is here is so that the sets, lists and charmaps
		# are generated only once, making the instantiation of uri objects much
		# lighter
		array set uri_common {
			reserved	{; ? : @ & = + $ ,}
			lowalpha	{a b c d e f g h i j k l m n o p q r s t u v w x y z}
			upalpha		{A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
			digit		{0 1 2 3 4 5 6 7 8 9}
			mark		{- _ . ! ~ * ' ( )}
			alpha		{}
			alphanum	{}
			unreserved	{}
		}

		set uri_common(alpha)		[concat $uri_common(lowalpha) $uri_common(upalpha)]
		set uri_common(alphanum)	[concat $uri_common(alpha) $uri_common(digit)]
		set uri_common(unreserved)	[concat $uri_common(alphanum) $uri_common(mark)]

		variable uri_charmap
		variable uri_charmap_compat
		variable uri_charmap_path
		variable uri_charmap_path_compat
		variable uri_decode_min	{}
		variable uri_decode	{}

		for {set i 0} {$i < 256} {incr i} {
			set c	[binary format c $i]
			if {$c in $uri_common(unreserved)} {
				lappend uri_charmap	$c
			} else {
				lappend uri_charmap	[format %%%02x $i]
			}
			if {$c in $uri_common(alphanum)} {
				lappend uri_charmap_compat	$c
			} else {
				lappend uri_charmap_compat	[format %%%02x $i]
				lappend uri_decode_min		[format %%%02x $i] $c [format %%%02X $i] $c
			}
			lappend uri_decode [format %%%02x $i] $c [format %%%02X $i] $c
		}
		lappend uri_decode + " "
		lappend uri_decode_min + " "
		unset uri_common

		set uri_charmap_path	$uri_charmap
		lset uri_charmap 0x2f /
		set uri_charmap_path_compat	$uri_charmap_compat
		lset uri_charmap_compat 0x2f /

		# Set up classvar uri_charmap >>>
		proc percent_encode {charset map data} { #<<<
			binary scan [encoding convertto $charset $data] cu* byteslist
			set out	""
			foreach byte $byteslist {
				append out	[lindex $map $byte]
			}
			set out
		}

		#>>>
		proc percent_decode {charset data} { #<<<
			variable uri_decode
			encoding convertfrom $charset [string map $uri_decode $data]
		}

		#>>>
	}
	proc rfc_urlencode args { #<<<
		# besides alphanumeric characters, the valid un-encoded characters are: - _ . ! ~ * ' ( )
		parse_args::parse_args $args {
			-charset	{-default utf-8}
			-part		{-enum {query path} -default query}
			str			{-required}
		}

		switch -- $part {
			query { set map		$::urlencode::_uri::uri_charmap }
			path  { set map		$::urlencode::_uri::uri_charmap_path }
		}

		::urlencode::_uri::percent_encode $charset $map $str
	}

	#>>>
	proc rfc_urldecode args { #<<<
		parse_args::parse_args $args {
			-charset	{-default utf-8}
			str			{-required}
		}

		# the encoding convertto here is in case we're passed unicode, not percent encoded utf-8
		::urlencode::_uri::percent_decode $charset [encoding convertto utf-8 $str]
	}

	#>>>
	proc encode_query args { #<<<
		switch -- [llength $args] {
			0       { return }
			1       { set params	[lindex $args 0] }
			default { set params $args }
		}

		if {[llength $params] == 0} return

		string cat ? [join [lmap {k v} $params {
			if {$v eq ""} {
				rfc_urlencode -- $k $v
			} else {
				format %s=%s [rfc_urlencode -- $k] [rfc_urlencode -- $v]
			}
		}] &]
	}

	#>>>
	proc decode_query q { #<<<
		set params	{}
		foreach part [split $q &] {
			lassign [split $part =] ke ve
			lappend params [rfc_urldecode -- $ke] [rfc_urldecode -- $ve]
		}
		set params
	}

	#>>>
}

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/tests/_parser.test.

924
925
926
927
928
929
930


931
932
933
934
935
936


937
938
939
940
941
942


943
944
945
946
947
948


949
950
951
952
953
954
955
...
976
977
978
979
980
981
982


983
984
985
986
987
988


989
990
991
992
993
994


995
996
997
998
999
1000


1001
1002
1003
1004
1005
1006


1007
1008
1009
1010
1011
1012


1013
1014
1015
1016
1017
1018


1019
1020
1021
1022
1023
1024


1025
1026
1027
1028
1029
1030


1031
1032
1033
1034
1035
1036


1037
1038
1039
1040
1041
1042


1043
1044
1045
1046
1047
1048


1049
1050
1051
1052
1053
1054
1055
....
1209
1210
1211
1212
1213
1214
1215


1216
1217
1218
1219
1220
1221
1222
....
1276
1277
1278
1279
1280
1281
1282

1283
1284
1285
1286
1287
	unset -nocomplain j
} -result [list {["foo","bar"]} bar]
#>>>
test parser/structure-4.1 {orphaned hold_key} -body { #<<<
	list [catch {
		json normalize {{"structure-4.1"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Expecting : after object key} {{"structure-4.1"}} 16] {Error parsing JSON value: Expecting : after object key at offset 16}]
#>>>
test parser/structure-4.2 {orphaned hold_key} -body { #<<<
	list [catch {
		json normalize {{"structure-4.2":}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Illegal character} {{"structure-4.2":}} 17] {Error parsing JSON value: Illegal character at offset 17}]
#>>>
test parser/structure-4.3 {nested orphaned hold_key} -body { #<<<
	list [catch {
		json normalize {{"x":"y","structure-4.3":{"nested-4.3":}}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Illegal character} {{"x":"y","structure-4.3":{"nested-4.3":}}} 39] {Error parsing JSON value: Illegal character at offset 39}]
#>>>
test parser/structure-4.4 {nested orphaned hold_key, nested key parse error} -body { #<<<
	list [catch {
		json normalize {{"structure-4.4":{"nested-4.4\x":"bar"}}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Illegal character} {{"structure-4.4":{"nested-4.4\x":"bar"}}} 30] {Error parsing JSON value: Illegal character at offset 30}]
#>>>
test parser/structure-5.4 {Deep nesting, ensure that this test nests deeper than CX_STACK_SIZE} -body { #<<<
	json get {
		{
			"first": {
				"second": {
................................................................................
	} first second third fourth fifth sixth seventh eighth ninth tenth eleventh end
} -result structure-5.4
#>>>
test parser/structure-6.1 {Nesting error} -body { #<<<
	list [catch {
		json normalize {{"structure-6.1":[}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Illegal character} {{"structure-6.1":[}]} 18] {Error parsing JSON value: Illegal character at offset 18}]
#>>>
test parser/structure-6.2 {Nesting error} -body { #<<<
	list [catch {
		json normalize {{"structure-6.2":[null,}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Illegal character} {{"structure-6.2":[null,}]} 23] {Error parsing JSON value: Illegal character at offset 23}]
#>>>
test parser/structure-6.3 {Nesting error} -body { #<<<
	list [catch {
		json normalize {[{"structure-6.3"]}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Expecting : after object key} {[{"structure-6.3"]}]} 17] {Error parsing JSON value: Expecting : after object key at offset 17}]
#>>>
test parser/structure-6.4 {Nesting error} -body { #<<<
	list [catch {
		json normalize {[{"structure-6.4":]}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Illegal character} {[{"structure-6.4":]}]} 18] {Error parsing JSON value: Illegal character at offset 18}]
#>>>
test parser/structure-6.5 {Nesting error} -body { #<<<
	list [catch {
		json normalize {[{"structure-6.5":1]}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE "Expecting \} or ," {[{"structure-6.5":1]}]} 19] "Error parsing JSON value: Expecting \} or , at offset 19"]
#>>>
test parser/structure-6.6 {Nesting error} -body { #<<<
	list [catch {
		json normalize {[{"structure-6.6":1,]}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Illegal character} {[{"structure-6.6":1,]}]} 20] {Error parsing JSON value: Illegal character at offset 20}]
#>>>
test parser/structure-7.1 {Object key not a string: number} -body { #<<<
	list [catch {
		json normalize {{7.1:"structure-7.1"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{7.1:"structure-7.1"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.2 {Object key not a string: true} -body { #<<<
	list [catch {
		json normalize {{true:"structure-7.2"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{true:"structure-7.2"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.3 {Object key not a string: false} -body { #<<<
	list [catch {
		json normalize {{false:"structure-7.3"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{false:"structure-7.3"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.4 {Object key not a string: null} -body { #<<<
	list [catch {
		json normalize {{null:"structure-7.4"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{null:"structure-7.4"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.5 {Object key not a string: object} -body { #<<<
	list [catch {
		json normalize {{{}:"structure-7.5"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{{}:"structure-7.5"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.6 {Object key not a string: array} -body { #<<<
	list [catch {
		json normalize {{[]:"structure-7.6"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{[]:"structure-7.6"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-8.1 {Object key not a string: dyn_number} -body { #<<<
	json normalize {{"~N:f":"structure-8.1"}}
} -result {{"~N:f":"structure-8.1"}}
#>>>
test parser/structure-8.2 {Object key not a string: dyn_bool} -body { #<<<
................................................................................
	unset -nocomplain bytes lower upper
}
#>>>
test parser/whitespace-4.1 {Half opened // comment sequence} -body { #<<<
	list [catch {
		json normalize " /foo"
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r


} -result [list 1 {RL JSON PARSE {Illegal character} { /foo} 2} {Error parsing JSON value: Illegal character at offset 2}]
#>>>
test parser/whitespace-5.1 {Two comments, no whitespace} -body { #<<<
	json get {/*foo*//*bar*/123}
} -result 123
#>>>
test parser/whitespace-6.1 {Two comments, whitespace between} -body { #<<<
................................................................................
test parser/whitespace-9.6 {Commented object key} -body { #<<<
	json template {
		{
			//"foo":	{}
		}
	}
} -result "{}"


::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4







>
>






>
>






>
>






>
>







 







>
>






>
>






>
>






>
>






>
>






>
>






>
>






>
>






>
>






>
>






>
>






>
>







 







>
>







 







>





924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
...
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
....
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
....
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
	unset -nocomplain j
} -result [list {["foo","bar"]} bar]
#>>>
test parser/structure-4.1 {orphaned hold_key} -body { #<<<
	list [catch {
		json normalize {{"structure-4.1"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Expecting : after object key} {{"structure-4.1"}} 16] {Error parsing JSON value: Expecting : after object key at offset 16}]
#>>>
test parser/structure-4.2 {orphaned hold_key} -body { #<<<
	list [catch {
		json normalize {{"structure-4.2":}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Illegal character} {{"structure-4.2":}} 17] {Error parsing JSON value: Illegal character at offset 17}]
#>>>
test parser/structure-4.3 {nested orphaned hold_key} -body { #<<<
	list [catch {
		json normalize {{"x":"y","structure-4.3":{"nested-4.3":}}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Illegal character} {{"x":"y","structure-4.3":{"nested-4.3":}}} 39] {Error parsing JSON value: Illegal character at offset 39}]
#>>>
test parser/structure-4.4 {nested orphaned hold_key, nested key parse error} -body { #<<<
	list [catch {
		json normalize {{"structure-4.4":{"nested-4.4\x":"bar"}}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Illegal character} {{"structure-4.4":{"nested-4.4\x":"bar"}}} 30] {Error parsing JSON value: Illegal character at offset 30}]
#>>>
test parser/structure-5.4 {Deep nesting, ensure that this test nests deeper than CX_STACK_SIZE} -body { #<<<
	json get {
		{
			"first": {
				"second": {
................................................................................
	} first second third fourth fifth sixth seventh eighth ninth tenth eleventh end
} -result structure-5.4
#>>>
test parser/structure-6.1 {Nesting error} -body { #<<<
	list [catch {
		json normalize {{"structure-6.1":[}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Illegal character} {{"structure-6.1":[}]} 18] {Error parsing JSON value: Illegal character at offset 18}]
#>>>
test parser/structure-6.2 {Nesting error} -body { #<<<
	list [catch {
		json normalize {{"structure-6.2":[null,}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Illegal character} {{"structure-6.2":[null,}]} 23] {Error parsing JSON value: Illegal character at offset 23}]
#>>>
test parser/structure-6.3 {Nesting error} -body { #<<<
	list [catch {
		json normalize {[{"structure-6.3"]}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Expecting : after object key} {[{"structure-6.3"]}]} 17] {Error parsing JSON value: Expecting : after object key at offset 17}]
#>>>
test parser/structure-6.4 {Nesting error} -body { #<<<
	list [catch {
		json normalize {[{"structure-6.4":]}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Illegal character} {[{"structure-6.4":]}]} 18] {Error parsing JSON value: Illegal character at offset 18}]
#>>>
test parser/structure-6.5 {Nesting error} -body { #<<<
	list [catch {
		json normalize {[{"structure-6.5":1]}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE "Expecting \} or ," {[{"structure-6.5":1]}]} 19] "Error parsing JSON value: Expecting \} or , at offset 19"]
#>>>
test parser/structure-6.6 {Nesting error} -body { #<<<
	list [catch {
		json normalize {[{"structure-6.6":1,]}]}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Illegal character} {[{"structure-6.6":1,]}]} 20] {Error parsing JSON value: Illegal character at offset 20}]
#>>>
test parser/structure-7.1 {Object key not a string: number} -body { #<<<
	list [catch {
		json normalize {{7.1:"structure-7.1"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{7.1:"structure-7.1"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.2 {Object key not a string: true} -body { #<<<
	list [catch {
		json normalize {{true:"structure-7.2"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{true:"structure-7.2"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.3 {Object key not a string: false} -body { #<<<
	list [catch {
		json normalize {{false:"structure-7.3"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{false:"structure-7.3"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.4 {Object key not a string: null} -body { #<<<
	list [catch {
		json normalize {{null:"structure-7.4"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{null:"structure-7.4"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.5 {Object key not a string: object} -body { #<<<
	list [catch {
		json normalize {{{}:"structure-7.5"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{{}:"structure-7.5"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-7.6 {Object key not a string: array} -body { #<<<
	list [catch {
		json normalize {{[]:"structure-7.6"}}
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 [list RL JSON PARSE {Object key is not a string} {{[]:"structure-7.6"}} 1] {Error parsing JSON value: Object key is not a string at offset 1}]
#>>>
test parser/structure-8.1 {Object key not a string: dyn_number} -body { #<<<
	json normalize {{"~N:f":"structure-8.1"}}
} -result {{"~N:f":"structure-8.1"}}
#>>>
test parser/structure-8.2 {Object key not a string: dyn_bool} -body { #<<<
................................................................................
	unset -nocomplain bytes lower upper
}
#>>>
test parser/whitespace-4.1 {Half opened // comment sequence} -body { #<<<
	list [catch {
		json normalize " /foo"
	} r o] [expr {[dict exists $o -errorcode] ? [dict get $o -errorcode] : ""}] $r
} -cleanup {
	unset -nocomplain r o
} -result [list 1 {RL JSON PARSE {Illegal character} { /foo} 2} {Error parsing JSON value: Illegal character at offset 2}]
#>>>
test parser/whitespace-5.1 {Two comments, no whitespace} -body { #<<<
	json get {/*foo*//*bar*/123}
} -result 123
#>>>
test parser/whitespace-6.1 {Two comments, whitespace between} -body { #<<<
................................................................................
test parser/whitespace-9.6 {Commented object key} -body { #<<<
	json template {
		{
			//"foo":	{}
		}
	}
} -result "{}"
#>>>

::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/tests/all.tcl.

13
14
15
16
17
18
19











































































































































































































20
21
22
23
24
25
26
..
63
64
65
66
67
68
69








70
71
}

if {[llength [info commands memory]] == 1} {
	memory init on
	#memory onexit memdebug
	#memory validate on
	#memory trace on











































































































































































































}

set ::tcltest::testSingleFile false
set ::tcltest::testsDirectory [file dir [info script]]

# We need to ensure that the testsDirectory is absolute
if {[catch {::tcltest::normalizePath ::tcltest::testsDirectory}]} {
................................................................................
	puts $chan $msg
    }
}

# cleanup
puts $chan "\nTests ended at [eval $timeCmd]"
::tcltest::cleanupTests 1








return








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







 







>
>
>
>
>
>
>
>


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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
...
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
}

if {[llength [info commands memory]] == 1} {
	memory init on
	#memory onexit memdebug
	#memory validate on
	#memory trace on
	memory tag startup

	proc intersect3 {list1 list2} {
		set firstonly       {}
		set intersection    {}
		set secondonly      {}

		set list1	[lsort -unique $list1]
		set list2	[lsort -unique $list2]

		foreach item $list1 {
			if {[lsearch -sorted $list2 $item] == -1} {
				lappend firstonly $item
			} else {
				lappend intersection $item
			}
		}

		foreach item $list2 {
			if {[lsearch -sorted $intersection $item] == -1} {
				lappend secondonly $item
			}
		}

		list $firstonly $intersection $secondonly
	}

	proc _mem_objs {} {
		set h	[file tempfile name]
		try {
			memory objs $name
			seek $h 0
			gets $h	;# Throw away the "total objects:" header
			set res	{}
			while {![eof $h]} {
				set line	[gets $h]
				lappend res $line
			}
			set res
		} finally {
			file delete $name
			close $h
		}
	}

	proc _mem_info {} {
		set res	{}
		foreach line [split [string trim [memory info]] \n] {
			if {![regexp {^(.*?)\s+([0-9]+)$} $line - k v]} continue
			dict set res $k $v
		}
		set res
	}

	proc _diff_mem_info {before after} {
		set res	{}

		dict for {k v} $after {
			dict set res $k [expr {$v - [dict get $before $k]}]
		}
		set res
	}

	proc _mem_active tag {
		set h	[file tempfile name]
		try {
			memory active $name
			seek $h 0
			set res	{}
			while {![eof $h]} {
				set line	[gets $h]
				if {[string match *$tag $line]} {
					lappend res $line
				}
			}
			set res
		} finally {
			file delete $name
			close $h
		}
	}

	proc memtest {name args} {
		if {[llength $::tcltest::match] > 0} {
			set ok	0
			foreach match $::tcltest::match {
				if {[string match $match $name]} {
					set ok	1
					break
				}
			}
			if {!$ok} return
		}
		set tag		"test $name"
		set before		[_mem_objs]
		set before_inf	[_mem_info]
		memory tag $tag
		try {
			uplevel 1 [list if 1 [list ::tcltest::test $name {*}$args]]
		} finally {
			set after_inf	[_mem_info]
			memory tag "overhead"
			set diff		[_diff_mem_info $before_inf $after_inf]
			if {[dict get $diff {current packets allocated}] > 80} {
				set after		[_mem_objs]
				#set new_active	[_mem_active $tag]
				#set new_active	[_mem_active ""]
				#puts stderr "$name: $diff"
				if {[incr ::count] > 0} {
					#if {[llength $new_active] > 0} {
					#	puts "$name new active:\n\t[join $new_active \n\t]"
					#}
					lassign [intersect3 $before $after] freed common new
					set new	[lmap line $new {
						if {![string match *unknown* $line]} continue
						#if {![regexp {/generic/(rl_json.|parser.|tclstuff.)} $line]} continue
						switch -glob -- $line {
							*tclIOCmd.c* -
							*tclLiteral* -
							*tclExecute* continue
						}
						set line
					}]
					set freed	[lmap line $freed {
						if {![string match *unknown* $line]} continue
						#if {![regexp {/generic/(rl_json.|parser.|tclstuff.)} $line]} continue
						switch -glob -- $line {
							*tclIOCmd.c* -
							*tclLiteral* -
							*tclExecute* continue
						}
						if {![string match *unknown* $line]} continue
						set line
					}]
					if {[llength $freed] > 0} {
						puts stderr "$name Existing objs freed:\n\t[join $freed \n\t]"
					}
					if {[llength $new] > 0} {
						#puts stderr "$name New objs created:\n\t[join $new \n\t]"
						#key = 0x0x1494cd8, objPtr = 0x0x1494cd8, file = unknown, line = 0
						puts stderr "$name New objs created:"
						foreach line $new {
							if {[regexp {, objPtr = 0x(0x.*?),} $line - addr]} {
								::rl_json::json _leak_info $addr
							}
						}
					}
					#set common	[lmap line $common {
					#	if {![regexp {/generic/(rl_json.|parser.|tclstuff.)} $line]} continue
					#	set line
					#}]
					#if {[llength $common] > 0} {
					#	puts stderr "$name New objs created:\n\t[join $common \n\t]"
					#}
				}
			}
		}
	}

	proc memtest2 {name args} {
		set bodyidx	[lsearch $args -body]
		if {$bodyidx == -1} {
			puts stderr "Can't find -body param to inject memory monitoring"
		} else {
			set body	[lindex $args $bodyidx+1]
			set args	[lreplace $args $bodyidx+1 $bodyidx+1 "set _checkmem_result \[::rl_json::checkmem [list $body] _checkmem_newactive\]; if {\[llength \$_checkmem_newactive\] > 0} {error \"Leaked memory:\\n\\t\[join \$_checkmem_newactive\[unset _checkmem_newactive\] \\n\\t\]\"} else {unset _checkmem_newactive}; return -level 0 \$_checkmem_result\[unset _checkmem_result\]"]
		}
		tailcall ::tcltest::test $name {*}$args
	}

	proc memtest3 {name args} {
		if {[llength $::tcltest::match] > 0} {
			set ok	0
			foreach match $::tcltest::match {
				if {[string match $match $name]} {
					set ok	1
					break
				}
			}
			if {!$ok} return
		}

		::rl_json::checkmem {
			apply {{name args} {
				::tcltest::test $name {*}$args
			}} $name {*}$args
		} newactive

		::tcltest::test "$name-mem" "Memory test for $name" -body {
			if {[llength $newactive] > 0} {
				return -level 0 "Leaked memory:\n\t[join $newactive \n\t]"
			}
		} -result {}
	}

	if 1 {
		rename test _test
		#interp alias {} test {} ::memtest
		#interp alias {} test {} ::memtest2
		interp alias {} ::test {} ::memtest3
	}
} else {
	proc memtest args {tailcall ::tcltest::test {*}$args}
}

set ::tcltest::testSingleFile false
set ::tcltest::testsDirectory [file dir [info script]]

# We need to ensure that the testsDirectory is absolute
if {[catch {::tcltest::normalizePath ::tcltest::testsDirectory}]} {
................................................................................
	puts $chan $msg
    }
}

# cleanup
puts $chan "\nTests ended at [eval $timeCmd]"
::tcltest::cleanupTests 1

if {[llength [info commands memory]] == 1} {
	memory tag shutdown
	#rl_json::json free_cache
	unload -nocomplain {} rl_json
	memory objs tclobjs_remaining
}

return

Added jni/rl_json/tests/amap.test.



























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
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
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
if {"::tcltest" ni [namespace children]} {
	package require tcltest
	namespace import ::tcltest::*
}

package require rl_json
namespace path {::rl_json}

test amap-1.0 {Single iterator, no vars, over array} -body { #<<<
	json amap {} {["a", "b", "other var", null, true, false, {"x": 42}]} {}
} -returnCodes error -result "foreach varlist is empty"
#>>>
test amap-1.1 {Single iterator, single var, over array} -setup { #<<<
	set i	0
} -body {
	json amap elem {["a", "b", "other var", null, true, false, {"x": 42}]} {
		string cat [incr i]($elem)([json get $elem])
	}
} -cleanup {
	unset -nocomplain i elem
} -result {["1(\"a\")(a)","2(\"b\")(b)","3(\"other var\")(other var)","4(null)()","5(true)(1)","6(false)(0)","7({\"x\":42})(x 42)"]}
#>>>
test amap-2.1 {Single iterator, multi vars, over array} -setup { #<<<
	set i	0
} -body {
	json amap {x y} {["a", "b", "other var", null, true, false, {"x": 42}, 42.1, "last"]} {
		string cat [incr i] \
			($x)([json get $x]) \
			($y)([json get $y])
	}
} -cleanup {
	unset -nocomplain i x y
} -result {["1(\"a\")(a)(\"b\")(b)","2(\"other var\")(other var)(null)()","3(true)(1)(false)(0)","4({\"x\":42})(x 42)(42.1)(42.1)","5(\"last\")(last)(null)()"]}
#>>>
test amap-3.0 {Multiple iterators, no vars, over array} -body { #<<<
	json amap \
		elem  {["a", "b", "other var", null, true, false, {"x": 42}]} \
		{}    {["A", "B", "OTHER VAR", null, true, {"X": 42}]} \
	{}
} -cleanup {
	unset -nocomplain elem
} -returnCodes error -result "foreach varlist is empty"
#>>>
test amap-3.1 {Multiple iterators, single var, over array} -setup { #<<<
	set i	0
} -body {
	json amap \
		elem  {["a", "b", "other var", null, true, false, {"x": 42}]} \
		elem2 {["A", "B", "OTHER VAR", null, true, {"X": 42}]} \
	{
		string cat [incr i]($elem)([json get $elem])/($elem2)([json get $elem2])
	}
} -cleanup {
	unset -nocomplain i elem elem2
} -result {["1(\"a\")(a)/(\"A\")(A)","2(\"b\")(b)/(\"B\")(B)","3(\"other var\")(other var)/(\"OTHER VAR\")(OTHER VAR)","4(null)()/(null)()","5(true)(1)/(true)(1)","6(false)(0)/({\"X\":42})(X 42)","7({\"x\":42})(x 42)/(null)()"]}
#>>>
test amap-4.1 {Multiple iterators, multi vars, over array} -setup { #<<<
	set i	0
} -body {
	json amap \
		{x y} {["a", "b", "other var", null, true, false, {"x": 42}, 42.1]} \
		{a b} {["A", "B", "OTHER VAR", null, true, {"X": 42}, 42.1]} \
	{
		string cat [incr i] \
			($x)([json get $x]) \
			($y)([json get $y]) \
			/ \
			($a)([json get $a]) \
			($b)([json get $b])
	}
} -cleanup {
	unset -nocomplain i x y a b
} -result {["1(\"a\")(a)(\"b\")(b)/(\"A\")(A)(\"B\")(B)","2(\"other var\")(other var)(null)()/(\"OTHER VAR\")(OTHER VAR)(null)()","3(true)(1)(false)(0)/(true)(1)({\"X\":42})(X 42)","4({\"x\":42})(x 42)(42.1)(42.1)/(42.1)(42.1)(null)()"]}
#>>>
test amap-5.1 {Single iterator, single var, over array, continue} -setup { #<<<
	set i	0
} -body {
	json amap elem {["a", "b", "other var", null, true, false, {"x": 42}]} {
		if {[json get $elem] eq ""} continue
		string cat [incr i]($elem)([json get $elem])
	}
} -cleanup {
	unset -nocomplain i elem
} -result {["1(\"a\")(a)","2(\"b\")(b)","3(\"other var\")(other var)","4(true)(1)","5(false)(0)","6({\"x\":42})(x 42)"]}
#>>>
test amap-5.1.1 {Single iterator, single var, over array, continue on final iteration} -setup { #<<<
	set i	0
} -body {
	json amap elem {["a", "b", "other var", null]} {
		if {[json get $elem] eq ""} continue
		string cat [incr i]($elem)([json get $elem])
	}
} -cleanup {
	unset -nocomplain i elem
} -result {["1(\"a\")(a)","2(\"b\")(b)","3(\"other var\")(other var)"]}
#>>>
test amap-6.1 {Single iterator, single var, over array, break} -setup { #<<<
	set i	0
} -body {
	json amap elem {["a", "b", "other var", null, true, false, {"x": 42}]} {
		if {[json get $elem] eq ""} break
		string cat [incr i]($elem)([json get $elem])
	}
} -cleanup {
	unset -nocomplain i elem
} -result {["1(\"a\")(a)","2(\"b\")(b)","3(\"other var\")(other var)"]}
#>>>
test amap-6.2 {Single iterator, single var, over array, return} -setup { #<<<
	set i	0
} -body {
	json amap elem {["a", "b", "other var", null, true, false, {"x": 42}]} {
		if {[json get $elem] eq ""} {return returned}
		string cat [incr i]($elem)([json get $elem])
	}
} -cleanup {
	unset -nocomplain i elem
} -result returned
#>>>

test amap-7.1 {Single iterator, single var, over null} -setup { #<<<
	set i	0
} -body {
	json amap elem null { incr i }
} -cleanup {
	unset -nocomplain i elem
} -result {[]}
#>>>
test amap-7.2 {Single iterator, single var, over empty array} -setup { #<<<
	set i	0
} -body {
	json amap elem {[]} { incr i }
} -cleanup {
	unset -nocomplain i elem
} -result {[]}
#>>>
test amap-7.3 {Single iterator, multi vars, over null} -setup { #<<<
	set i	0
} -body {
	json amap {x y} null { incr i }
} -cleanup {
	unset -nocomplain i x y
} -result {[]}
#>>>
test amap-8.1 {Multiple iterators, single var, over null} -setup { #<<<
	set i	0
} -body {
	json amap \
		elem  {["a", "b", "other var", null, true, false, {"x": 42}]} \
		elem2 {null} \
	{
		string cat [incr i]($elem)([json get $elem])/($elem2)([json get $elem2])
	}
} -cleanup {
	unset -nocomplain i elem elem2
} -result {["1(\"a\")(a)/(null)()","2(\"b\")(b)/(null)()","3(\"other var\")(other var)/(null)()","4(null)()/(null)()","5(true)(1)/(null)()","6(false)(0)/(null)()","7({\"x\":42})(x 42)/(null)()"]}
#>>>
test amap-8.2 {Multiple iterators, single var, over empty array} -setup { #<<<
	set i	0
	set res	{}
} -body {
	json amap \
		elem  {["a", "b", "other var", null, true, false, {"x": 42}]} \
		elem2 {[]} \
	{
		string cat [incr i]($elem)([json get $elem])/($elem2)([json get $elem2])
	}
} -cleanup {
	unset -nocomplain i elem elem2
} -result {["1(\"a\")(a)/(null)()","2(\"b\")(b)/(null)()","3(\"other var\")(other var)/(null)()","4(null)()/(null)()","5(true)(1)/(null)()","6(false)(0)/(null)()","7({\"x\":42})(x 42)/(null)()"]}
#>>>

test amap-9.1.0 {Single iterator, no vars, over object} -body { #<<<
	json amap {} {
		{
			"a": "b",
			"other var": null
		}
	} {}
} -returnCodes error -result "foreach varlist is empty"
#>>>
test amap-9.1.1 {Single iterator, single var, over object} -setup { #<<<
	set i	0
} -body {
	json amap {k v} {{"a": "b", "other var": null}} {
		string cat [incr i]:$k/$v
	}
} -cleanup {
	unset -nocomplain i k v
} -result {["1:a/\"b\"","2:other var/null"]}
#>>>
test amap-9.1.2 {Single iterator, single var, over object} -setup { #<<<
	set i	0
} -body {
	json amap {k} {{"a": "b", "other var": null}} {
		string cat [incr i]:$k/$v
	}
} -cleanup {
	unset -nocomplain i k v
} -returnCodes error -result {When iterating over a JSON object, varlist must be a pair of varnames (key value)}
#>>>
test amap-9.1.3 {Single iterator, single var, over object} -setup { #<<<
	set i	0
} -body {
	json amap {k v x} {{"a": "b", "other var": null}} {
		string cat [incr i]:$k/$v
	}
} -cleanup {
	unset -nocomplain i k v x
} -returnCodes error -result {When iterating over a JSON object, varlist must be a pair of varnames (key value)}
#>>>
test amap-9.3.0 {Multiple iterators, no vars, over object} -body { #<<<
	json amap \
		{k v}  {{"a": "b", "other var": null}} \
		{}     {{"A": "B", "OTHER VAR": null}} \
	{}
} -cleanup {
	unset -nocomplain k v
} -returnCodes error -result "foreach varlist is empty"
#>>>
test amap-9.3.1 {Multiple iterators, single var, over object} -setup { #<<<
	set i	0
} -body {
	json amap \
		{k v}   {{"a": "b", "other var": null}} \
		{k2 v2} {{"A": "B", "OTHER VAR": null}} \
	{
		string cat [incr i]($k/$v)($k/[json get $v])/($k2/$v2)($k2/[json get $v2])
	}
} -cleanup {
	unset -nocomplain i k1 k2 v1 v2
} -result {["1(a/\"b\")(a/b)/(A/\"B\")(A/B)","2(other var/null)(other var/)/(OTHER VAR/null)(OTHER VAR/)"]}
#>>>
test amap-9.5.1 {Single iterator, single var, over object, continue} -setup { #<<<
	set i	0
} -body {
	json amap {k v} {{"a": "b", "other var": null,"x": "y"}} {
		if {[json get $v] eq ""} continue
		string cat [incr i]($k/$v)([json get $v])
	}
} -cleanup {
	unset -nocomplain i k v
} -result {["1(a/\"b\")(b)","2(x/\"y\")(y)"]}
#>>>
test amap-9.5.1.1 {Single iterator, single var, over object, continue on final iteration} -setup { #<<<
	set i	0
} -body {
	json amap {k v} {{"a": "b", "X": "Y", "other var": null}} {
		if {[json get $v] eq ""} continue
		string cat [incr i]($k/$v)([json get $v])
	}
} -cleanup {
	unset -nocomplain i k v
} -result {["1(a/\"b\")(b)","2(X/\"Y\")(Y)"]}
#>>>
test amap-9.6.1 {Single iterator, single var, over object, break} -setup { #<<<
	set i	0
} -body {
	json amap {k v} {{"a": "b", "other var": null, "x": "y"}} {
		if {[json get $v] eq ""} break
		string cat [incr i]($k/$v)([json get $v])
	}
} -cleanup {
	unset -nocomplain i k v
} -result {["1(a/\"b\")(b)"]}
#>>>
test amap-9.6.2 {Single iterator, single var, over object, return} -setup { #<<<
	set i	0
} -body {
	json amap {k v} {{"a": "b", "other var": null, "x": "y"}} {
		if {[json get $v] eq ""} {return returned}
		string cat [incr i]($k/$v)([json get $v])
	}
} -cleanup {
	unset -nocomplain i k v
} -result returned
#>>>

test amap-10.1.1 {iteration over array result is a (native) JSON value: string} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		json string ([json get $e])
	}
} -cleanup {
	unset -nocomplain e
} -result {["(a)","(bb)","(ccc)"]}
#>>>
test amap-10.1.2 {iteration over array result is a (pure string) JSON value: string} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		string trim " \"([json get $e])\""
	}
} -cleanup {
	unset -nocomplain e
} -result {["(a)","(bb)","(ccc)"]}
#>>>
test amap-10.2.1 {iteration over array result is a (native) JSON value: number} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		json number [string length [json get $e]]
	}
} -cleanup {
	unset -nocomplain e
} -result {[1,2,3]}
#>>>
test amap-10.2.2 {iteration over array result is a (pure string) JSON value: number} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		string trim " [string length [json get $e]]"
	}
} -cleanup {
	unset -nocomplain e
} -result {[1,2,3]}
#>>>
test amap-10.3.1 {iteration over array result is a (native) JSON value: bool} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		json boolean [expr {[string length [json get $e]] % 2 == 0}]
	}
} -cleanup {
	unset -nocomplain e
} -result {[false,true,false]}
#>>>
test amap-10.3.2 {iteration over array result is a (pure string) JSON value: bool} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		string trim " [expr {[string length [json get $e]] % 2 == 0 ? "true":"false"}]"
	}
} -cleanup {
	unset -nocomplain e
} -result {[false,true,false]}
#>>>
test amap-10.4.1 {iteration over array result is a (native) JSON value: null} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		json extract {[null]} 0
	}
} -cleanup {
	unset -nocomplain e
} -result {[null,null,null]}
#>>>
test amap-10.4.2 {iteration over array result is a (pure string) JSON value: null} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		string trim " null"
	}
} -cleanup {
	unset -nocomplain e
} -result {[null,null,null]}
#>>>
test amap-10.5.1 {iteration over array result is a (native) JSON value: array} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		set r {[]}
		json set r end+1 $e
		json set r end+1 [json number [string length [json get $e]]]
	}
} -cleanup {
	unset -nocomplain e r
} -result {[["a",1],["bb",2],["ccc",3]]}
#>>>
test amap-10.5.2 {iteration over array result is a (pure string) JSON value: array} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		set r {[]}
		json set r end+1 $e
		json set r end+1 [json number [string length [json get $e]]]
		string trim " $r"
	}
} -cleanup {
	unset -nocomplain e r
} -result {[["a",1],["bb",2],["ccc",3]]}
#>>>
test amap-10.6.1 {iteration over array result is a (native) JSON value: object} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		set r {{}}
		json set r k $e
		json set r l [json number [string length [json get $e]]]
	}
} -cleanup {
	unset -nocomplain e r
} -result {[{"k":"a","l":1},{"k":"bb","l":2},{"k":"ccc","l":3}]}
#>>>
test amap-10.6.2 {iteration over array result is a (pure string) JSON value: object} -body { #<<<
	json amap e {["a","bb","ccc"]} {
		set r {{}}
		json set r k $e
		json set r l [json number [string length [json get $e]]]
		string trim " $r"
	}
} -cleanup {
	unset -nocomplain e r
} -result {[{"k":"a","l":1},{"k":"bb","l":2},{"k":"ccc","l":3}]}
#>>>

test amap-11.1.1 {iteration over object, iteration result a (native) JSON value: string} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		json string ($k/[json get $v])
	}
} -cleanup {
	unset -nocomplain k v
} -result {["(x/a)","(y/bb)","(z/ccc)"]}
#>>>
test amap-11.1.2 {iteration over object, iteration result a (pure string) JSON value: string} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		string trim " ($k/[json get $v])"
	}
} -cleanup {
	unset -nocomplain e
} -result {["(x/a)","(y/bb)","(z/ccc)"]}
#>>>
test amap-11.2.1 {iteration over object, iteration result a (native) JSON value: number} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		json number [string length [json get $v]]
	}
} -cleanup {
	unset -nocomplain k v
} -result {[1,2,3]}
#>>>
test amap-11.2.2 {iteration over object, iteration result a (pure string) JSON value: number} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		string trim " [string length [json get $v]]"
	}
} -cleanup {
	unset -nocomplain k v
} -result {[1,2,3]}
#>>>
test amap-11.3.1 {iteration over object, iteration result a (native) JSON value: bool} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		json boolean [expr {[string length [json get $v]] % 2 == 0}]
	}
} -cleanup {
	unset -nocomplain k v
} -result {[false,true,false]}
#>>>
test amap-11.3.2 {iteration over object, iteration result a (pure string) JSON value: bool} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		string trim " [expr {[string length [json get $v]] % 2 == 0 ? "true":"false"}]"
	}
} -cleanup {
	unset -nocomplain k v
} -result {[false,true,false]}
#>>>
test amap-11.4.1 {iteration over object, iteration result a (native) JSON value: null} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		json extract {[null]} 0
	}
} -cleanup {
	unset -nocomplain k v
} -result {[null,null,null]}
#>>>
test amap-11.4.2 {iteration over object, iteration result a (pure string) JSON value: null} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		string trim " null"
	}
} -cleanup {
	unset -nocomplain k v
} -result {[null,null,null]}
#>>>
test amap-11.5.1 {iteration over object, iteration result a (native) JSON value: array} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		set r {[]}
		json set r end+1 $v
		json set r end+1 [json number [string length [json get $v]]]
	}
} -cleanup {
	unset -nocomplain k v r
} -result {[["a",1],["bb",2],["ccc",3]]}
#>>>
test amap-11.5.2 {iteration over object, iteration result a (pure string) JSON value: array} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		set r {[]}
		json set r end+1 $v
		json set r end+1 [json number [string length [json get $v]]]
		string trim " $r"
	}
} -cleanup {
	unset -nocomplain k v r
} -result {[["a",1],["bb",2],["ccc",3]]}
#>>>
test amap-11.6.1 {iteration over object, iteration result a (native) JSON value: object} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		set r {{}}
		json set r k $v
		json set r l [json number [string length [json get $v]]]
	}
} -cleanup {
	unset -nocomplain k v r
} -result {[{"k":"a","l":1},{"k":"bb","l":2},{"k":"ccc","l":3}]}
#>>>
test amap-11.6.2 {iteration over object, iteration result a (pure string) JSON value: object} -body { #<<<
	json amap {k v} {{"x":"a","y":"bb","z":"ccc"}} {
		set r {{}}
		json set r k $v
		json set r l [json number [string length [json get $v]]]
		string trim " $r"
	}
} -cleanup {
	unset -nocomplain k v r
} -result {[{"k":"a","l":1},{"k":"bb","l":2},{"k":"ccc","l":3}]}
#>>>

test amap-20.5 {too few args} -body { #<<<
	list [catch {json amap x {[]}} r o] $r [dict get $o -errorcode]
} -cleanup {
	unset -nocomplain x y r o
} -result {1 {wrong # args: should be "*amap ?varlist datalist ...? script"} {TCL WRONGARGS}} -match glob
#>>>
test amap-20.6 {too many args} -body { #<<<
	list [catch {json amap x {[]} y {}} r o] $r [dict get $o -errorcode]
} -cleanup {
	unset -nocomplain x y r o
} -result {1 {wrong # args: should be "*amap ?varlist datalist ...? script"} {TCL WRONGARGS}} -match glob
#>>>

::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Added jni/rl_json/tests/array.test.

































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
if {"::tcltest" ni [namespace children]} {
	package require tcltest
	namespace import ::tcltest::*
}

package require rl_json

source [file join [file dirname [info script]] helpers.tcl]

test array-1.1 {Create an array from type-value pairs} -setup { #<<<
	set typevalues [lmap v {a 1 c 2 e 3 g} {
		if {[string is digit $v]} {
			list number $v
		} else {
			list string $v
		}
	}];
} -body {
	json new array {*}$typevalues
} -cleanup {
	unset -nocomplain typevalues
} -result {["a",1,"c",2,"e",3,"g"]}
#>>>
test array-1.2 {Create an array from JSON values} -setup { #<<<
	set values [lmap v {a 1 c 2 e 3 g} {
		if {[string is digit $v]} {
			json new number $v
		} else {
			json new string $v
		}
	}];
} -body {
	json new array {*}[lmap v $values {
		list json $v
	}];
} -cleanup {
	unset -nocomplain values v
} -result {["a",1,"c",2,"e",3,"g"]}
#>>>

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# tab-width: 4
# End:
# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Added jni/rl_json/tests/boolean.test.











































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
if {"::tcltest" ni [namespace children]} {
	package require tcltest
	namespace import ::tcltest::*
}

package require rl_json

test boolean-1.1 {Create a json boolean: 1} -body { #<<<
	json boolean 1
} -result true
#>>>
test boolean-1.2 {Create a json boolean: 0} -body { #<<<
	json boolean 0
} -result false
#>>>
test boolean-1.3 {Create a json boolean: truthy string: true} -body { #<<<
	json boolean true
} -result true
#>>>
test boolean-1.4 {Create a json boolean: truthy string: t} -body { #<<<
	json boolean t
} -result true
#>>>
test boolean-1.5 {Create a json boolean: truthy string: yes} -body { #<<<
	json boolean yes
} -result true
#>>>
test boolean-1.6 {Create a json boolean: truthy string: y} -body { #<<<
	json boolean y
} -result true
#>>>
test boolean-1.7 {Create a json boolean: truthy string: on} -body { #<<<
	json boolean on
} -result true
#>>>
test boolean-1.8 {Create a json boolean: truthy string: o (ambiguous prefix)} -body { #<<<
	json boolean o
} -returnCodes error -result {expected boolean value but got "o"}
#>>>
test boolean-1.9 {Create a json boolean: truthy number: 42} -body { #<<<
	json boolean 42
} -result true
#>>>
test boolean-1.10 {Create a json boolean: truthy number: 42.5} -body { #<<<
	json boolean 42.5
} -result true
#>>>
test boolean-1.11 {Create a json boolean: truthy number: 1e6} -body { #<<<
	json boolean 1e6
} -result true
#>>>
test boolean-1.12 {Create a json boolean: truthy number: positive bignum} -body { #<<<
	json boolean [expr {2**1000-1}]
} -result true
#>>>
test boolean-1.13 {Create a json boolean: truthy number: -42} -body { #<<<
	json boolean -42
} -result true
#>>>
test boolean-1.14 {Create a json boolean: truthy number: -42.5} -body { #<<<
	json boolean -42.5
} -result true
#>>>
test boolean-1.15 {Create a json boolean: truthy number: -1e6} -body { #<<<
	json boolean -1e6
} -result true
#>>>
test boolean-1.16 {Create a json boolean: truthy number: negative bignum} -body { #<<<
	json boolean [expr {-1*(2**1000-1)}]
} -result true
#>>>
test boolean-1.17 {Create a json boolean: json boolean true} -body { #<<<
	json boolean [json boolean 1]
} -result true
#>>>
test boolean-1.18 {Create a json boolean: json boolean false} -body { #<<<
	json boolean [json boolean 0]
} -result false
#>>>
test boolean-2.1 {Too few args} -body { #<<<
	set code [catch {
		json boolean
	} r o]
	list $code $r [dict get $o -errorcode]
} -result {1 {wrong # args: should be "*boolean value"} {TCL WRONGARGS}} -match glob
#>>>
test boolean-2.2 {Too many args} -body { #<<<
	set code [catch {
		json boolean foo bar
	} r o]
	list $code $r [dict get $o -errorcode]
} -result {1 {wrong # args: should be "*boolean value"} {TCL WRONGARGS}} -match glob
#>>>
test boolean-2.3 {Empty string} -body { #<<<
	set code [catch {
		json boolean ""
	} r o]
	list $code $r [dict get $o -errorcode]
} -result {1 {expected boolean value but got ""} {TCL VALUE NUMBER}}
#>>>
test boolean-2.4 {Non-truthy string} -body { #<<<
	set code [catch {
		json boolean maybe
	} r o]
	list $code $r [dict get $o -errorcode]
} -result {1 {expected boolean value but got "maybe"} {TCL VALUE NUMBER}}
#>>>

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# tab-width: 4
# End:
# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Added jni/rl_json/tests/decode.test.











































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
if {"::tcltest" ni [namespace children]} {
	package require tcltest
	namespace import ::tcltest::*
}

package require rl_json
namespace path {::rl_json}

# Helpers <<<
proc readbin fn {
	set h	[open $fn rb]
	try {read $h} finally {close $h}
}

proc unicode_string {} {
	# hello, は 🙂 world
	return "hello, \u306f [format %c 0x1F642] world"
}

if {"utf-16le" in [encoding names]} {
	proc string_to_utf16le s { encoding convertto utf-16le $s }
} else {
	proc string_to_utf16le s {
		set chars	{}
		foreach e [split $s {}] {
			scan $e %c o
			if {$o >= 0x010000} {
				set u	[expr {$o - 0x10000}]
				set w1	[expr {0b1101100000000000 | ($u >> 10)}]
				set w2	[expr {0b1101110000000000 | ($u & 0b1111111111)}]
				lappend chars $w1 $w2
			} else {
				lappend chars $o
			}
		}
		binary format su* $chars
	}
}

if {"utf-16be" in [encoding names]} {
	proc string_to_utf16be s { encoding convertto utf-16be $s }
} else {
	proc string_to_utf16be s {
		set chars	{}
		foreach e [split $s {}] {
			scan $e %c o
			if {$o >= 0x010000} {
				set u	[expr {$o - 0x10000}]
				set w1	[expr {0b1101100000000000 | ($u >> 10)}]
				set w2	[expr {0b1101110000000000 | ($u & 0b1111111111)}]
				lappend chars $w1 $w2
			} else {
				lappend chars $o
			}
		}
		binary format Su* $chars
	}
}

proc string_to_utf32le s {
	binary format iu* [lmap e [split $s {}] {scan $e %c o; set o}]
}

proc string_to_utf32be s {
	binary format Iu* [lmap e [split $s {}] {scan $e %c o; set o}]
}

#>>>

test decode-0.1 {Too few args} -body { #<<<
	list [catch {json decode} r o] $r [dict get $o -errorcode]
} -cleanup {
	unset -nocomplain r o
} -result {1 {wrong # args: should be "*decode bytes ?encoding?"} {TCL WRONGARGS}} -match glob
#>>>
test decode-0.2 {Too many args} -body { #<<<
	list [catch {json decode foo auto bar} r o] $r [dict get $o -errorcode]
} -cleanup {
	unset -nocomplain r o
} -result {1 {wrong # args: should be "*decode bytes ?encoding?"} {TCL WRONGARGS}} -match glob
#>>>
test decode-0.3 {No optional encoding arg} -body { #<<<
	json decode foo
} -result foo
#>>>
test decode-1.1 {Decode utf-8, no BOM} -body { #<<<
	json decode [encoding convertto utf-8 [unicode_string]]
} -result [unicode_string]
#>>>
test decode-1.2 {Decode utf-8, BOM} -body { #<<<
	json decode [binary decode hex {EF BB BF}][encoding convertto utf-8 [unicode_string]]
} -result \uFEFF[unicode_string]
#>>>
test decode-2.1 {Decode utf-16le, no BOM, explicit encoding} -body { #<<<
	json decode [string_to_utf16le [unicode_string]] utf-16le
} -result [unicode_string]
#>>>
test decode-2.2 {Decode utf-16le, BOM} -body { #<<<
	json decode [binary decode hex {FF FE}][string_to_utf16le [unicode_string]]
} -result \uFEFF[unicode_string]
#>>>
test decode-3.1 {Decode utf-16be, no BOM, explicit encoding} -body { #<<<
	json decode [string_to_utf16be [unicode_string]] utf-16be
} -result [unicode_string]
#>>>
test decode-3.2 {Decode utf-16be, BOM} -body { #<<<
	json decode [binary decode hex {FE FF}][string_to_utf16be [unicode_string]]
} -result \uFEFF[unicode_string]
#>>>
test decode-4.1 {Decode utf-32le, no BOM, explicit encoding} -body { #<<<
	json decode [string_to_utf32le [unicode_string]] utf-32le
} -result [unicode_string]
#>>>
test decode-4.2 {Decode utf-32le, BOM} -body { #<<<
	json decode [binary decode hex {FF FE 00 00}][string_to_utf32le [unicode_string]]
} -result \uFEFF[unicode_string]
#>>>
test decode-5.1 {Decode utf-32be, no BOM, explicit encoding} -body { #<<<
	json decode [string_to_utf32be [unicode_string]] utf-32be
} -result [unicode_string]
#>>>
test decode-5.2 {Decode utf-32be, BOM} -body { #<<<
	json decode [binary decode hex {00 00 FE FF}][string_to_utf32be [unicode_string]]
} -result \uFEFF[unicode_string]
#>>>
test decode-6.1 {Decode utf-16le, no BOM, explicit encoding, force manual decode} -body { #<<<
	json decode [string_to_utf16le [unicode_string]] "x utf-16le"
} -result [unicode_string]
#>>>
test decode-6.2 {Decode utf-16le, BOM, force manual decode} -body { #<<<
	json decode [binary decode hex {FF FE}][string_to_utf16le [unicode_string]] "x utf-16le"
} -result \uFEFF[unicode_string]
#>>>
test decode-7.1 {Decode utf-16be, no BOM, explicit encoding, force manual decode} -body { #<<<
	json decode [string_to_utf16be [unicode_string]] "x utf-16be"
} -result [unicode_string]
#>>>
test decode-7.2 {Decode utf-16be, BOM, force manual decode} -body { #<<<
	json decode [binary decode hex {FE FF}][string_to_utf16be [unicode_string]] "x utf-16be"
} -result \uFEFF[unicode_string]
#>>>
test decode-8.1 {Decode utf-32le, no BOM, explicit encoding, force manual decode} -body { #<<<
	json decode [string_to_utf32le [unicode_string]]  utf-32le
} -result [unicode_string]
#>>>
test decode-8.2 {Decode utf-32le, BOM, force manual decode} -body { #<<<
	json decode [binary decode hex {FF FE 00 00}][string_to_utf32le [unicode_string]] utf-32le
} -result \uFEFF[unicode_string]
#>>>
test decode-9.1 {Decode utf-32be, no BOM, explicit encoding, force manual decode} -body { #<<<
	json decode [string_to_utf32be [unicode_string]] utf-32be
} -result [unicode_string]
#>>>
test decode-9.2 {Decode utf-32be, BOM, force manual decode} -body { #<<<
	json decode [binary decode hex {00 00 FE FF}][string_to_utf32be [unicode_string]] utf-32be
} -result \uFEFF[unicode_string]
#>>>
test decode-10.1 {Decode utf-32le, no BOM, explicit encoding, force manual decode} -body { #<<<
	json decode [string_to_utf32le [unicode_string]] "x utf-32le"
} -result [unicode_string]
#>>>
test decode-10.2 {Decode utf-32le, BOM, force manual decode} -body { #<<<
	json decode [binary decode hex {FF FE 00 00}][string_to_utf32le [unicode_string]] "x utf-32le"
} -result \uFEFF[unicode_string]
#>>>
test decode-11.1 {Decode utf-32be, no BOM, explicit encoding, force manual decode} -body { #<<<
	json decode [string_to_utf32be [unicode_string]] "x utf-32be"
} -result [unicode_string]
#>>>
test decode-11.2 {Decode utf-32be, BOM, force manual decode} -body { #<<<
	json decode [binary decode hex {00 00 FE FF}][string_to_utf32be [unicode_string]] "x utf-32be"
} -result \uFEFF[unicode_string]
#>>>

::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4



Changes to jni/rl_json/tests/exists.test.

107
108
109
110
111
112
113




















114
115
116
117
118
119
120
test exists-7.6 {exists for invalid value - truncated boolean: false} -body { #<<<
	json exists {fals} foo
} -result 0
#>>>
test exists-7.7 {exists for invalid value - truncated null} -body { #<<<
	json exists {nul} foo
} -result 0




















#>>>

# Modifiers - ?type
test exists-20.1 {type modifier, string} -body { #<<<
	json exists {
		{
			"foo": "bar",







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







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
test exists-7.6 {exists for invalid value - truncated boolean: false} -body { #<<<
	json exists {fals} foo
} -result 0
#>>>
test exists-7.7 {exists for invalid value - truncated null} -body { #<<<
	json exists {nul} foo
} -result 0
#>>>
test exists-8.1 {exists on an atomic value - string} -body { #<<<
	json exists {"foo"}
} -result 1
#>>>
test exists-8.2 {exists on an atomic value - number} -body { #<<<
	json exists 123
} -result 1
#>>>
test exists-8.3 {exists on an atomic value - bool: true} -body { #<<<
	json exists true
} -result 1
#>>>
test exists-8.4 {exists on an atomic value - bool: false} -body { #<<<
	json exists false
} -result 1
#>>>
test exists-8.5 {exists on an atomic value - null} -body { #<<<
	json exists null
} -result 0
#>>>

# Modifiers - ?type
test exists-20.1 {type modifier, string} -body { #<<<
	json exists {
		{
			"foo": "bar",

Changes to jni/rl_json/tests/foreach.test.

243
244
245
246
247
248
249
250

















































251
252
253
254
	{3("other var")(other var)/(null)()} \
	4(null)()/(null)() \
	5(true)(1)/(null)() \
	"6(false)(0)/(null)()" \
	"7({\"x\":42})(x 42)/(null)()" \
]
#>>>


















































::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4








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




243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	{3("other var")(other var)/(null)()} \
	4(null)()/(null)() \
	5(true)(1)/(null)() \
	"6(false)(0)/(null)()" \
	"7({\"x\":42})(x 42)/(null)()" \
]
#>>>

test foreach-20.1 {over string} -body { # TODO: perhaps allow this, and iterate over characters? <<<
	json foreach x {"foo"} {
		lappend res	$x
	}
	set res
} -cleanup {
	unset -nocomplain x res
} -returnCodes error -result {Cannot iterate over JSON type string}
#>>>
test foreach-20.2 {over number} -body { #<<<
	json foreach x {123} {
		lappend res	$x
	}
	set res
} -cleanup {
	unset -nocomplain x res
} -returnCodes error -result {Cannot iterate over JSON type number}
#>>>
test foreach-20.3 {over true} -body { #<<<
	json foreach x {true} {
		lappend res	$x
	}
	set res
} -cleanup {
	unset -nocomplain x res
} -returnCodes error -result {Cannot iterate over JSON type boolean}
#>>>
test foreach-20.4 {over false} -body { #<<<
	json foreach x {false} {
		lappend res	$x
	}
	set res
} -cleanup {
	unset -nocomplain x res
} -returnCodes error -result {Cannot iterate over JSON type boolean}
#>>>
test foreach-20.5 {too few args} -body { #<<<
	list [catch {json foreach x {[]}} r o] $r [dict get $o -errorcode]
} -cleanup {
	unset -nocomplain x y r o
} -result {1 {wrong # args: should be "*foreach ?varlist datalist ...? script"} {TCL WRONGARGS}} -match glob
#>>>
test foreach-20.6 {too many args} -body { #<<<
	list [catch {json foreach x {[]} y {}} r o] $r [dict get $o -errorcode]
} -cleanup {
	unset -nocomplain x y r o
} -result {1 {wrong # args: should be "*foreach ?varlist datalist ...? script"} {TCL WRONGARGS}} -match glob
#>>>

::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Changes to jni/rl_json/tests/get.test.

875
876
877
878
879
880
881
































882
883
884
885
886
887
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
































#>>>

::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4







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






875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>
test get-60.23 {invalid path: subscribed atomic: template invalid} -body { #<<<
	json get {
		{
			"foo": "~X:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz en
} -returnCodes error -result {Expected an integer index or end(-integer)?, got en}
#>>>
test get-60.24 {invalid path: subscribed atomic: template invalid} -body { #<<<
	json get {
		{
			"foo": "~X:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz foo
} -returnCodes error -result {Expected an integer index or end(-integer)?, got foo}
#>>>
test get-60.25 {Get a template point} -body { #<<<
	json get {
		{
			"foo": "~S:bar"
		}
	} foo
} -result {~S:bar}
#>>>

::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

Deleted jni/rl_json/tests/get_typed.test.

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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
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
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
if {"::tcltest" ni [namespace children]} {
	package require tcltest
	namespace import ::tcltest::*
}

package require rl_json
namespace path {::rl_json}

test get_typed-1.1 {get_typed a value from an object} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} foo
} -result {bar string}
#>>>
test get_typed-2.1 {get_typed a value from an object} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz
} -result [list [list str 123 123.4 1 0 "" {inner obj}] array]
#>>>
test get_typed-3.1 {get_typed a value from a nested object} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz": {
				"query": "filtered"
			}
		}
	} baz query
} -result {filtered string}
#>>>
test get_typed-4.1 {get_typed a value from an array} -body { #<<<
	json get_typed {["a", "b", "c", "d"]} 2
} -result {c string}
#>>>
test get_typed-4.4 {get_typed an index from an array relative to the end} -body { #<<<
	json get_typed {["a", "b", "c", "d"]} end
} -result {d string}
#>>>
test get_typed-4.5 {get_typed an index from an array relative to the end} -body { #<<<
	json get_typed {["a", "b", "c", "d"]} end-2
} -result {b string}
#>>>
test get_typed-4.6 {get_typed an index from an array relative to the end} -body { #<<<
	json get_typed {["a", "b", "c", "d"]} end-4
} -result [list "" null]
#>>>
test get_typed-5.1 {get_typed a value from an array in an object} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 2
} -result {123.4 number}
#>>>
test get_typed-6.1 {get_typed of a toplevel value} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	}
} -result [list [dict create foo bar baz [list str 123 123.4 1 0 "" [dict create inner obj]]] object]
#>>>
test get_typed-7.1 {get_typed for invalid value - empty string} -body { #<<<
	json get_typed {} foo
} -returnCodes error -result {Error parsing JSON value: No JSON value found at offset 0}
#>>>
test get_typed-7.2 {get_typed for invalid value - truncated object} -body { #<<<
	json get_typed "\{\"foo\":\"bar\"" foo
} -returnCodes error -result {Error parsing JSON value: Unterminated object at offset 0}
#>>>
test get_typed-7.3 {get_typed for invalid value - truncated array} -body { #<<<
	json get_typed {["foo", "bar"} 1
} -returnCodes error -result {Error parsing JSON value: Unterminated array at offset 0}
#>>>
test get_typed-7.4 {get_typed for invalid value - truncated string} -body { #<<<
	json get_typed {"foo} foo
} -returnCodes error -result {Error parsing JSON value: Document truncated at offset 4}
#>>>
test get_typed-7.5 {get_typed for invalid value - truncated boolean: true} -body { #<<<
	json get_typed {tru} foo
} -returnCodes error -result {Error parsing JSON value: Illegal character at offset 0}
#>>>
test get_typed-7.6 {get_typed for invalid value - truncated boolean: false} -body { #<<<
	json get_typed {fals} foo
} -returnCodes error -result {Error parsing JSON value: Illegal character at offset 0}
#>>>
test get_typed-7.7 {get_typed for invalid value - truncated null} -body { #<<<
	json get_typed {nul} foo
} -returnCodes error -result {Error parsing JSON value: Illegal character at offset 0}
#>>>

# Modifiers - ?type
test get_typed-20.1 {type modifier, string} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} foo ?type
} -result string
#>>>
test get_typed-20.2 {type modifier, array} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz ?type
} -result array
#>>>
test get_typed-20.3 {type modifier, number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 1 ?type
} -result number
#>>>
test get_typed-20.4 {type modifier, boolean} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 3 ?type
} -result boolean
#>>>
test get_typed-20.5 {type modifier, null} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 5 ?type
} -result null
#>>>
test get_typed-20.6 {type modifier, object} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 6 ?type
} -result object
#>>>
test get_typed-20.7 {type modifier, template subst: string} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~S:dynamic"
		}
	} something ?type
} -result string
#>>>
test get_typed-20.8 {type modifier, template subst: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~N:dynamic"
		}
	} something ?type
} -result string
#>>>
test get_typed-20.9 {type modifier, template subst: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~B:dynamic"
		}
	} something ?type
} -result string
#>>>
test get_typed-20.10 {type modifier, template subst: literal} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~L:dynamic"
		}
	} something ?type
} -result string
#>>>
test get_typed-20.11 {type modifier, template subst: json doc} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~J:dynamic"
		}
	} something ?type
} -result string
#>>>
test get_typed-20.12 {type modifier, template subst: json template} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~T:dynamic"
		}
	} something ?type
} -result string
#>>>
test get_typed-20.13 {type modifier, template subst: invalid} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~X:dynamic"
		}
	} something ?type
} -result string
#>>>

# Modifiers - ?length
test get_typed-21.1 {length modifier, string} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} foo ?length
} -result 3
#>>>
test get_typed-21.2 {length modifier, array} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz ?length
} -result 7
#>>>
test get_typed-21.3 {length modifier, number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 1 ?length
} -returnCodes error -result {?length modifier is not supported for type number}
#>>>
test get_typed-21.4 {length modifier, boolean} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 3 ?length
} -returnCodes error -result {?length modifier is not supported for type boolean}
#>>>
test get_typed-21.5 {length modifier, null} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 5 ?length
} -returnCodes error -result {?length modifier is not supported for type null}
#>>>
test get_typed-21.6 {length modifier, object} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 6 ?length
} -returnCodes error -result {?length modifier is not supported for type object}
#>>>
test get_typed-21.7 {length modifier, template subst: string} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~S:dynamic"
		}
	} something ?length
} -result 10
#>>>
test get_typed-21.8 {length modifier, template subst: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~N:dynamic"
		}
	} something ?length
} -result 10
#>>>
test get_typed-21.9 {length modifier, template subst: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~B:dynamic"
		}
	} something ?length
} -result 10
#>>>
test get_typed-21.10 {length modifier, template subst: literal} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~L:dynamic"
		}
	} something ?length
} -result 10
#>>>
test get_typed-21.11 {length modifier, template subst: json doc} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~J:dynamic"
		}
	} something ?length
} -result 10
#>>>
test get_typed-21.12 {length modifier, template subst: json template} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~T:dynamic"
		}
	} something ?length
} -result 10
#>>>
test get_typed-21.13 {length modifier, template subst: invalid} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~X:dynamic"
		}
	} something ?length
} -result 10
#>>>

# Modifiers - ?size
test get_typed-22.1 {size modifier, string} -body { #<<<
	json get_typed {
		{
			"foo": "bar x",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} foo ?size
} -returnCodes error -result {?size modifier is not supported for type string}
#>>>
test get_typed-22.2 {size modifier, array} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz ?size
} -returnCodes error -result {?size modifier is not supported for type array}
#>>>
test get_typed-22.3 {size modifier, number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 1 ?size
} -returnCodes error -result {?size modifier is not supported for type number}
#>>>
test get_typed-22.4 {size modifier, boolean} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 3 ?size
} -returnCodes error -result {?size modifier is not supported for type boolean}
#>>>
test get_typed-22.5 {size modifier, null} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 5 ?size
} -returnCodes error -result {?size modifier is not supported for type null}
#>>>
test get_typed-22.6 {size modifier, object} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj", "x": "y", "z": null}]
		}
	} baz 6 ?size
} -result 3
#>>>
test get_typed-22.7 {size modifier, template subst: string} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~S:dynamic"
		}
	} something ?size
} -returnCodes error -result {?size modifier is not supported for type string}
#>>>
test get_typed-22.8 {size modifier, template subst: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~N:dynamic"
		}
	} something ?size
} -returnCodes error -result {?size modifier is not supported for type string}
#>>>
test get_typed-22.9 {size modifier, template subst: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~B:dynamic"
		}
	} something ?size
} -returnCodes error -result {?size modifier is not supported for type string}
#>>>
test get_typed-22.10 {size modifier, template subst: literal} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~L:dynamic"
		}
	} something ?size
} -returnCodes error -result {?size modifier is not supported for type string}
#>>>
test get_typed-22.11 {size modifier, template subst: json doc} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~J:dynamic"
		}
	} something ?size
} -returnCodes error -result {?size modifier is not supported for type string}
#>>>
test get_typed-22.12 {size modifier, template subst: json template} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~T:dynamic"
		}
	} something ?size
} -returnCodes error -result {?size modifier is not supported for type string}
#>>>
test get_typed-22.13 {size modifier, template subst: invalid} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~X:dynamic"
		}
	} something ?size
} -returnCodes error -result {?size modifier is not supported for type string}
#>>>

# Modifiers - ?keys
test get_typed-23.1 {keys modifier, string} -body { #<<<
	json get_typed {
		{
			"foo": "bar x",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} foo ?keys
} -returnCodes error -result {?keys modifier is not supported for type string}
#>>>
test get_typed-23.2 {keys modifier, array} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz ?keys
} -returnCodes error -result {?keys modifier is not supported for type array}
#>>>
test get_typed-23.3 {keys modifier, number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 1 ?keys
} -returnCodes error -result {?keys modifier is not supported for type number}
#>>>
test get_typed-23.4 {keys modifier, boolean} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 3 ?keys
} -returnCodes error -result {?keys modifier is not supported for type boolean}
#>>>
test get_typed-23.5 {keys modifier, null} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	} baz 5 ?keys
} -returnCodes error -result {?keys modifier is not supported for type null}
#>>>
test get_typed-23.6 {keys modifier, object} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj", "x": "y", "z": null}]
		}
	} baz 6 ?keys
} -result [list {inner x z}]
#>>>
test get_typed-23.7 {keys modifier, template subst: string} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~S:dynamic"
		}
	} something ?keys
} -returnCodes error -result {?keys modifier is not supported for type string}
#>>>
test get_typed-23.8 {keys modifier, template subst: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~N:dynamic"
		}
	} something ?keys
} -returnCodes error -result {?keys modifier is not supported for type string}
#>>>
test get_typed-23.9 {keys modifier, template subst: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~B:dynamic"
		}
	} something ?keys
} -returnCodes error -result {?keys modifier is not supported for type string}
#>>>
test get_typed-23.10 {keys modifier, template subst: literal} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~L:dynamic"
		}
	} something ?keys
} -returnCodes error -result {?keys modifier is not supported for type string}
#>>>
test get_typed-23.11 {keys modifier, template subst: json doc} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~J:dynamic"
		}
	} something ?keys
} -returnCodes error -result {?keys modifier is not supported for type string}
#>>>
test get_typed-23.12 {keys modifier, template subst: json template} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~T:dynamic"
		}
	} something ?keys
} -returnCodes error -result {?keys modifier is not supported for type string}
#>>>
test get_typed-23.13 {keys modifier, template subst: invalid} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": "~X:dynamic"
		}
	} something ?keys
} -returnCodes error -result {?keys modifier is not supported for type string}
#>>>

test get_typed-50.1 {escaping a modifier} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} something ??type
} -result {fromdoc string}
#>>>

# Invalid paths
test get_typed-60.1 {invalid path: missing key} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} blah
} -returnCodes error -result {Path element 2: "blah" not found}
#>>>
test get_typed-60.2 {invalid path: subscribed atomic: string} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>
test get_typed-60.3 {invalid path: subscribed atomic: number} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz 1 blah
} -returnCodes error -result {Cannot descend into atomic type "number" with path element 3: "blah"}
#>>>
test get_typed-60.4 {invalid path: subscribed atomic: boolean} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz 3 blah
} -returnCodes error -result {Cannot descend into atomic type "boolean" with path element 3: "blah"}
#>>>
test get_typed-60.5 {invalid path: subscribed atomic: null} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz 5 blah
} -returnCodes error -result {Cannot descend into atomic type "null" with path element 3: "blah"}
#>>>
test get_typed-60.6 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz blah
} -returnCodes error -result {Expected an integer index or end(-integer)?, got blah}
#>>>
test get_typed-60.7 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz end-12
} -result [list "" null]
#>>>
test get_typed-60.8 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz 100
} -result [list "" null]
#>>>
test get_typed-60.9 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz -2
} -result [list "" null]
#>>>
test get_typed-60.10 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz end-2foo
} -returnCodes error -result {Expected an integer index or end(-integer)?, got end-2foo}
#>>>
test get_typed-60.11 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz end-foo
} -returnCodes error -result {Expected an integer index or end(-integer)?, got end-foo}
#>>>
test get_typed-60.12 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz end2
} -returnCodes error -result {Expected an integer index or end(-integer)?, got end2}
#>>>
test get_typed-60.13 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz end+2
} -returnCodes error -result {Expected an integer index or end(-integer)?, got end+2}
#>>>
test get_typed-60.14 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz "end- 2"
} -returnCodes error -result {Expected an integer index or end(-integer)?, got end- 2}
#>>>
test get_typed-60.15 {invalid path: invalid array index} -body { #<<<
	json get_typed {
		{
			"foo": "bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} baz end-
} -returnCodes error -result {Expected an integer index or end(-integer)?, got end-}
#>>>
test get_typed-60.16 {invalid path: subscribed atomic: template string} -body { #<<<
	json get_typed {
		{
			"foo": "~S:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>
test get_typed-60.17 {invalid path: subscribed atomic: template number} -body { #<<<
	json get_typed {
		{
			"foo": "~N:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>
test get_typed-60.18 {invalid path: subscribed atomic: template boolean} -body { #<<<
	json get_typed {
		{
			"foo": "~B:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>
test get_typed-60.19 {invalid path: subscribed atomic: template json doc} -body { #<<<
	json get_typed {
		{
			"foo": "~J:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>
test get_typed-60.20 {invalid path: subscribed atomic: template json template} -body { #<<<
	json get_typed {
		{
			"foo": "~T:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>
test get_typed-60.21 {invalid path: subscribed atomic: template literal} -body { #<<<
	json get_typed {
		{
			"foo": "~L:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>
test get_typed-60.22 {invalid path: subscribed atomic: template invalid} -body { #<<<
	json get_typed {
		{
			"foo": "~X:bar",
			"baz":  ["str", 123, 123.4, true, false, null, {"inner": "obj"}],
			"something": {
				"?type": "fromdoc"
			}
		}
	} foo blah
} -returnCodes error -result {Cannot descend into atomic type "string" with path element 2: "blah"}
#>>>

::tcltest::cleanupTests
return

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<














































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































Changes to jni/rl_json/tests/helpers.tcl.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
				append msg ", at path $path"
			}
			throw {RL TEST JSON_MISMATCH} $msg
		}
	}

	try {
		json get $j1 ?type
	} on error errmsg {
		apply $mismatch "Cannot parse left JSON value:\n$errmsg"
	} on ok j1_type {}

	try {
		json get $j2 ?type
	} on error errmsg {
		apply $mismatch "Cannot parse right JSON value:\n$errmsg"
	} on ok j2_type {}

	set j1_val	[json get $j1]
	set j2_val	[json get $j2]








|





|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
				append msg ", at path $path"
			}
			throw {RL TEST JSON_MISMATCH} $msg
		}
	}

	try {
		json type $j1
	} on error errmsg {
		apply $mismatch "Cannot parse left JSON value:\n$errmsg"
	} on ok j1_type {}

	try {
		json type $j2
	} on error errmsg {
		apply $mismatch "Cannot parse right JSON value:\n$errmsg"
	} on ok j2_type {}

	set j1_val	[json get $j1]
	set j2_val	[json get $j2]

Added jni/rl_json/tests/jsontestsuite.test.





















































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
if {"::tcltest" ni [namespace children]} {
	package require tcltest
	namespace import ::tcltest::*
}

package require rl_json
namespace path {::rl_json}

proc readbin fn {
	set h	[open $fn rb]
	try {read $h} finally {close $h}
}

foreach file [glob -nocomplain -type f [file join [file dirname [info script]] JSONTestSuite test_parsing *.json]] {
	if {![regexp {/([yni])_([^/]+)\.json$} $file - expected name]} {
		puts stderr "Could not interpret test case filename \"$file\""
		continue
	}

	set encoding	auto

	# outcomes overrides: comments, etc
	switch -- $name {
		object_trailing_comment_slash_open -
		structure_object_with_comment -
		object_trailing_comment {
			# Comments are supported by default, but can be disabled - test both
			set expected comment
		}

		string_utf16BE_no_BOM {
			# UTF-16 files without a BOM need an out-of-band signal to indicate the encoding
			set encoding utf-16be
		}

		string_utf16LE_no_BOM {
			# UTF-16 files without a BOM need an out-of-band signal to indicate the encoding
			set encoding utf-16le
		}
	}

	set cmd	[list test jsontestsuite-$name ${expected}_$name -match glob -result * -body]
	lappend cmd	[string map [list %file% [list $file] %encoding% [list $encoding]] {
		json normalize [json decode [readbin %file%] %encoding%]
	}]
	if {$expected eq "n"} {
		lappend cmd -returnCodes error
	}
	{*}$cmd

	switch -- $expected {
		y - i {
			set cmd	[list test jsontestsuite_valid-$name ${expected}_$name -result 1 -body]
			lappend cmd	[string map [list %file% [list $file] %encoding% [list $encoding]] {
				json valid [json decode [readbin %file%] %encoding%]
			}]
			{*}$cmd
		}

		n {
			set cmd	[list test jsontestsuite_valid-$name ${expected}_$name -result 0 -body]
			lappend cmd	[string map [list %file% [list $file] %encoding% [list $encoding]] {
				json valid [json decode [readbin %file%] %encoding%]
			}]
			{*}$cmd
		}

		comment {
			set cmd	[list test jsontestsuite_valid-$name-1 ${expected}_$name -result 0 -body]
			lappend cmd	[string map [list %file% [list $file] %encoding% [list $encoding]] {
				json valid -extensions {} [json decode [readbin %file%] %encoding%]
			}]
			{*}$cmd

			set cmd	[list test jsontestsuite_valid-$name-2 ${expected}_$name -result 1 -body]
			lappend cmd	[string map [list %file% [list $file] %encoding% [list $encoding]] {
				json valid -extensions {comments} [json decode [readbin %file%] %encoding%]
			}]
			{*}$cmd
		}

		default {
			error "Unexpected expected value: \"$expected\""
		}
	}
}

foreach file [glob -nocomplain -type f [file join [file dirname [info script]] JSONTestSuite test_transform *.json]] {
	if {![regexp {/([^/]+)\.json$} $file - name]} {
		puts stderr "Could not interpret test case filename \"$file\""
		continue
	}

	set encoding	auto

	set result		[string trim [json decode [readbin $file]]]

	# Overrides for our intended behaviours in various situations
	switch -- $name {
		object_same_key_different_values {