json/json.test

   1 # json.test - Copyright (C) 2006 ActiveState Software Inc.
   2 #
   3 # Tests for the Tcllib json package
   4 #
   5 # -------------------------------------------------------------------------
   6 # See the file "license.terms" for information on usage and redistribution
   7 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   8 # -------------------------------------------------------------------------
   9 # RCS: @(#) $Id: json.test,v 1.8 2011/11/10 21:05:58 andreas_kupries Exp $
  10
  11 # -------------------------------------------------------------------------
  12
  13 source [file join \
  14         [file dirname [file dirname [file join [pwd] [info script]]]] \
  15         devtools testutilities.tcl]
  16
  17 testsNeedTcl     [expr {[catch {package require dict}] ? "8.5" : "8.4"}]
  18 testsNeedTcltest 2.0
  19
  20 testing {
  21     useLocal json.tcl json
  22 }
  23
  24 catch {unset JSON}
  25 catch {unset TCL}
  26 catch {unset DICTSORT}
  27
  28 proc dictsort3 {spec data} {
  29     while [llength $spec] {
  30         set type [lindex $spec 0]
  31         set spec [lrange $spec 1 end]
  32
  33         switch -- $type {
  34             dict {
  35                 lappend spec * string
  36
  37                 set json {}
  38                 foreach {key} [lsort [dict keys $data]] {
  39                     set val [dict get $data $key]
  40                     foreach {keymatch valtype} $spec {
  41                         if {[string match $keymatch $key]} {
  42                             lappend json $key [dictsort3 $valtype $val]
  43                             break
  44                         }
  45                     }
  46                 }
  47                 return $json
  48             }
  49             list {
  50                 lappend spec * string
  51                 set json {}
  52                 set idx 0
  53                 foreach {val} $data {
  54                     foreach {keymatch valtype} $spec {
  55                         if {$idx == $keymatch || $keymatch eq "*"} {
  56                             lappend json [dictsort3 $valtype $val]
  57                             break
  58                         }
  59                     }
  60                     incr idx
  61                 }
  62                 return $json
  63             }
  64             string {
  65                 return $data
  66             }
  67             default {error "Invalid type"}
  68         }
  69     }
  70 }
  71
  72
  73 set JSON(array) {[
  74       {
  75          "precision": "zip",
  76          "Latitude":  37.7668,
  77          "Longitude": -122.3959,
  78          "Address":   "",
  79          "City":      "SAN FRANCISCO",
  80          "State":     "CA",
  81          "Zip":       "94107",
  82          "Country":   "US"
  83       },
  84       {
  85          "precision": "zip",
  86          "Latitude":  37.371991,
  87          "Longitude": -122.026020,
  88          "Address":   "",
  89          "City":      "SUNNYVALE",
  90          "State":     "CA",
  91          "Zip":       "94085",
  92          "Country":   "US"
  93       }
  94      ]}
  95 set TCL(array) {{precision zip Latitude 37.7668 Longitude -122.3959 Address {} City {SAN FRANCISCO} State CA Zip 94107 Country US} {precision zip Latitude 37.371991 Longitude -122.026020 Address {} City SUNNYVALE State CA Zip 94085 Country US}}
  96
  97 set DICTSORT(array) {list dict}
  98
  99 set JSON(glossary) {{
 100     "glossary": {
 101         "title": "example glossary",
 102         "mixlist": ["a \"\" str", -0.09, null, "", {"member":true}],
 103         "GlossDiv": {
 104             "title": "S",
 105             "GlossList": [{
 106                 "ID": "SGML",
 107                 "GlossTerm": "Standard \\\" Language",
 108                 "Acronym": "SGML\\",
 109                 "Abbrev": "ISO 8879:1986",
 110                 "GlossDef":
 111                 "A meta-markup language, used ...",
 112                 "GlossSeeAlso": ["GML", "XML", "markup"]}]}}
 113 }}
 114 set TCL(glossary) {glossary {title {example glossary} mixlist {{a "" str} -0.09 null {} {member true}} GlossDiv {title S GlossList {{ID SGML GlossTerm {Standard \" Language} Acronym SGML\\ Abbrev {ISO 8879:1986} GlossDef {A meta-markup language, used ...} GlossSeeAlso {GML XML markup}}}}}}
 115 set DICTSORT(glossary) {dict * {dict GlossDiv {dict GlossList {list dict}}}}
 116
 117 set JSON(menu) {{"menu": {
 118     "id": "file",
 119     "value": "File:",
 120     "unival": "\u6021:",
 121     "popup": {
 122         "menuitem": [
 123                      {"value": "Open", "onclick": "OpenDoc()"},
 124                      {"value": "Close", "onclick": "CloseDoc()"}
 125                     ]
 126     }
 127 }
 128 }}
 129 set TCL(menu) [list menu [list id file value File: unival \u6021: popup {menuitem {{value Open onclick OpenDoc()} {value Close onclick CloseDoc()}}}]]
 130 set DICTSORT(menu) {dict * {dict popup {dict * {list dict}}}}
 131
 132 set JSON(widget) {{"widget": {
 133     "debug": "on",
 134     "window": {
 135         "title":"Sample Widget",
 136         "name": "main_window",
 137         "width": 500,
 138         "height": 500},
 139     "text": {
 140         "data": "Click Here",
 141         "size": 36,
 142         "style": "bold",
 143         "name": null,
 144         "hOffset":250,
 145         "vOffset": 100,
 146         "alignment": "center",
 147         "onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;"
 148     }
 149 }
 150 }}
 151 set TCL(widget) {widget {debug on window {title {Sample Widget} name main_window width 500 height 500} text {data {Click Here} size 36 style bold name null hOffset 250 vOffset 100 alignment center onMouseUp {sun1.opacity = (sun1.opacity / 100) * 90;}}}}
 152 set DICTSORT(widget) {dict * {dict text dict window dict}}
 153
 154 set JSON(menu2) {{"menu": {
 155     "header": "Viewer",
 156     "items": [
 157               {"id": "Open"},
 158               {"id": "OpenNew", "label": "Open New"},
 159               null,
 160               {"id": "ZoomIn", "label": "Zoom In"},
 161               {"id": "ZoomOut", "label": "Zoom Out"},
 162               null,
 163               {"id": "Help"},
 164               {"id": "About", "label": "About Viewer..."}
 165              ]
 166 }
 167 }}
 168 set TCL(menu2) {menu {header Viewer items {{id Open} {id OpenNew label {Open New}} null {id ZoomIn label {Zoom In}} {id ZoomOut label {Zoom Out}} null {id Help} {id About label {About Viewer...}}}}}
 169 set DICTSORT(menu2) {dict * {dict items {list 0 dict 1 dict 3 dict 4 dict 6 dict 7 dict}}}
 170
 171 set JSON(emptyList) {[]}
 172 set TCL(emptyList) {}
 173
 174 set JSON(emptyList2) {{"menu": []}}
 175 set TCL(emptyList2) {menu {}}
 176
 177 set JSON(emptyList3) {["menu", []]}
 178 set TCL(emptyList3) {menu {}}
 179
 180 set JSON(emptyList4) {[[]]}
 181 set TCL(emptyList4) {{}}
 182
 183 # -------------------------------------------------------------------------
 184 # Tests
 185 # -------------------------------------------------------------------------
 186
 187 set i 0
 188 foreach name [array names JSON] {
 189     test json-1.[incr i] "test JSON $name" -body {
 190         set res [json::json2dict $JSON($name)]
 191         if {[info exists DICTSORT($name)]} {
 192             return [string equal [dictsort3 $DICTSORT($name) $res] [dictsort3 $DICTSORT($name) $TCL($name)]]
 193         } else {
 194             return [string equal $res $TCL($name)]
 195         }
 196     } -result 1
 197 }
 198
 199 # -------------------------------------------------------------------------
 200 # More Tests
 201 # -------------------------------------------------------------------------
 202
 203 test json-2.0 {list2json} -body {
 204     json::list2json {{"a"} {"b"} {"c"}}
 205 } -result {["a","b","c"]}
 206
 207 test json-2.1 {string2json} -body {
 208     json::string2json a
 209 } -result {"a"}
 210
 211 # -------------------------------------------------------------------------
 212 catch {unset JSON}
 213 catch {unset TCL}
 214 catch {unset DICTSORT}
 215 testsuiteCleanup
 216
 217 # Local Variables:
 218 #  mode: tcl
 219 #  indent-tabs-mode: nil
 220 # End: