Types edit

Examples edit

Format

Usage

json::encode

% json::encode {string hello}
"hello"
% json::encode {number 42}
42
% json::encode {literal null}
null
% json::encode {array {{string hello} {number 42} {literal null}}}
["hello",42,null]
% json::encode {object {foo {string hello} bar {number 42} quux {literal null}}}
{"foo":"hello","bar":42,"quux":null}
% json::encode {array {{array {{number 1} {number 2}}} {array {{number 3} {number 4}}}}}
[[1,2],[3,4]]
% json::encode {{array {array number}} {{1 2} {3 4}}}
[[1,2],[3,4]]
% json::encode {{array array number} {{1 2} {3 4}}}
[[1,2],[3,4]]
% json::encode {{array array string} {{1 2} {3 4}}}
[["1","2"],["3","4"]]
% json::encode {{object object string} {name {first Andy last Goth} address {web http://tcl.tk/}}}
{"name":{"first":"Andy","last":"Goth"},"address":{"web":"http://tcl.tk/"}}

json::decode

% json::decode {"hello"}
string hello
% json::decode 42
number 42
% json::decode null
literal null
% json::decode {["hello",42,null]}
array {{string hello} {number 42} {literal null}}
% json::decode {{"foo":"hello","bar":42,"quux":null}}
object {foo {string hello} bar {number 42} quux {literal null}}
% json::decode {[[1,2],[3,4]]}
array {{array {{number 1} {number 2}}} {array {{number 3} {number 4}}}}
% json::decode {{"name":{"first":"Andy","last":"Goth"},"address":{"web":"http://tcl.tk/"}}}
object {name {object {first {string Andy} last {string Goth}}} address {object {web {string http://tcl.tk/}}}}

json::schema

% json::schema [json::decode {{"name":{"first":"Andy","last":"Goth"},"address":{"web":"http://tcl.tk/"}}}]
object {name {object {first string last string}} address {object {web string}}}
% json::schema [json::decode {"foo":"hello","bar":42,"quux":null}]
object {foo string bar number quux literal}

json::values

% json::values [json::decode {{"name":{"first":"Andy","last":"Goth"},"address":{"web":"http://tcl.tk/"}}}]
name {first Andy last Goth} address {web http://tcl.tk/}
% json::values [json::decode {"foo":"hello","bar":42,"quux":null}]
foo hello bar 42 quux null

json::unite

% json::unite {object {name {object {first string last string}} address {object {web string}}}} {name {first Andy last Goth} address {web http://tcl.tk/}}
object {name {object {first {string Andy} last {string Goth}}} address {object {web {string http://tcl.tk/}}}}
% json::unite {object {foo string bar number quux literal}} {foo hello bar 42 quux null}
{object {foo {string hello} bar {number 42} quux {literal null}}}

Comparisons edit

Tcllib JSON

json::json2dict

json::many-json2dict

json::write string|array|object

json::encode {object {
    name {object {
        first {string Andy}
        last {string Goth}
    }} address {object {
        web {string http://tcl.tk/}
    }}
}}

json::write object\
    name [json::write object\
        first [json::write string Andy]\
        last [json::write string Goth]\
    ] address [json::write object\
        web [json::write string http://tcl.tk/]\
    ]

{"name":{"first":"Andy","last":"Goth"},"address":{"web":"http://tcl.tk/"}}

{
    "name"    : {
        "first" : "Andy",
        "last"  : "Goth"
    },
    "address" : {
        "web" : "http://tcl.tk/"
    }
}

{"name":{"first":"Andy","last":"Goth"},"address":{"web":"http://tcl.tk/"}}

json::write indented|aligned

huddle

% json::encode {array {{array {{number 1} {number 2}}} {array {{number 3} {number 4}}}}}
[[1,2],[3,4]]

% json::encode {{array array number} {{1 2} {3 4}}}
[[1,2],[3,4]]

% huddle list [huddle list [huddle number 1] [huddle number 2]] [huddle list [huddle number 3] [huddle number 4]]
HUDDLE {L {{L {{num 1} {num 2}}} {L {{num 3} {num 4}}}}}
% huddle jsondump {HUDDLE {L {{L {{num 1} {num 2}}} {L {{num 3} {num 4}}}}}}
[
  [
    1,
    2
  ],
  [
    3,
    4
  ]
]
% huddle compile {list list} {{1 2} {3 4}}
HUDDLE {L {{L {{s 1} {s 2}}} {L {{s 3} {s 4}}}}}

Bugs edit

Inconsistency between tagged data and isolated schemas

% json::encode {{array number} {1 2 3 4}}
[1,2,3,4]
% json::encode [json::unite {array number} {1 2 3 4}]
[1,2,3,4]

% json::encode {{array {number string}} {1 a 2 b}}
invalid JSON type "number string"
% json::encode [json::unite {array {number string}} {1 a 2 b}]
[1,"a",2,"b"]

% json::encode {{array array number} {{1 2} {3 4}}}
[[1,2],[3,4]]
% json::encode [json::unite {array array number} {{1 2} {3 4}}]
invalid JSON data: must be a two-element list with second element being list of array element types
% json::encode [json::unite {array {array number}} {{1 2} {3 4}}]
invalid JSON data: must be a two-element list with second element being list of array element types

TODO/ideas edit

• Indent (pretty print) options for [json::encode]
• Type compression options for [json::decode], [json::schema], and [json::unite]
• Tests for [json::decode] whitespace tolerance
• Tests for error detection
• Submit to tcllib as an alternative to huddle and Tcllib JSON
• Bloat into a package that supports not only JSON but also XML, YAML, TDL, huddle, EBML, ASN.1, Tclon, vrtcl, etc. (See: Category Data Serialization Format)
• Fix the Tcler's Wiki syntax highlight JavaScript to not butcher this code

See also edit

• huddle
• Tcllib JSON

Prerequisites edit

forward-compatible lassign

Code edit

namespace eval ::json {}

# ::json::encode --
# Encodes data in the JSON format per https://tools.ietf.org/html/rfc7159.
proc ::json::encode {data} {
    # Extract type and value from data argument.
    if {[llength $data] != 2} {
        error "invalid JSON data: must be a two-element list consisting of\
                type and value"
    }
    lassign $data type value

    # Extract top and subtype from type element.
    set toptype [lindex $type 0]
    if {[llength $type] >= 2} {
        if {[llength $type] == 2} {
            set subtype [lindex $type 1]
        } else {
            set subtype [lrange $type 1 end]
        }
        if {$toptype ni {array object}} {
            set toptype {}
        }
    }

    # Perform type-specific JSON encoding.
    switch $toptype {
    array {
        # Recursively encode each array element.  If a subtype was specified, it
        # is shared between all elements.  Otherwise, each element is itself a
        # two-element list consisting of type and value.
        set comma {}
        set result \[
        foreach element $value {
            append result $comma
            set comma ,
            if {[info exists subtype]} {
                append result [encode [list $subtype $element]]
            } else {
                append result [encode $element]
            }
        }
        append result \]
        return $result
    } object {
        # Recursively encode each object key and element.  Keys are always
        # strings.  If a subtype was specified, it is shared between all
        # elements.  Otherwise, each element is itself a two-element list
        # consisting of type and underlying data value.
        set comma {}
        set result \{
        foreach {key element} $value {
            append result $comma
            set comma ,
            append result [encode [list string $key]] :
            if {[info exists subtype]} {
                append result [encode [list $subtype $element]]
            } else {
                append result [encode $element]
            }
        }
        append result \}
        return $result
    } string {
        # Encode the minimal set of required escape sequences.
        return \"[string map {
            \x00 \\u0000    \x01 \\u0001    \x02 \\u0002    \x03 \\u0003
            \x04 \\u0004    \x05 \\u0005    \x06 \\u0006    \x07 \\u0007
            \x08 \\u0008    \x09 \\u0009    \x0a \\u000a    \x0b \\u000b
            \x0c \\u000c    \x0d \\u000d    \x0e \\u000e    \x0f \\u000f
            \x10 \\u0010    \x11 \\u0011    \x12 \\u0012    \x13 \\u0013
            \x14 \\u0014    \x15 \\u0015    \x16 \\u0016    \x17 \\u0017
            \x18 \\u0018    \x19 \\u0019    \x1a \\u001a    \x1b \\u001b
            \x1c \\u001c    \x1d \\u001d    \x1e \\u001e    \x1f \\u001f
            \\   \\\\       \"   \\\"
        } $value]\"
    } number {
        # Attempt to normalize the number to comply with the JSON standard.
        regsub {^[\f\n\r\t\v ]+} $value {} result     ;# Strip leading space.
        regsub {[\f\n\r\t\v ]+$} $result {} result    ;# Strip trailing space.
        regsub {^\+(?=[\d.])} $result {} result       ;# Strip leading plus.
        regsub {^(-?)0+(?=\d)} $result {\1} result    ;# Strip leading zeroes.
        regsub {(\.\d*[1-9])0+} $result {\1} result   ;# Strip trailing zeroes.
        regsub {E} $result {e} result                 ;# Normalize exponent, 1.
        regsub {^(-?\d+)e} $result {\1.0e} result     ;# Normalize exponent, 2.
        regsub {\.e} $result {.0e} result             ;# Normalize exponent, 3.
        regsub {e(\d)} $result {e+\1} result          ;# Normalize exponent, 4.
        regsub {(^|-)\.(?=\d)} $result {\10.} result  ;# Prefix leading dot.
        regsub {(\d)\.(?=\D|$)} $result {\1.0} result ;# Suffix trailing dot.
        if {![regexp {^-?(?:0|[1-9]\d*)(?:\.\d+)?(?:[eE][-+]?\d+)?$} $result]} {
            error "invalid JSON number \"$value\":\
                    see https://tools.ietf.org/html/rfc7159#section-6"
        }
        return $result
    } literal {
        # The only valid literals are false, null, and true.
        if {$value ni {false null true}} {
            error "invalid JSON literal \"$value\":\
                    must be false, null, or true"
        }
        return $value
    } encoded {
        # Raw data.  The caller must supply correctly formatted JSON.
        return $value
    } decoded {
        # Nested decoded data.
        encode $value
    } default {
        # Invalid type.
        error "invalid JSON type \"$type\": must be array, object, string,\
                number, literal, encoded, decoded, or {array|object ?...?\
                subtype}, where subtype is recursively any valid JSON type"
    }}
}

# ::json::decode --
# Decodes data from the JSON format per https://tools.ietf.org/html/rfc7159.
# The optional indexVar argument is the name of a variable that holds the index
# at which decoding begins (defaults to 0 if the variable doesn't exist) and
# will hold the index immediately following the end of the decoded element.  If
# indexVar is not specified, the entire JSON input is decoded, and it is an
# error for it to be followed by any non-whitespace characters.
proc ::json::decode {json {indexVar {}}} {
    # Link to the caller's index variable.
    if {$indexVar ne {}} {
        upvar 1 $indexVar index
    }

    # By default, start decoding at the start of the input.
    if {![info exists index]} {
        set index 0
    }

    # Skip leading whitespace.  Return empty at end of input.
    if {![regexp -indices -start $index {[^\t\n\r ]} $json range]} {
        return
    }
    set index [lindex $range 0]

    # The first character determines the JSON element type.
    switch [string index $json $index] {
    \" {
        # JSON strings start with double quote.
        set type string

        # The value is the text between matching double quotes.
        if {![regexp -indices -start $index {\A\"((?:[^"]|\\.)*)\"}\
                $json range sub]} {
            return -code error "invalid JSON string at index $index:\
                    must end with close quote"
        }
        set value [string range $json {*}$sub]

        # Process all backslash substitutions in the value.
        set start 0
        while {[regexp -indices -start $start {\\u[[:xdigit:]]{4}|\\[^u]}\
                $value sub]} {
            set char [string index $value [expr {[lindex $sub 0] + 1}]]
            switch $char {
                u {set char [subst [string range $value {*}$sub]]}
                b {set char \b} f {set char \f} n {set char \n}
                r {set char \r} t {set char \t}
            }
            set value [string replace $value {*}$sub $char]
            set start [expr {[lindex $sub 0] + 1}]
        }
    } \{ - \[ {
        # JSON objects/arrays start with open brace/bracket.
        if {[string index $json $index] eq "\{"} {
            set type object
            set endRe {\A[\t\n\r ]*\}}
            set charName brace
        } else {
            set type array
            set endRe {\A[\t\n\r ]*\]}
            set charName bracket
        }
        set value {}
        incr index

        # Loop until close brace/bracket is encountered.
        while {![regexp -indices -start $index $endRe $json range]} {
            # Each element other than the first is preceded by comma.
            if {[llength $value]} {
                if {![regexp -indices -start $index\
                        {\A[\t\n\r ]*,} $json range]} {
                    return -code error "invalid JSON $type at index $index:\
                            element not followed by comma or close $charName"
                }
                set index [expr {[lindex $range 1] + 1}]
            }

            # For objects, get key and confirm it is followed by colon.
            if {$type eq "object"} {
                set key [decode $json index]
                if {![llength $key]} {
                    return -code error "invalid JSON object at index $index:\
                            must end with close brace"
                } elseif {[lindex $key 0] ne "string"} {
                    return -code error "invalid JSON object at index $index:\
                            key type is \"[lindex $key 0]\", must be string"
                } elseif {![regexp -indices -start $index {\A[\t\n\r ]*:}\
                        $json range]} {
                    return -code error "invalid JSON object at index $index:\
                            key not followed by colon"
                }
                set index [expr {[lindex $range 1] + 1}]
                lappend value [lindex $key 1]
            }

            # Get element value.
            lappend value [decode $json index]
        }
    } t - f - n {
        # JSON literals are true, false, or null.
        set type literal
        if {![regexp -indices -start $index {(?:true|false|null)\M}\
                $json range]} {
            return -code error "invalid JSON literal at index $index"
        }
        set value [string range $json {*}$range]
    } - - + - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - . {
        # JSON numbers are integers or real numbers.
        set type number
        if {![regexp -indices -start $index --\
                {-?(?:0|[1-9]\d*)(?:\.\d+)?(?:[eE][-+]?\d+)?\M} $json range]} {
            return -code error "invalid JSON number at index $index"
        }
        set value [string range $json {*}$range]
    } default {
        # JSON allows only the above-listed types.
        return -code error "invalid JSON data at index $index"
    }}

    # Continue decoding after the last character matched above.
    set index [expr {[lindex $range 1] + 1}]

    # When performing a full decode, ensure only whitespace appears at end.
    if {$indexVar eq {} && [regexp -start $index {[^\t\n\r\ ]} $json]} {
        return -code error "junk at end of JSON"
    }

    # Return the type and value.
    list $type $value
}

# ::json::schema --
# Extracts JSON type information from the output of [json::decode].
proc ::json::schema {data} {
    # Extract type and value from data argument.
    if {[llength $data] != 2} {
        error "invalid JSON data: must be a two-element list consisting of\
                type and value"
    }
    lassign $data type value

    # Extract top and subtype from type element.
    set toptype [lindex $type 0]
    if {[llength $type] >= 2} {
        if {[llength $type] == 2} {
            set subtype [lindex $type 1]
        } else {
            set subtype [lrange $type 1 end]
        }
        if {$toptype ni {array object}} {
            set toptype {}
        }
    }

    # Perform type-specific JSON processing.
    switch $toptype {
    array {
        list $toptype [lmap element $value {
            if {[info exists subtype]} {
                schema [list $subtype $element]
            } else {
                schema $element
            }
        }]
    } object {
        list $toptype [dict map {key element} $value {
            if {[info exists subtype]} {
                schema [list $subtype $element]
            } else {
                schema $element
            }
        }]
    } string - number - literal {
        return $toptype
    } encoded {
        schema [decode $value]
    } decoded {
        schema $value
    } default {
        error "invalid JSON type \"$type\": must be array, object, string,\
                number, literal, encoded, decoded, or {array|object ?...?\
                subtype}, where subtype is recursively any valid JSON type"
    }}
}

# ::json::values --
# Extracts JSON value information from the output of [json::decode].
proc ::json::values {data} {
    # Extract type and value from data argument.
    if {[llength $data] != 2} {
        error "invalid JSON data: must be a two-element list consisting of\
                type and value"
    }
    lassign $data type value

    # Extract top and subtype from type element.
    set toptype [lindex $type 0]
    if {[llength $type] >= 2} {
        if {[llength $type] == 2} {
            set subtype [lindex $type 1]
        } else {
            set subtype [lrange $type 1 end]
        }
        if {$toptype ni {array object}} {
            set toptype {}
        }
    }

    # Perform type-specific JSON processing.
    switch $toptype {
    array {
        lmap element $value {
            if {[info exists subtype]} {
                values [list $subtype $element]
            } else {
                values $element
            }
        }
    } object {
        dict map {key element} $value {
            if {[info exists subtype]} {
                values [list $subtype $element]
            } else {
                values $element
            }
        }
    } string - number - literal {
        return $value
    } encoded {
        values [decode $value]
    } decoded {
        values $value
    } default {
        error "invalid JSON type \"$type\": must be array, object, string,\
                number, literal, encoded, decoded, or {array|object ?...?\
                subtype}, where subtype is recursively any valid JSON type"
    }}
}

# ::json::unite --
# Combines the output of [json::schema] with the output of [json::values] to
# produce a suitable input for [json::encode].  The [json::schema] input format
# is extended to allow variable-length arrays and objects with extra, missing,
# or reordered keys.  Repeated keys are not allowed.  Variable-length arrays are
# implemented by repeating the defined element types in a loop.  The schema may
# also contain encoded and decoded types, signifying that the corresponding
# value is a raw JSON string or a decoded JSON document.
proc ::json::unite {schema values} {
    switch [lindex $schema 0] {
    array {
        if {[llength $schema] != 2} {
            error "invalid JSON data: must be a two-element list with second\
                    element being list of array element types"
        }

        # Repeat and/or trim the subtype list to the value list length.
        set subtypes [lindex $schema 1]
        if {[llength $subtypes] < [llength $values]} {
            set subtypes [lrepeat [expr {
                ([llength $values] + [llength $subtypes] - 1)
              / [llength $subtypes]
            }] {*}$subtypes]
        }
        if {[llength $subtypes] > [llength $values]} {
            set subtypes [lreplace $subtypes [llength $values] end]
        }

        # Process each element.
        list array [lmap subtype $subtypes value $values {
            unite $subtype $value
        }]
    } object {
        if {[llength $schema] != 2} {
            error "invalid JSON object: must be a two-element list with second\
                    element being dict of object element types"
        }
        list object [dict map {key value} $values {
            if {[dict exists [lindex $schema 1] $key]} {
                unite [dict get [lindex $schema 1] $key] $value
            } elseif {[dict exists [lindex $schema 1] {}]} {
                unite [dict get [lindex $schema 1] {}] $value
            } else {
                error "key not defined in schema: $key"
            }
        }]
    } string - number - literal {
        if {[llength $schema] != 1} {
            error "invalid JSON [lindex $schema 0]: must be a one-element list"
        }
        list [lindex $schema 0] $values
    } encoded {
        if {[llength $schema] != 1} {
            error "invalid encoded JSON: must be a one-element list"
        }
        decode [lindex $values 0]
    } decoded {
        if {[llength $schema] != 2} {
            error "invalid decoded JSON: must be a two-element list"
        }
        return $values
    } default {
        error "invalid JSON type \"[lindex $schema 0]\": must be array, object,\
                string, number, literal, encoded, or decoded"
    }}
}

Testing edit

New test suite

package require Tcl 8.5.7
package require json
package require tcltest

foreach {name description input output} {
    json-1.1 "encode array document"
    {array {{number 0} {number 1} {number 2} {number 3}}} {[0,1,2,3]}

    json-1.2 "encode object document"
    {object {foo {number 0} bar {number 1} quux {number 2}}}
    {{"foo":0,"bar":1,"quux":2}}

    json-1.3.1 "encode string document"
    {string "hello world"} {"hello world"}

    json-1.3.2 "encode empty string document"
    {string ""} {""}

    json-1.3.3 "encode NUL string document"
    {string "\x00"} {"\u0000"}

    json-1.3.4 "encode quoted string document"
    {string "\x1f\\x\"y\"z"} {"\u001f\\x\"y\"z"}

    json-1.4.1 "encode integer number document"
    {number 42} 42

    json-1.4.2 "encode negative integer number document"
    {number -42} -42

    json-1.4.3 "encode positive integer number document"
    {number +42} 42

    json-1.4.4 "encode spaced integer number document"
    {number " +084 "} 84

    json-1.4.5 "encode real number document"
    {number 4.2} 4.2

    json-1.4.6 "encode negative real number document"
    {number -4.2} -4.2

    json-1.4.6 "encode positive real number document"
    {number +4.2} 4.2

    json-1.4.7 "encode spaced real number document"
    {number " +04.20 "} 4.2

    json-1.4.8 "encode real number document w/o leading zero"
    {number -.2} -0.2

    json-1.4.9 "encode real number document w/o trailing zero"
    {number +2.} 2.0

    json-1.4.10 "encode exponential number document"
    {number 2e5} 2.0e+5

    json-1.5.1 "encode literal true document"
    {literal true} true

    json-1.5.2 "encode literal false document"
    {literal false} false

    json-1.5.3 "encode literal null document"
    {literal null} null

    json-1.6 "encode pre-encoded document"
    {encoded {"hello world"}} {"hello world"}

    json-1.7 "encode decoded document"
    {decoded {string "hello world"}} {"hello world"}

    json-1.8.1 "encode array array document"
    {{array array} {{{number 1} {number 2}} {{string 3}}}} {[[1,2],["3"]]}

    json-1.8.2 "encode array array number document"
    {{array array number} {{1 2} {3 4}}} {[[1,2],[3,4]]}

    json-1.8.3 "encode array object document"
    {{array object} {{a {number 1} b {string 2}} {a {string 3} b {number 4}}}}
    {[{"a":1,"b":"2"},{"a":"3","b":4}]}

    json-1.8.4 "encode array object number document"
    {{array object number} {{a 1 b 2} {a 3 b 4}}}
    {[{"a":1,"b":2},{"a":3,"b":4}]}

    json-1.8.5 "encode array string document"
    {{array string} {1 2 3 4}} {["1","2","3","4"]}

    json-1.8.6 "encode array number document"
    {{array number} {1 2 3 4}} {[1,2,3,4]}

    json-1.8.7 "encode array literal document"
    {{array literal} {true false null}} {[true,false,null]}

    json-1.8.8 "encode array encoded document"
    {{array encoded} {{"x"} [0,0] null}} {["x",[0,0],null]}

    json-1.8.9 "encode array decoded document"
    {{array decoded} {{literal true} {literal false} {literal null}}}
    {[true,false,null]}

    json-1.9.1 "encode object array document"
    {{object array} {a {{number 1} {number 2}} b {{string 3}}}}
    {{"a":[1,2],"b":["3"]}}

    json-1.9.2 "encode object array number document"
    {{object array number} {a {1 2} b {3 4}}} {{"a":[1,2],"b":[3,4]}}

    json-1.9.3 "encode object object document"
    {{object object} {x {a {number 1} b {string 2}} y {a {string 3}}}}
    {{"x":{"a":1,"b":"2"},"y":{"a":"3"}}}

    json-1.9.4 "encode object object number document"
    {{object object number} {x {a 1 b 2} y {a 3 b 4}}}
    {{"x":{"a":1,"b":2},"y":{"a":3,"b":4}}}

    json-1.9.5 "encode object string document"
    {{object string} {1 2 3 4}} {{"1":"2","3":"4"}}

    json-1.9.6 "encode object number document"
    {{object number} {1 2 3 4}} {{"1":2,"3":4}}

    json-1.9.7 "encode object literal document"
    {{object literal} {true true false false null null}}
    {{"true":true,"false":false,"null":null}}

    json-1.9.8 "encode object encoded document"
    {{object encoded} {true {"x"} false [0,0] null null}}
    {{"true":"x","false":[0,0],"null":null}}

    json-1.9.9 "encode object decoded document"
    {{object decoded} {true {string x} false {number -1.20} null {literal null}}}
    {{"true":"x","false":-1.2,"null":null}}
} {
    tcltest::test $name $description -body [list json::encode $input]\
            -result $output
}

# TODO: more error cases?
tcltest::test json-1.5.4 "encode literal invalid document" -body {
    json::encode {literal invalid}
} -returnCodes error\
-result {invalid JSON literal "invalid": must be false, null, or true}

foreach {name description input output} {
    json-2.1 "decode array document"
    {[0,1,2,3]} {array {{number 0} {number 1} {number 2} {number 3}}}

    json-2.2 "decode object document"
    {{"foo":0,"bar":1,"quux":2}}
    {object {foo {number 0} bar {number 1} quux {number 2}}}

    json-2.3.1 "decode string document"
    {"hello world"} {string {hello world}}

    json-2.3.2 "decode empty string document"
    {""} {string {}}

    json-2.3.3 "decode NUL string document"
    {"\u0000"} "string \x00"

    json-2.3.4 "decode quoted string document"
    {"\u001f\\x\"y\"z"} "string {\x1f\\x\"y\"z}"

    json-2.4.1 "decode integer number document"
    42 {number 42}

    json-2.4.2 "decode negative integer number document"
    -42 {number -42}

    json-2.4.3 "decode positive integer number document"
    +42 {number 42}

    json-2.4.5 "decode real number document"
    4.2 {number 4.2}

    json-2.4.6 "decode negative real number document"
    -4.2 {number -4.2}

    json-2.4.6 "decode positive real number document"
    +4.2 {number 4.2}

    json-2.5.1 "decode literal true document"
    true {literal true}

    json-2.5.2 "decode literal false document"
    false {literal false}

    json-2.5.3 "decode literal null document"
    null {literal null}

    json-2.6.1 "decode array array document"
    {[[1],["3"]]} {array {{array {{number 1}}} {array {{string 3}}}}}

    json-2.6.2 "decode array array number document"
    {[[1,2],[3,4]]}
    {array {{array {{number 1} {number 2}}} {array {{number 3} {number 4}}}}}

    json-2.6.3 "decode array object document"
    {[{"a":1,"b":"2"},{"a":"3"}]}
    {array {{object {a {number 1} b {string 2}}} {object {a {string 3}}}}}

    json-2.6.4 "encode array string document"
    {["1","2","3","4"]} {array {{string 1} {string 2} {string 3} {string 4}}}

    json-2.6.5 "decode array number document"
    {[1,2,3,4]} {array {{number 1} {number 2} {number 3} {number 4}}}

    json-2.6.6 "decode array literal document"
    {[true,false,null]} {array {{literal true} {literal false} {literal null}}}

    json-2.7.1 "decode object array document"
    {{"a":[1,2],"b":["3"]}}
    {object {a {array {{number 1} {number 2}}} b {array {{string 3}}}}}

    json-2.7.2 "decode object object document"
    {{"x":{"a":1,"b":"2"},"y":{"a":"3"}}}
    {object {x {object {a {number 1} b {string 2}}} y {object {a {string 3}}}}}

    json-2.7.3 "decode object string document"
    {{"1":"2","3":"4"}} {object {1 {string 2} 3 {string 4}}}

    json-2.7.4 "encode object number document"
    {{"1":2,"3":4}} {object {1 {number 2} 3 {number 4}}}

    json-2.7.5 "decode object literal document"
    {{"true":true,"false":false,"null":null}}
    {object {true {literal true} false {literal false} null {literal null}}}
} {
    tcltest::test $name $description -body [list json::decode $input]\
            -result $output
}

foreach {name description input output} {
    json-3.1 "array schema"
    {array {{number 0} {number 1} {number 2} {number 3}}}
    {array {number number number number}}

    json-3.2 "object schema"
    {object {foo {number 0} bar {number 1} quux {number 2}}}
    {object {foo number bar number quux number}}

    json-3.3 "string schema"
    {string {hello world}} string

    json-3.4 "number schema"
    {number 42} number

    json-3.5 "literal schema"
    {literal true} literal

    json-3.6.1 "array array schema"
    {array {{array {{number 1}}} {array {{string 3} {literal false}}}}}
    {array {{array number} {array {string literal}}}}

    json-3.6.2 "array array number schema"
    {array {{array {{number 1} {number 2}}} {array {{number 3} {number 4}}}}}
    {array {{array {number number}} {array {number number}}}}

    json-3.6.3 "array object schema"
    {array {{object {a {number 1} b {string 2}}} {object {a {string 3}}}}}
    {array {{object {a number b string}} {object {a string}}}}

    json-3.6.4 "array string schema"
    {array {{string 1} {string 2} {string 3} {string 4}}}
    {array {string string string string}}

    json-3.6.5 "array number schema"
    {array {{number 1} {number 2} {number 3} {number 4}}}
    {array {number number number number}}

    json-3.6.6 "array literal schema"
    {array {{literal true} {literal false} {literal null}}}
    {array {literal literal literal}}

    json-3.7.1 "object array schema"
    {object {a {array {{number 1} {number 2}}} b {array {{string 3}}}}}
    {object {a {array {number number}} b {array string}}}

    json-3.7.2 "object object schema"
    {object {x {object {a {number 1} b {string 2}}} y {object {a {string 3}}}}}
    {object {x {object {a number b string}} y {object {a string}}}}

    json-3.7.3 "object string schema"
    {object {1 {string 2} 3 {string 4}}}
    {object {1 string 3 string}}

    json-3.7.4 "object number schema"
    {object {1 {number 2} 3 {number 4}}}
    {object {1 number 3 number}}

    json-3.7.5 "object literal schema"
    {object {true {literal true} false {literal false} null {literal null}}}
    {object {true literal false literal null literal}}
} {
    tcltest::test $name $description -body [list json::schema $input]\
            -result $output
}

foreach {name description input output} {
    json-4.1 "array values"
    {array {{number 0} {number 1} {number 2} {number 3}}} {0 1 2 3}

    json-4.2 "object values"
    {object {foo {number 0} bar {number 1} quux {number 2}}}
    {foo 0 bar 1 quux 2}

    json-4.3 "string values"
    {string {hello world}} {hello world}

    json-4.4 "number values"
    {number 42} 42

    json-4.5 "literal values"
    {literal true} true

    json-4.6.1 "array array values"
    {array {{array {{number 1}}} {array {{string 3} {literal false}}}}}
    {1 {3 false}}

    json-4.6.2 "array array number values"
    {array {{array {{number 1} {number 2}}} {array {{number 3} {number 4}}}}}
    {{1 2} {3 4}}

    json-4.6.3 "array object values"
    {array {{object {a {number 1} b {string 2}}} {object {a {string 3}}}}}
    {{a 1 b 2} {a 3}}

    json-4.6.4 "array string values"
    {array {{string 1} {string 2} {string 3} {string 4}}} {1 2 3 4}

    json-4.6.5 "array number values"
    {array {{number 1} {number 2} {number 3} {number 4}}} {1 2 3 4}

    json-4.6.6 "array literal values"
    {array {{literal true} {literal false} {literal null}}} {true false null}

    json-4.7.1 "object array values"
    {object {a {array {{number 1} {number 2}}} b {array {{string 3}}}}}
    {a {1 2} b 3}

    json-4.7.2 "object object values"
    {object {x {object {a {number 1} b {string 2}}} y {object {a {string 3}}}}}
    {x {a 1 b 2} y {a 3}}

    json-4.7.3 "object string values"
    {object {1 {string 2} 3 {string 4}}} {1 2 3 4}

    json-4.7.4 "object number values"
    {object {1 {number 2} 3 {number 4}}} {1 2 3 4}

    json-4.7.5 "object literal values"
    {object {true {literal true} false {literal false} null {literal null}}}
    {true true false false null null}
} {
    tcltest::test $name $description -body [list json::values $input]\
            -result $output
}

foreach {name description schema values output} {
    json-5.1 "unite array"
    {array {number number number number}} {0 1 2 3}
    {array {{number 0} {number 1} {number 2} {number 3}}}

    json-5.2 "unite object"
    {object {foo number bar number quux number}} {foo 0 bar 1 quux 2}
    {object {foo {number 0} bar {number 1} quux {number 2}}}

    json-5.3 "unite string"
    string {hello world} {string {hello world}}

    json-5.4 "unite number"
    number 42 {number 42}

    json-5.5 "unite literal"
    literal true {literal true}

    json-5.6.1 "unite array array"
    {array {{array number} {array {string literal}}}} {1 {3 false}}
    {array {{array {{number 1}}} {array {{string 3} {literal false}}}}}

    json-5.6.2 "unite array array number"
    {array {{array {number number}} {array {number number}}}} {{1 2} {3 4}}
    {array {{array {{number 1} {number 2}}} {array {{number 3} {number 4}}}}}

    json-5.6.3 "unite array object"
    {array {{object {a number b string}} {object {a string}}}} {{a 1 b 2} {a 3}}
    {array {{object {a {number 1} b {string 2}}} {object {a {string 3}}}}}

    json-5.6.4 "unite array string"
    {array {string string string string}} {1 2 3 4}
    {array {{string 1} {string 2} {string 3} {string 4}}}

    json-5.6.5 "unite array number"
    {array {number number number number}} {1 2 3 4}
    {array {{number 1} {number 2} {number 3} {number 4}}}

    json-5.6.6 "unite array literal"
    {array {literal literal literal}} {true false null}
    {array {{literal true} {literal false} {literal null}}}

    json-5.7.1 "unite object array"
    {object {a {array {number number}} b {array string}}} {a {1 2} b 3}
    {object {a {array {{number 1} {number 2}}} b {array {{string 3}}}}}

    json-5.7.2 "unite object object"
    {object {x {object {a number b string}} y {object {a string}}}}
    {x {a 1 b 2} y {a 3}}
    {object {x {object {a {number 1} b {string 2}}} y {object {a {string 3}}}}}

    json-5.7.3 "unite object string"
    {object {1 string 3 string}} {1 2 3 4} {object {1 {string 2} 3 {string 4}}}

    json-5.7.4 "unite object number"
    {object {1 number 3 number}} {1 2 3 4} {object {1 {number 2} 3 {number 4}}}

    json-5.7.5 "unite object literal"
    {object {true literal false literal null literal}}
    {true true false false null null}
    {object {true {literal true} false {literal false} null {literal null}}}
} {
    tcltest::test $name $description -body [list json::unite $schema $values]\
            -result $output
}

tcltest::cleanupTests

Old test suite

package require tcltest
foreach {name json::encode json::decode description tcl json} {
    1.1 1 1 "empty string"
        {string {}}
        {""}
    1.2 1 1 "nonempty string"
        {string hello}
        {"hello"}
    1.3 1 0 "string with quoted characters"
        {string \"a\nb\\c\"}
        {"\"a\u000ab\\c\""}
    1.4 1 1 "string with canonical quoted characters"
        "string \{\"a\nb\\c\"\}"
        {"\"a\u000ab\\c\""}
    2.1 1 1 integer
        {number 42}
        42
    2.2 1 1 "negative integer"
        {number -42}
        -42
    2.3 1 0 "positive integer"
        {number +42}
        42
    2.4 1 0 "leading zeroes"
        {number 000}
        0
    2.5 1 1 zero
        {number 0}
        0
    2.6 1 1 "negative zero"
        {number -0}
        -0
    2.7 1 0 "negative zero with leading zeroes"
        {number -000}
        -0
    2.8 1 1 "real number"
        {number 1.23}
        1.23
    2.9 1 1 "negative real number"
        {number -1.23}
        -1.23
    2.10 1 1 "negative real number with exponent"
        {number -1e5}
        -1e5
    2.11 1 1 "real number with capital exponent"
        {number 1E5}
        1E5
    2.12 1 1 "real number with fraction and exponent"
        {number 1.23e4}
        1.23e4
    2.13 1 0 "positive real number with fraction and positive exponent"
        {number +1.23e+4}
        1.23e+4
    2.14 1 1 "real number with fraction and negative exponent"
        {number 1.23e-4}
        1.23e-4
    2.15 1 0 "real number with dot and no fraction"
        {number 1.}
        1.0
    2.16 1 0 "real number with dot and no integer"
        {number .1}
        0.1
    2.17 1 0 "real number with dot, no fraction, and exponent"
        {number 1.E5}
        1.0E5
    2.18 1 0 "real number with dot, no integer, and exponent"
        {number .1E-5}
        0.1E-5
    2.19 1 0 "real number with leading zeroes"
        {number 00123.45}
        123.45
    2.20 1 0 "small real number with leading zeroes"
        {number 00000.45}
        0.45
    2.21 1 0 "zero real number with leading zeroes and exponent"
        {number 00000e9}
        0e9
    3.1 1 1 "literal false"
        {literal false}
        false
    3.2 1 1 "literal null"
        {literal null}
        null
    3.3 1 1 "literal true"
        {literal true}
        true
    4.1 1 1 "array with variable type"
        {array {{string hello} {number 42} {literal null}}}
        {["hello",42,null]}
    4.2 1 1 "array with constant but unshared type"
        {array {{array {{number 1} {number 2}}} {array {{number 3} {number 4}}}}}
        {[[1,2],[3,4]]}
    4.3 1 0 "array with shared type, nested syntax"
        {{array {array number}} {{1 2} {3 4}}}
        {[[1,2],[3,4]]}
    4.4 1 0 "array with shared type, flattened syntax"
        {{array array number} {{1 2} {3 4}}}
        {[[1,2],[3,4]]}
    4.5 1 0 "array of strings"
        {{array array string} {{1 2} {3 4}}}
        {[["1","2"],["3","4"]]}
    4.6 1 1 "empty array"
        {array {}}
        {[]}
    4.7 1 0 "empty array with unnecessary shared type"
        {{array string} {}}
        {[]}
    5.1 1 1 "object with variable type"
        {object {foo {string hello} bar {number 42} quux {literal null}}}
        {{"foo":"hello","bar":42,"quux":null}}
    5.2 1 1 "object with constant but unshared type"
        {object {name {object {first {string Andy} last {string Goth}}} address {object {web {string http://tcl.tk/}}}}}
        {{"name":{"first":"Andy","last":"Goth"},"address":{"web":"http://tcl.tk/"}}}
    5.3 1 0 "object with shared type, flattened syntax"
        {{object object string} {name {first Andy last Goth} address {web http://tcl.tk/}}}
        {{"name":{"first":"Andy","last":"Goth"},"address":{"web":"http://tcl.tk/"}}}
    5.4 1 1 "empty object"
        {object {}}
        {{}}
    5.5 1 0 "empty object with unnecessary shared type"
        {{object string} {}}
        {{}}
    6.1 1 0 "empty raw"
        {encoded {}}
        {}
    6.2 1 0 "nonempty raw"
        {encoded {"foobar"}}
        {"foobar"}
} {
    if {$json::encode} {
        tcltest::test json::encode-$name $description\
                -body [list json::encode $tcl] -result $json
    }
    if {$json::decode} {
        tcltest::test json::decode-$name $description\
                -body [list json::decode $json] -result $tcl
    }
}
tcltest::cleanupTests

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References