[bknr-cvs] r2230 - in branches/trunk-reorg/thirdparty: . cl-json cl-json/_darcs cl-json/_darcs/current cl-json/_darcs/current/doc cl-json/_darcs/current/src cl-json/_darcs/current/t cl-json/_darcs/inventories cl-json/_darcs/patches cl-json/_darcs/prefs cl-json/doc cl-json/src cl-json/t

Author: hhubner Date: 2007-10-07 19:18:29 -0400 (Sun, 07 Oct 2007) New Revision: 2230

Added: branches/trunk-reorg/thirdparty/cl-json/ branches/trunk-reorg/thirdparty/cl-json/_darcs/ branches/trunk-reorg/thirdparty/cl-json/_darcs/checkpoints/ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/cl-json.asd branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/index.html branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/style.css branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/common.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/decoder.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/encoder.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/json-rpc.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/package.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/utils.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail1.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail10.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail11.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail12.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail13.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail14.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail15.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail16.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail17.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail18.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail19.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail2.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail20.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail21.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail22.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail23.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail24.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail3.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail4.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail5.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail6.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail7.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail8.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail9.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/package.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass1.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass2.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass3.json branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testdecoder.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testencoder.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testjson.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testmisc.lisp branches/trunk-reorg/thirdparty/cl-json/_darcs/inventories/ branches/trunk-reorg/thirdparty/cl-json/_darcs/inventories/20070324142014-f2a76-a446e4d7a4ca95e1e4cffcd7f83f62b0810c94d3.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/inventory branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/ branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060130172648-1073e-418fe73231a10472a503fd6a02be8cd4fb2fae3c.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060202142849-1073e-1a01685d86ae410a3daf0517a12b5aefa4ad47e5.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060203193308-2eda4-3e8a8b08934e415ee98f432847ba99b2a0f2473b.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060203211337-2eda4-e84b2961e6d77a27f5ad145a8c86e6e1741bff86.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060205110905-2eda4-d75e1b0c3492c980c371f3245f366fca64303c5b.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060205170525-2eda4-7a1ca0472deb835294a687b38d17c3c7c6fd99bf.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060218114508-2eda4-19149c99c1e3fa477e9428078c8080f313e15d62.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060222215326-2eda4-45a4ea19782481ca9ac576abd121369f646fbbcd.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060223090421-2eda4-15cccaa2bee2022dd3fd03c7648749fea1afc94d.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060818161526-2eda4-151021eec164a7b52d9a4844bfe6a24c6b8b5a63.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060922142524-2eda4-3a71033e3fe281e3f9aa88777045388f6242df3d.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060922142711-2eda4-e150e8c262db6cedf82a2b5caed3d7e5aa2c958f.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923090745-2eda4-2860a46edd40564768cf5a0805a3903063442a08.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923091853-2eda4-f86b21590e38fdb6a4461efe49be66cf33e62cf7.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923103021-2eda4-4c1ababe563eafb2829dde088e91471f83d059a4.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923171022-2eda4-87a564361d8011f62b557e75b851012c9bc45580.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060924093311-2eda4-e9f67bed3e76e28d407dcbf02f47c847fb13a077.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060926135223-f2a76-a2fd736ee3105a64d17620c3f7e8c7b961bdc05d.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061031054156-f2a76-534fb5a215d2339b2244e01ce64ff840ee52a69a.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229094512-f2a76-979034ec4301db8ae7fd3698b4369abbb3aa2cbb.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101705-f2a76-121dfafa63680808271452a8990031095330951b.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101832-f2a76-cb5d7aa34b17526bcf8bffc901f6294eb8b3ef53.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101922-f2a76-1d8519ead2fbb540ebc80b00a703781043bd7932.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324093357-f2a76-c650e69a2e1117bdbb24e22a62a4d39fe37e448f.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324095848-f2a76-f6b5ac53bd541b80e1b47cb674f1d9854809dc98.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324102326-f2a76-3818038b2f27315270dc4e37c067cd43d98cf20d.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324110354-f2a76-d5cde7675cc1c97b68378a778f44eefd916be442.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324115951-f2a76-47dba0b50ae12cedb7028aff812c06414fc022da.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324122807-f2a76-cf483ee81e42710a183e3c82fb54165a64ef6aca.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141640-f2a76-131280f2336bfab387055306ecf88f2b48cbae53.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141654-2eda4-2589cb490ac521aa79509558bd0cb13916e6e51d.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141935-f2a76-0439a3725d93d42526a2c9d3ec4c821b93b8b771.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324142014-f2a76-a446e4d7a4ca95e1e4cffcd7f83f62b0810c94d3.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070325211904-f2a76-9a9667b1214cb27a87a1fdcc6ce1cf740122b193.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070531134607-f2a76-04005616b0614ac5bb6190289a43227d24ff648f.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070531150713-f2a76-7d556dae2e116b5d8bc955931afe84e602733c37.gz branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/ branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/binaries branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/boring branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/defaultrepo branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/motd branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/repos branches/trunk-reorg/thirdparty/cl-json/cl-json.asd branches/trunk-reorg/thirdparty/cl-json/doc/ branches/trunk-reorg/thirdparty/cl-json/doc/index.html branches/trunk-reorg/thirdparty/cl-json/doc/style.css branches/trunk-reorg/thirdparty/cl-json/src/ branches/trunk-reorg/thirdparty/cl-json/src/common.lisp branches/trunk-reorg/thirdparty/cl-json/src/decoder.lisp branches/trunk-reorg/thirdparty/cl-json/src/encoder.lisp branches/trunk-reorg/thirdparty/cl-json/src/json-rpc.lisp branches/trunk-reorg/thirdparty/cl-json/src/package.lisp branches/trunk-reorg/thirdparty/cl-json/src/utils.lisp branches/trunk-reorg/thirdparty/cl-json/t/ branches/trunk-reorg/thirdparty/cl-json/t/fail1.json branches/trunk-reorg/thirdparty/cl-json/t/fail10.json branches/trunk-reorg/thirdparty/cl-json/t/fail11.json branches/trunk-reorg/thirdparty/cl-json/t/fail12.json branches/trunk-reorg/thirdparty/cl-json/t/fail13.json branches/trunk-reorg/thirdparty/cl-json/t/fail14.json branches/trunk-reorg/thirdparty/cl-json/t/fail15.json branches/trunk-reorg/thirdparty/cl-json/t/fail16.json branches/trunk-reorg/thirdparty/cl-json/t/fail17.json branches/trunk-reorg/thirdparty/cl-json/t/fail18.json branches/trunk-reorg/thirdparty/cl-json/t/fail19.json branches/trunk-reorg/thirdparty/cl-json/t/fail2.json branches/trunk-reorg/thirdparty/cl-json/t/fail20.json branches/trunk-reorg/thirdparty/cl-json/t/fail21.json branches/trunk-reorg/thirdparty/cl-json/t/fail22.json branches/trunk-reorg/thirdparty/cl-json/t/fail23.json branches/trunk-reorg/thirdparty/cl-json/t/fail24.json branches/trunk-reorg/thirdparty/cl-json/t/fail3.json branches/trunk-reorg/thirdparty/cl-json/t/fail4.json branches/trunk-reorg/thirdparty/cl-json/t/fail5.json branches/trunk-reorg/thirdparty/cl-json/t/fail6.json branches/trunk-reorg/thirdparty/cl-json/t/fail7.json branches/trunk-reorg/thirdparty/cl-json/t/fail8.json branches/trunk-reorg/thirdparty/cl-json/t/fail9.json branches/trunk-reorg/thirdparty/cl-json/t/package.lisp branches/trunk-reorg/thirdparty/cl-json/t/pass1.json branches/trunk-reorg/thirdparty/cl-json/t/pass2.json branches/trunk-reorg/thirdparty/cl-json/t/pass3.json branches/trunk-reorg/thirdparty/cl-json/t/testdecoder.lisp branches/trunk-reorg/thirdparty/cl-json/t/testencoder.lisp branches/trunk-reorg/thirdparty/cl-json/t/testjson.lisp branches/trunk-reorg/thirdparty/cl-json/t/testmisc.lisp Log: add cl-json

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/cl-json.asd =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/cl-json.asd 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/cl-json.asd 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,41 @@ +;;; -*- lisp -*- + +(in-package #:cl-user) + +(defpackage #:json-system + (:use #:cl #:asdf)) + +(in-package #:json-system) + +(defsystem :cl-json + :name "cl-json" + :description "JSON in Lisp. JSON (JavaScript Object Notation) is a lightweight data-interchange format." + :version "0.3.2" + :author "Henrik Hjelte henrik@evahjelte.com" + :licence "MIT" + :components ((:static-file "cl-json.asd") + (:module :src + :components ((:file "package") + (:file "common" :depends-on ("package")) + (:file "decoder" :depends-on ("common")) + (:file "encoder" :depends-on ("common")) + (:file "utils" :depends-on ("decoder" "encoder")) + (:file "json-rpc" :depends-on ("package" "common" "utils" "encoder" "decoder"))))) + :depends-on (:parenscript)) + +(defsystem :cl-json.test + :depends-on (:cl-json :fiveam ) + :components ((:module :t + :components ((:file "package") + (:file "testjson" :depends-on ("package" "testdecoder" "testencoder" "testmisc")) + (:file "testmisc" :depends-on ("package" "testdecoder" "testencoder")) + (:file "testdecoder" :depends-on ("package")) + (:file "testencoder" :depends-on ("package")))))) + +;; Copyright (c) 2006 Henrik Hjelte +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/index.html =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/index.html 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/index.html 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,98 @@ +<?xml version="1.0"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> + <head> + <title>CL-JSON</title> + <link rel="stylesheet" type="text/css" href="style.css"/> + <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> +</head> + +<body> + <div class="header"> + <h1>CL-JSON</h1> + <h2>A JSON parser and generator in Common-Lisp.</h2> + + </div> + + <h3>What is JSON?</h3> + +<p><a href="http://www.json.org">JSON</a> is a language independent text format for data-interchange. JSON is especially convenient in web applications, since it is a subset of the literal object notation of <a href="http://www.json.org/js.html">ECMAScript</a>. It can also be an alternative to XML. JSON has good open-source support in many languages.</p> +<h3>Why not use XML instead?</h3> +<li>Some find JSON lighter and more simple, see this <a href="http://www.json.org/xml.html">comparison.</a></li> +<h3>Why not use s-expressions instead?</h3> +<ul> +<li>Many people find parentheses difficult, but brackets and braces easy. That has led to many implementations of JSON. There is no format based on s-expressions implemented in over 20 languages (yet!).</li> +<li>A simple and very fast JSON parser in JavaScript looks like this:<pre>eval('(' + aJSONtext + ')')</pre> +Even a seasoned lisper may find it difficult to make a shorter JavaScript parser for s-expressions.</li> +</ul> + + <h3>Mailing Lists</h3> + <ul> + <li> + <a + href="http://www.common-lisp.net/mailman/listinfo/cl-json-devel%22%3E + cl-json-devel</a><br/>for developers and users.</li> + <li> + <a + href="http://www.common-lisp.net/mailman/listinfo/cl-json-announce%22%3E + cl-json-announce</a><br/>for announcements.</li> + + </ul> + <h3>Documentation</h3> + <p> + You can use any of these functions: + <pre> + decode-json + decode-json-strict + decode-json-from-string + encode-json + encode-json-to-string + + json-bind, use like this: + +(test test-json-bind + (json-bind (hello hi ciao) "{"hello":100,"hi":5}" + (is (= hello 100)) + (is (= hi 5)) + (is-false ciao)))</pre> + + Json-rpc, implements the json-rpc specification. Easily add it to your favourite webserver. + <pre> + defun-json-rpc + export-as-json-rpc + clear-exported + invoke-rpc + </pre> + Tweaking + <pre> + *json-symbols-package* Default keyword, set to a package or nil for current package. + *json-object-factory* Change how objects are decoded to Lisp. + *use-strict-json-rules* + </pre> + + For examples, see the <a href="http://common-lisp.net/project/bese/FiveAM.html">FiveAM</a> based testcases. + + </p> + <h3>Where is it</h3> + <p>A <a href="http://www.darcs.net/">Darcs</a> repository is available.<pre>darcs get http://common-lisp.net/project/cl-json/darcs/cl-json +</pre> + <p>The latest release can be downloaded <a href="http://www.cliki.net/cl-json">here</a>.</p> + <p>You can also install it by asdf-install.</p> + <p>History has shown that the darcs version is probably better than the latest release.</p> + <h3>Dependencies</h3> + cl-json now depends on <a href="http://parenscript.org">parenscript</a> for some functions. + <pre> darcs get http://common-lisp.net/project/ucw/repos/parenscript </pre> + + <h3>License</h3> + <p>MIT-license</p> + <div class="footer"> + <p>Henrik Hjelte</p> 2. Feb. 2006, updated 25 march 2007. + </div> + + <div class="check"> + <a href="http://validator.w3.org/check/referer"> + Valid XHTML 1.0 Strict</a> + </div + </body> +</html>

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/style.css =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/style.css 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/doc/style.css 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,60 @@ +.header { + font-size: medium; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 5px; + border-color:#002244; + padding: 1mm 1mm 1mm 5mm; +} + +.footer { + font-size: small; + font-style: italic; + text-align: right; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 2px; + border-color:#002244; + padding: 1mm 1mm 1mm 1mm; +} + +.footer a:link { + font-weight:bold; + color:#ffffff; + background-color: #336699; + text-decoration:underline; +} + +.footer a:visited { + font-weight:bold; + color:#ffffff; + background-color: #336699; + text-decoration:underline; +} + +.footer a:hover { + font-weight:bold; + color:#002244; + background-color: #336699; + text-decoration:underline; } + +.check {font-size: x-small; + text-align:right;} + +.check a:link { font-weight:bold; + color:#a0a0ff; + background-color: #FFFFFF; + text-decoration:underline; } + +.check a:visited { font-weight:bold; + color:#a0a0ff; + background-color: #FFFFFF; + text-decoration:underline; } + +.check a:hover { font-weight:bold; + color:#000000; + background-color: #FFFFFF; + text-decoration:underline; } +

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/common.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/common.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/common.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,24 @@ +(in-package :json) + +(defparameter *json-lisp-escaped-chars* + `((#" . #") + (#\ . #\) + (#/ . #/) + (#\b . #\Backspace) + (#\f . ,(code-char 12)) + (#\n . #\Newline) + (#\r . #\Return) + (#\t . #\Tab))) + +(defparameter *use-strict-json-rules* t) + +(defun json-escaped-char-to-lisp(json-escaped-char) + (let ((ch (cdr (assoc json-escaped-char *json-lisp-escaped-chars*)))) + (if *use-strict-json-rules* + (or ch (error 'json-parse-error)) + (or ch json-escaped-char)))) + +(defun lisp-special-char-to-json(lisp-char) + (car (rassoc lisp-char *json-lisp-escaped-chars*))) + +

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/decoder.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/decoder.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/decoder.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,163 @@ +(in-package :json) + +(defvar *json-symbols-package* (find-package 'keyword) "The package where json-symbols are interned. Default keyword, nil = current package") + +(defun json-intern (string) + (if *json-symbols-package* + (intern (camel-case-to-lisp string) *json-symbols-package*) + (intern (camel-case-to-lisp string)))) + +(defparameter *json-rules* nil) + +(defparameter *json-object-factory* #'(lambda () nil)) +(defparameter *json-object-factory-add-key-value* #'(lambda (obj key value) + (push (cons (json-intern key) value) + obj))) +(defparameter *json-object-factory-return* #'(lambda (obj) (nreverse obj))) +(defparameter *json-make-big-number* #'(lambda (number-string) (format nil "BIGNUMBER:~a" number-string))) + +(define-condition json-parse-error (error) ()) + +(defun decode-json-from-string (json-string) + (with-input-from-string (stream json-string) + (decode-json stream))) + +(defun decode-json (&optional (stream *standard-input*)) + "Reads a json element from stream" + (funcall (or (cdr (assoc (peek-char t stream) *json-rules*)) + #'read-json-number) + stream)) + +(defun decode-json-strict (&optional (stream *standard-input*)) + "Only objects or arrays on top level, no junk afterwards." + (assert (member (peek-char t stream) '(#{ #[))) + (let ((object (decode-json stream))) + (assert (eq :no-junk (peek-char t stream nil :no-junk))) + object)) + +;;----------------------- + + +(defun add-json-dispatch-rule (character fn) + (push (cons character fn) *json-rules*)) + +(add-json-dispatch-rule #\t #'(lambda (stream) (read-constant stream "true" t))) + +(add-json-dispatch-rule #\f #'(lambda (stream) (read-constant stream "false" nil))) + +(add-json-dispatch-rule #\n #'(lambda (stream) (read-constant stream "null" nil))) + +(defun read-constant (stream expected-string ret-value) + (loop for x across expected-string + for ch = (read-char stream nil nil) + always (char= ch x) + finally (return ret-value))) + +(defun read-json-string (stream) + (read-char stream) + (let ((val (read-json-chars stream '(#")))) + (read-char stream) + val)) + +(add-json-dispatch-rule #" #'read-json-string) + +(defun read-json-object (stream) + (read-char stream) + (let ((obj (funcall *json-object-factory*))) + (if (char= #} (peek-char t stream)) + (read-char stream) + (loop for skip-whitepace = (peek-char t stream) + for key = (read-json-string stream) + for separator = (peek-char t stream) + for skip-separator = (assert (char= #: (read-char stream))) + for value = (decode-json stream) + for terminator = (peek-char t stream) + for skip-terminator = (assert (member (read-char stream) '(#, #}))) + do (setf obj (funcall *json-object-factory-add-key-value* obj key value)) + until (char= #} terminator))) + (funcall *json-object-factory-return* obj))) + +(add-json-dispatch-rule #{ #'read-json-object) + +(defun read-json-array (stream) + (read-char stream) + (if (char= #] (peek-char t stream)) + (progn (read-char stream) nil) + (loop for first-in-element = (assert (not (member (peek-char t stream) '(#, #])))) + for element = (decode-json stream) + for terminator = (peek-char t stream) + for skip-terminator = (assert (member (read-char stream) '(#, #]))) + collect element + until (char= #] terminator)))) + +(add-json-dispatch-rule #[ #'read-json-array) + +(defparameter *digits* '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) +(defparameter *json-number-valid-chars* (concatenate 'list *digits* '(#\e #\E #. #+ #-))) + +(defun read-json-number (stream) + (let ((number-string (read-chars-until stream + :terminator-fn #'(lambda (ch) + (not (member ch *json-number-valid-chars*)))))) + (assert (if (char= (char number-string 0) #\0) + (or (= 1 (length number-string)) (char= #. (char number-string 1))) + t)) + (handler-case + (read-from-string number-string) + (serious-condition (e) + (let ((e-pos (or (position #\e number-string) + (position #\E number-string)))) + (if e-pos + (handler-case + (read-from-string (substitute #\l (aref number-string e-pos) number-string)) + (serious-condition () + (funcall *json-make-big-number* number-string))) + (error "Unexpected error ~S" e))))))) + +(defun read-chars-until(stream &key terminator-fn (char-converter #'(lambda (ch stream) + (declare (ignore stream)) + ch))) + (with-output-to-string (ostr) + (loop + (let ((ch (peek-char nil stream nil nil))) + (when (or (null ch) + (funcall terminator-fn ch)) + (return)) + (write-char (funcall char-converter + (read-char stream nil nil) + stream) + ostr))))) + +(defun read-n-chars (stream n) + (with-output-to-string (ostr) + (dotimes (x n) + (write-char (read-char stream) ostr)))) + +(defun read-json-chars(stream terminators) + (read-chars-until stream :terminator-fn #'(lambda (ch) + (member ch terminators)) + :char-converter #'(lambda (ch stream) + (if (char= ch #\) + (if (char= #\u (peek-char nil stream)) + (code-char (parse-integer (read-n-chars stream 5) :start 1 :radix 16)) + (json-escaped-char-to-lisp (read-char stream))) + ch)))) + +(defun camel-case-to-lisp (string) + "Converts a string in camelCase to the same lisp-friendly syntax used in parenscript. + +(camel-case-to-string "camelCase") -> "CAMEL-CASE" +(camel-case-to-string "CamelCase") -> "*CAMEL-CASE" +(camel-case-to-string "dojo.widget.TreeNode") -> "DOJO.WIDGET.*TREE-NODE" +" + (with-output-to-string (out) + (loop for ch across string + with last-char do + (if (upper-case-p ch) + (progn + (if (and last-char (lower-case-p last-char)) + (write-char #- out) + (write-char #* out)) + (write-char ch out)) + (write-char (char-upcase ch) out)) + (setf last-char ch))))

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/encoder.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/encoder.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/encoder.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,112 @@ +(in-package :json) + +(defparameter *symbol-to-string-fn* #'js::symbol-to-js) + +(defgeneric encode-json (object stream)) + +(defun encode-json-to-string(object) + (with-output-to-string (stream) + (encode-json object stream))) + +(defmethod encode-json((nr number) stream) + (write-json-number nr stream)) + +(defmethod encode-json((s string) stream) + (write-json-string s stream)) + +(defmethod encode-json ((c character) stream) + "JSON does not define a character type, we encode characters as strings." + (encode-json (string c) stream)) + +(defmethod encode-json((s symbol) stream) + (cond + ((null s) (write-json-chars "null" stream)) + ((eq 't s) (write-json-chars "true" stream)) + (t (write-json-string (funcall *symbol-to-string-fn* s) stream)))) + +(defmethod encode-json((s list) stream) + (handler-case + (write-string (with-output-to-string (temp) + (call-next-method s temp)) + stream) + (type-error (e) + (declare (ignore e)) + (encode-json-alist s stream)))) + +(defmethod encode-json((s sequence) stream) + (let ((first-element t)) + (write-char #[ stream) + (map nil #'(lambda (element) + (if first-element + (setf first-element nil) + (write-char #, stream)) + (encode-json element stream)) + s) + (write-char #] stream))) + +(defmacro write-json-object (generator-fn stream) + (let ((strm (gensym)) + (first-element (gensym))) + `(let ((,first-element t) + (,strm ,stream)) + (write-char #{ ,strm) + (loop + (multiple-value-bind (more name value) + (,generator-fn) + (unless more (return)) + (if ,first-element + (setf ,first-element nil) + (write-char #, ,strm)) + (encode-json name ,strm) + (write-char #: ,strm) + (encode-json value ,strm))) + (write-char #} ,strm)))) + +(defmethod encode-json((h hash-table) stream) + (with-hash-table-iterator (generator h) + (write-json-object generator stream))) + +(defmacro with-alist-iterator ((generator-fn alist) &body body) + (let ((stack (gensym))) + `(let ((,stack (copy-alist ,alist))) + (flet ((,generator-fn () + (let ((cur (pop ,stack))) + (if cur + (values t (car cur) (cdr cur)) + nil)))) + ,@body)))) + +(defun encode-json-alist (alist stream) + (with-alist-iterator (gen-fn alist) + (write-json-object gen-fn stream))) + +(defun encode-json-alist-to-string(alist) + (with-output-to-string (stream) + (encode-json-alist alist stream))) + + +(defun write-json-string (s stream) + (write-char #" stream) + (if (stringp s) + (write-json-chars s stream) + (encode-json s stream)) + (write-char #" stream)) + +(defun write-json-chars (s stream) + (declare (inline lisp-special-char-to-json)) + (loop for ch across s + for code = (char-code ch) + for special = (lisp-special-char-to-json ch) + do + (cond + ((and special (not (char= special #/))) + (write-char #\ stream) + (write-char special stream)) + ((<= code #x1f) + (format stream "\u~4,'0x" code)) + (t (write-char ch stream))))) + +(defun write-json-number (nr stream) + (if (integerp nr) + (format stream "~d" nr) + (format stream "~f" nr)))

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/json-rpc.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/json-rpc.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/json-rpc.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,79 @@ +(in-package :json-rpc) + +;; http://json-rpc.org/wiki/specification +;; http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html + +(defvar *json-rpc-functions* (make-hash-table :test #'equal)) + +(defun clear-exported () + (clrhash *json-rpc-functions*)) + +(defmacro defun-json-rpc (name lambda-list &body body) + "Defines a function and registers it as a json-rpc target." + `(progn + (defun ,name ,lambda-list ,@body) + (export-as-json-rpc #',name (string-downcase (symbol-name ',name))))) + +(defun export-as-json-rpc (func function-name) + (setf (gethash function-name *json-rpc-functions*) func)) + +(defun make-rpc-response (&key result error id) + "When the method invocation completes, the service must reply with a response. The response is a single object serialized using JSON. + +It has three properties: + + * result - The Object that was returned by the invoked method. This must be null in case there was an error invoking the method. + * error - An Error object(unspecified in json-rpc 1.0) if there was an error invoking the method. Null if there was no error. + * id - This must be the same id as the request it is responding to. " + (json:encode-json-alist-to-string + `((:result . ,result) + (:error . ,error) + (:id . ,id)))) + +(defun make-json-rpc-error-object-1.1 (message &key code error-object) + "This code is based on the Working Draft 7 August 2006 of Json-rpc 1.1 specification. + http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html +" + (let ((eo `((:name . "JSONRPCError") + (:code . ,(or code 999)) + (:message . ,message)))) + (if error-object + (append eo `((:error . ,error-object))) + eo))) + +(defun invoke-rpc (json-string) + "A remote method is invoked by sending a request to a remote service. The request is a single object serialized using JSON. + +It has three properties: + + * method - A String containing the name of the method to be invoked. + * params - An Array of objects to pass as arguments to the method. + * id - The request id. This can be of any type. It is used to match the response with the request that it is replying to. " + (json-bind (method params id) json-string + (restart-case + (let ((func (gethash method *json-rpc-functions*))) + (if func + (make-rpc-response :id id :result (restart-case (apply func params) + (use-value (value) + value))) + (make-rpc-response :id id :error (make-json-rpc-error-object-1.1 "Procedure not found")))) + (send-error (message &optional code error-object) + (make-rpc-response :id id :error (make-json-rpc-error-object-1.1 message + :code code + :error-object error-object))) + (send-error-object (error-object) + (make-rpc-response :id id :error error-object)) + (send-nothing () + nil) + (send-internal-error () + (make-rpc-response :id id :error (make-json-rpc-error-object-1.1 "Service error")))))) + +(defmacro def-restart (restart-name &rest (params)) + `(defun ,restart-name (,@params &optional condition) + (let ((restart (find-restart ',restart-name condition))) + (invoke-restart restart ,@params)))) + +(def-restart send-error (errmsg code)) +(def-restart send-error-object (errobject)) +(def-restart send-nothing ()) +(def-restart send-internal-error ())

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/package.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/package.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/package.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,38 @@ +(defpackage :json + (:use :common-lisp) + (:export + #:*json-symbols-package* + #:*json-object-factory* + #:*json-object-factory-add-key-value* + #:*json-object-factory-return* + #:*json-make-big-number* + + #:decode-json + #:decode-json-strict + #:decode-json-from-string + + #:*use-strict-json-rules* + #:json-parse-error + + #:encode-json + #:encode-json-to-string + #:encode-json-alist + #:encode-json-alist-to-string + + #:json-bind + )) + +(defpackage :json-rpc + (:use :common-lisp :json) + (:export + #:clear-exported + #:defun-json-rpc + #:export-as-json-rpc + #:invoke-rpc + + ;; restarts + #:send-error + #:send-error-object + #:send-nothing + #:send-internal-error + ))

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/utils.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/utils.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/src/utils.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,47 @@ +(in-package :json) + +;; helpers for json-bind +(defun cdas(item alist) + "Alias for (cdr (assoc item alist))" + (cdr (assoc item alist))) + +(defun last1 (lst) + (first (last lst))) + +(defmacro assoc-lookup (&rest lookuplist) + "(assoc-lookup :x :y alist) => (cdr (assoc :y (cdr (assoc :x alist))))" + (let ((alist-form (last1 lookuplist)) + (lookups (reverse (butlast lookuplist)))) + (labels ((mk-assoc-lookup (lookuplist) + (if lookuplist + `(cdas ,(first lookuplist) ,(mk-assoc-lookup (rest lookuplist))) + alist-form))) + (mk-assoc-lookup lookups)))) + +(defmacro json-bind (vars json-string-or-alist &body body) + (labels ((symbol-as-string (symbol) + (string-downcase (symbol-name symbol))) + (split-by-dots (string) + (loop for ch across string + with x + with b + do (if (char= #. ch) + (progn + (push (concatenate 'string (nreverse b)) x) + (setf b nil)) + (push ch b)) + finally (progn + (push (concatenate 'string (nreverse b)) x) + (return (nreverse x))))) + (lookup-deep (variable) + (mapcar #'json-intern (split-by-dots (symbol-as-string variable))))) + (let ((a-list (gensym))) + `(let ((,a-list (if (stringp ,json-string-or-alist) + (decode-json-from-string ,json-string-or-alist) + ,json-string-or-alist))) + (let ,(loop for v in vars collect `(,v (assoc-lookup ,@(lookup-deep v) + ,a-list))) + ,@body))))) + + +

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail1.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail1.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail1.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +"A JSON payload should be an object or array, not a string." \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail10.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail10.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail10.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Extra value after close": true} "misplaced quoted value" \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail11.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail11.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail11.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Illegal expression": 1 + 2} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail12.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail12.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail12.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Illegal invocation": alert()} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail13.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail13.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail13.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Numbers cannot have leading zeroes": 013} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail14.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail14.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail14.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Numbers cannot be hex": 0x14} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail15.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail15.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail15.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Illegal backslash escape: \x15"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail16.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail16.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail16.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Illegal backslash escape: '"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail17.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail17.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail17.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Illegal backslash escape: \017"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail18.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail18.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail18.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +[[[[[[[[[[[[[[[[[[[["Too deep"]]]]]]]]]]]]]]]]]]]] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail19.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail19.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail19.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Missing colon" null} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail2.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail2.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail2.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Unclosed array" \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail20.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail20.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail20.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Double colon":: null} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail21.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail21.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail21.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Comma instead of colon", null} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail22.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail22.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail22.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Colon instead of comma": false] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail23.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail23.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail23.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Bad value", truth] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail24.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail24.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail24.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +['single quote'] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail3.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail3.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail3.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{unquoted_key: "keys must be quoted} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail4.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail4.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail4.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["extra comma",] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail5.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail5.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail5.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["double extra comma",,] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail6.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail6.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail6.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +[ , "<-- missing value"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail7.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail7.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail7.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Comma after the close"], \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail8.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail8.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail8.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Extra close"]] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail9.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail9.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/fail9.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Extra comma": true,} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/package.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/package.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/package.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,5 @@ +(defpackage :json-test + (:use :json :json-rpc :common-lisp :5am )) + +(in-package :json-test) +(def-suite json) \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass1.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass1.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass1.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,56 @@ +[ + "JSON Test Pattern pass1", + {"object with 1 member":["array with 1 element"]}, + {}, + [], + -42, + true, + false, + null, + { + "integer": 1234567890, + "real": -9876.543210, + "e": 0.123456789e-12, + "E": 1.234567890E+34, + "": 23456789012E666, + "zero": 0, + "one": 1, + "space": " ", + "quote": """, + "backslash": "\", + "controls": "\b\f\n\r\t", + "slash": "/ & /", + "alpha": "abcdefghijklmnopqrstuvwyz", + "ALPHA": "ABCDEFGHIJKLMNOPQRSTUVWYZ", + "digit": "0123456789", + "special": "`1~!@#$%^&*()_+-={':[,]}|;.</>?", + "hex": "\u0123\u4567\u89AB\uCDEF\uabcd\uef4A", + "true": true, + "false": false, + "null": null, + "array":[ ], + "object":{ }, + "address": "50 St. James Street", + "url": "http://www.JSON.org/", + "comment": "// /* <!-- --", + "# -- --> */": " ", + " s p a c e d " :[1,2 , 3 + +, + +4 , 5 , 6 ,7 ], + "compact": [1,2,3,4,5,6,7], + "jsontext": "{"object with 1 member":["array with 1 element"]}", + "quotes": "&#34; \u0022 %22 0x22 034 &#x22;", + "/\"\uCAFE\uBABE\uAB98\uFCDE\ubcda\uef4A\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?" +: "A key can be any string" + }, + 0.5 ,98.6 +, +99.44 +, + +1066 + + +,"rosebud"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass2.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass2.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass2.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +[[[[[[[[[[[[[[[[[[["Not too deep"]]]]]]]]]]]]]]]]]]] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass3.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass3.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/pass3.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,6 @@ +{ + "JSON Test Pattern pass3": { + "The outermost value": "must be an object or array.", + "In this test": "It is an object." + } +}

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testdecoder.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testdecoder.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testdecoder.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,177 @@ +(in-package :json-test) + +(in-suite json) + +;; Test decoder + +(test json-literal + (is-true (decode-json-from-string " true")) + (is-true (decode-json-from-string " true ")) + (is-true (decode-json-from-string "true ")) + (is-true (decode-json-from-string "true")) + (is-false (decode-json-from-string "trUe ")) + (is-false (decode-json-from-string "false")) + (is-false (decode-json-from-string "null")) + ) + +(test json-string + (is (string= "hello" + (decode-json-from-string " "hello""))) + (is (string= "new-line +returned!" + (decode-json-from-string ""new-line\nreturned!""))) + (is (string= (make-string 1 :initial-element (code-char (+ (* 10 16) 11))) + (decode-json-from-string " "\u00ab"")))) + +(test json-array + (is (equalp + '("hello" "hej" "ciao") + (decode-json-from-string " [ "hello", "hej", + "ciao" ]"))) + (is (equalp '(1 2 3) + (decode-json-from-string "[1,2,3]"))) + (is (equalp '(t nil nil) + (decode-json-from-string "[true,null,false]"))) + (is-false (decode-json-from-string "[]"))) + +(test json-object + (is (equalp '((:hello . "hej") + (:hi . "tjena")) + (decode-json-from-string " { "hello" : "hej" , + "hi" : "tjena" + }"))) + (is-false (decode-json-from-string " { } ")) + (is-false (decode-json-from-string "{}"))) + +(test json-object-factory + (let ((*json-object-factory* #'(lambda () + (make-hash-table))) + (*json-object-factory-add-key-value* #'(lambda (obj key value) + (setf (gethash (intern (string-upcase key)) obj) + value) + obj)) + (*json-object-factory-return* #'identity) + obj) + (setf obj (decode-json-from-string " { "hello" : "hej" , + "hi" : "tjena" + }")) + (is (string= "hej" (gethash 'hello obj))) + (is (string= "tjena" (gethash 'hi obj))))) + +(test json-object-camel-case + (is (equalp '((:hello-key . "hej") + (:*hi-starts-with-upper-case . "tjena")) + (decode-json-from-string " { "helloKey" : "hej" , + "HiStartsWithUpperCase" : "tjena" + }")))) + + + + +(test json-number + (is (= (decode-json-from-string "100") 100)) + (is (= (decode-json-from-string "10.01") 10.01)) + (is (= (decode-json-from-string "-2.3") -2.3)) + (is (= (decode-json-from-string "-2.3e3") -2.3e3)) + (is (= (decode-json-from-string "-3e4") -3e4)) + (is (= (decode-json-from-string "3e4") 3e4)) + #+sbcl + (is (= (decode-json-from-string "2e40") 2d40));;Coerced to double + (is (equalp (decode-json-from-string "2e444") (funcall *json-make-big-number* "2e444")))) + +(defparameter *json-test-files-path* *load-pathname*) + +(defun test-file (name) + (make-pathname :name name :type "json" :defaults *json-test-files-path*)) + +(defun decode-file (path) + (with-open-file (stream path + :direction :input) + (decode-json-strict stream))) + +;; All test files are taken from http://www.crockford.com/JSON/JSON_checker/test/ + +(test pass-1 + (decode-file (test-file "pass1"))) + +(test pass-2 + (decode-file (test-file "pass2"))) + +(test pass-3 + (decode-file (test-file "pass3"))) + +(defparameter *ignore-tests* '( + 1 ; says: "A JSON payload should be an object or array, not a string.", but who cares? + 7 ; says: ["Comma after the close"], ,but decode-file stops parsing after one object has been retrieved + 8 ; says ["Extra close"]] ,but decode-file stops parsing after one object has been retrieved + 10; says {"Extra value after close": true} "misplaced quoted value", but + ; decode-file stops parsing after one object has been retrieved + 18; says [[[[[[[[[[[[[[[[[[[["Too deep"]]]]]]]]]]]]]]]]]]]], but there is no formal limit +)) + +(defparameter *ignore-tests-strict* '( + 18; says [[[[[[[[[[[[[[[[[[[["Too deep"]]]]]]]]]]]]]]]]]]]], but there is no formal limit +)) + +(test fail-files + (dotimes (x 24) + (if (member x *ignore-tests-strict*) + (is-true t) + (5am:signals error + (decode-file (test-file (format nil "fail~a" x))))))) + +(defun contents-of-file(file) + (with-open-file (stream file :direction :input) + (let ((s (make-string (file-length stream)))) + (read-sequence s stream) + s))) + +(test decoder-performance + (let* ((json-string (contents-of-file (test-file "pass1"))) + (chars (length json-string)) + (count 1000)) + (format t "Decoding ~a varying chars from memory ~a times." chars count) + (time + (dotimes (x count) + (let ((discard-soon (decode-json-from-string json-string))) + (funcall #'identity discard-soon))))));Do something so the compiler don't optimize too much + +;;#+when-u-want-profiling +;;(defun profile-decoder-performance() +;; #+sbcl +;; (progn +;; (let ((json-string (contents-of-file (test-file "pass1"))) +;; (count 10)) +;; (format t "Parsing test-file pass1 from memory ~a times." count) +;; (sb-sprof:with-profiling () +;; (dotimes (x count) +;; (let ((discard-soon (decode-json-from-string json-string))) +;; (funcall #'identity discard-soon)))) +;; (sb-sprof:report) +;; nil))) + +(test non-strict-json + (let ((not-strictly-valid ""right\'s of man"")) + (5am:signals json:json-parse-error + (json:decode-json-from-string not-strictly-valid)) + (let ((*use-strict-json-rules* nil)) + (declare (special *use-strict-json-rules*)) + (is (string= (json:decode-json-from-string not-strictly-valid) + "right's of man"))))) + +(test test*json-symbols-package* + (let ((*json-symbols-package* nil) + x) + (setf x (decode-json-from-string "{"x":1}")) + (is (equal (symbol-package (caar x)) + (find-package :json-test)))) + (let ((*json-symbols-package* (find-package :cl-user)) + x) + (setf x (decode-json-from-string "{"x":1}")) + (is (equal (symbol-package (caar x)) + (find-package :cl-user)))) + (let (x) + (setf x (decode-json-from-string "{"x":1}")) + (is (equal (symbol-package (caar x)) + (find-package :keyword))))) +

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testencoder.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testencoder.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testencoder.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,200 @@ +(in-package :json-test) +(in-suite json) + +(defmacro with-objects-as-hashtables(&body body) + ;;For testing, keys are stored as strings + `(let ((*json-object-factory* #'(lambda () + (make-hash-table :test #'equalp ))) + (*json-object-factory-add-key-value* #'(lambda (obj key value) + (setf (gethash key obj) + value) + obj)) + (*json-object-factory-return* #'identity)) + ,@body)) + +(test json-string() + (is (string= (encode-json-to-string (format nil "hello~&hello")) + ""hello\nhello"")) + (is (string= (encode-json-to-string (format nil ""aquote")) + ""\"aquote""))) + +(test json-literals + (is (string= "true" (encode-json-to-string t))) + (is (string= "null" (encode-json-to-string nil)))) + +(defun is-same-number(nr) + "If it gets decoded back ok then it was encoded ok" + (is (= nr (decode-json-from-string (encode-json-to-string nr))))) + +(test json-number + (is (string= "0" (encode-json-to-string 0))) + (is (string= "13" (encode-json-to-string 13))) + (is (string= "13.02" (encode-json-to-string 13.02))) + + (is-same-number 2e10) + (is-same-number -1.3234e-10) + (is-same-number -1280.12356) + (is-same-number 1d2) + (is-same-number 1l2) + (is-same-number 1s2) + (is-same-number 1f2) + (is-same-number 1e2)) + +(defun decode-then-encode (json) + (with-objects-as-hashtables + (assert (member (elt json 0) '(#{ #[ #" ))) ;must be json + (flet ((normalize (string) + (remove #\Newline (remove #\Space string)))) + (let* ((decoded (decode-json-from-string json)) + (encoded (encode-json-to-string decoded))) +;; (format t "Json:~a~&" json) +;; (format t "Encoded:~a" encoded) + (is (string= (normalize json) + (normalize encoded))))))) + +(test test-encode-json-nathan-hawkins + (let ((foo '((a . 1) (b . 2) (c . 3)))) + (is (string= (encode-json-to-string foo) + "{"a":1,"b":2,"c":3}")))) + +(test test-encode-json-alist + (let ((alist `((:HELLO . 100)(:hi . 5))) + (expected "{"hello":100,"hi":5}")) + (is (string= (with-output-to-string (s) (encode-json-alist alist s)) + expected)))) + +(test test-encode-json-alist-two + (let ((alist `((HELLO . 100)(hi . 5))) + (expected "{"hello":100,"hi":5}")) + (is (string= (with-output-to-string (s) (encode-json-alist alist s)) + expected)))) + +(test test-encode-json-alist-string + (let ((alist `((:hello . "hej")(:hi . "tjena"))) + (expected "{"hello":"hej","hi":"tjena"}")) + (is (string= (with-output-to-string (s) (encode-json-alist alist s)) + expected)))) + +(test test-encode-json-alist-camel-case + (let ((alist `((:hello-message . "hej")(*also-starting-with-upper . "hej"))) + (expected "{"helloMessage":"hej","AlsoStartingWithUpper":"hej"}")) + (is (string= (with-output-to-string (s) (encode-json-alist alist s)) + expected)))) + +(test encode-pass-2 + (decode-then-encode "[[[[[[[[[[[[[[[[[[["Not too deep"]]]]]]]]]]]]]]]]]]]")) + +(test encode-pass-3 + (decode-then-encode "{ + "JSON Test Pattern pass3": { + "The outermost value": "must be an object or array." + } +} +")) + +;; Test inspired by the file pass1. +;; There are too many small differences just to decode-encode the whole pass1 file, +;; Instead the difficult parts are in separate tests below. + +(test controls + (decode-then-encode ""\\b\\f\\n\\r\\"")) + +(test slash + (let* ((z ""/ & /"") + (also-z ""/ & /"") ;Extra quote + (x (encode-json-to-string z)) + (also-x (encode-json-to-string also-z)) + (y (decode-json-from-string x)) + (also-y (decode-json-from-string also-x))) + (is (string= x also-x)) + (is (string= y also-y)) + (is (string= z y)))) + + +(test quoted + (decode-then-encode ""&#34; %22 0x22 034 &#x22;"")) + +(test alpha-1 + (decode-then-encode ""abcdefghijklmnopqrstuvwyz"")) + +(test alpha-2 + (decode-then-encode ""ABCDEFGHIJKLMNOPQRSTUVWYZ"")) + +(test digit + (decode-then-encode ""0123456789"")) + +(test special + (decode-then-encode ""`1~!@#$%^&*()_+-={':[,]}|;.</>?"")) + +(test hex + (decode-then-encode ""\u0123\u4567\u89AB\uCDEF\uabcd\uef4A"")) + +(test true + (decode-then-encode "[ true]")) + +(test false + (is (string= (encode-json-to-string (decode-json-from-string "[false]")) + "[null]")));;We dont separate between false and null +(test null + (decode-then-encode "[null]")) + +(test array + ;;Since empty lists becomes nil in lisp, they are converted back to null + (is (string= (encode-json-to-string (decode-json-from-string "[ ]")) + "null")) + ;;But you can use vectors + (is (string= (encode-json-to-string (vector 1 2)) + "[1,2]"))) + +(test character + ;;Characters are encoded to strings, but when decoded back to string + (is (string= (encode-json-to-string #\a) ""a""))) + + +(test hash-table-symbol + (let ((ht (make-hash-table))) + (setf (gethash 'symbols-are-now-converted-to-camel-case ht) 5) + (is (string= (encode-json-to-string ht) + "{"symbolsAreNowConvertedToCamelCase":5}")))) + +(test hash-table-string + (let ((ht (make-hash-table :test #'equal))) + (setf (gethash "lower x" ht) 5) + (is (string= (encode-json-to-string ht) + "{"lower x":5}")))) + + +(defparameter *encode-performace-test-string* + "{ + "JSON Test Pattern pass3": { + "The outermost value": "must be an object or array.", + "In this test": "It is an object.", + "Performance-1" : 123465.578, + "Performance-2" : 12e4, + "Performance-2" : "asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd", + "Performance-3" : ["asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd", + "asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd", + "asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd", + "asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd"] + } +} +") + + + + + +(test encoder-performance + (with-objects-as-hashtables + (let* ((json-string *encode-performace-test-string*) + (chars (length json-string)) + (lisp-obj (decode-json-from-string json-string)) + (count 2000)) + (format t "Encoding ~a varying chars from memory ~a times." chars count) + (time + (dotimes (x count) + (let ((discard-soon (encode-json-to-string lisp-obj))) + (funcall #'identity discard-soon))))))) + + +

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testjson.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testjson.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testjson.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,2 @@ +(in-package :json-test) +(run! 'json) \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testmisc.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testmisc.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/current/t/testmisc.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,50 @@ +(in-package :json-test) +(in-suite json) + +(test test-json-bind + (json-bind (hello hi ciao) "{"hello":100,"hi":5}" + (is (= hello 100)) + (is (= hi 5)) + (is-false ciao))) + + +(test test-json-bind-advanced + (json-bind (hello-world + sub-obj.property + sub-obj.missing-property + sub-obj.even-deeper-obj.some-stuff) + "{"helloWorld":100,"subObj":{"property":20,"evenDeeperObj":{"someStuff":"Guten Tag"}}}" + (is (= hello-world 100)) + (is (= sub-obj.property 20)) + (is-false sub-obj.missing-property) + (is (string= sub-obj.even-deeper-obj.some-stuff "Guten Tag")))) + +(test test-json-bind-with-alist + (let ((the-alist (decode-json-from-string "{"hello":100,"hi":5}"))) + (json-bind (hello hi ciao) the-alist + (is (= hello 100)) + (is (= hi 5)) + (is-false ciao)))) + +(test assoc-lookup + (is (equalp '(json::cdas widget-id (json::cdas parent data)) + (macroexpand-1 '(json::assoc-lookup parent widget-id data))))) + + +(defun-json-rpc foo (x y) + "Adds two numbers" + (+ x y)) + + +(test test-json-rpc + (let (result) + (setf result (json-rpc:invoke-rpc "{"method":"foo","params":[1,2],"id":999}")) + (is (string= result "{"result":3,"error":null,"id":999}")))) + +(test test-json-rpc-unknown-fn + (let (result) + (setf result (json-rpc:invoke-rpc "{"method":"secretmethod","params":[1,2],"id":"my id"}")) + (json-bind (result error id) result + (is-false result) + (is-true error) + (is (string= id "my id")))))

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/inventories/20070324142014-f2a76-a446e4d7a4ca95e1e4cffcd7f83f62b0810c94d3.gz =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/inventories/20070324142014-f2a76-a446e4d7a4ca95e1e4cffcd7f83f62b0810c94d3.gz 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/inventories/20070324142014-f2a76-a446e4d7a4ca95e1e4cffcd7f83f62b0810c94d3.gz 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,70 @@ +[First version, decoder +henrik@evahjele.com**20060130172648] +[encoder works +henrik@evahjele.com**20060202142849] +[html +henrik@evahjelte.com**20060203193308] +[testjson +henrik@evahjelte.com**20060203211337] +[MIT license +henrik@evahjelte.com**20060205110905] +[ No form-character on openmcl +henrik@evahjelte.com**20060205170525] +[links refer to json.org +henrik@evahjelte.com**20060218114508] +[bugfix encoding hashtables +henrik@evahjelte.com**20060222215326] +[keyword package for keys when decoding objects +henrik@evahjelte.com**20060223090421] +[json-rpc +henrik@evahjelte.com**20060818161526] +[remove separate asdf module for json-rpc +henrik@evahjelte.com**20060922142524] +[symbols encoded by parenscript, 'camel-case becomes "camelCase" +henrik@evahjelte.com**20060922142711] +[interning of strings moved to a single function json-intern +henrik@evahjelte.com**20060923090745] +[decoding symbols in camelCase becomes camel-case just as in parenscript. +henrik@evahjelte.com**20060923091853] +[smarter json-bind allows access to nested objects with dot-notation +henrik@evahjelte.com**20060923103021] +[json-bind can take alist as well as string +henrik@evahjelte.com**20060923171022] +[bugfix to last json-bind change +henrik@evahjelte.com**20060924093311] +[restarts in json-rpc +Henrik Hjelte henrik@evahjelte.com**20060926135223] +[configurable to allow non-strict json (suggestion by Ben Hyde) +Henrik Hjelte henrik@evahjelte.com**20061031054156 + set *use-strict-json-rules* to nil if you want to be + generous in what json you accept.. +] +[encode characters as strings, patch by Ken Harris +Henrik Hjelte henrik@evahjelte.com**20061229094512] +[serious-condition instead of reader-error to trap number overflow +Henrik Hjelte henrik@evahjelte.com**20061229101705 + SBCL signals reader-error, Allegro signals error. + Serious-condition ought to work on all Lisp implementations +] +[show failures better +Henrik Hjelte henrik@evahjelte.com**20061229101832] +[simplify test that failed for the wrong reason +Henrik Hjelte henrik@evahjelte.com**20061229101922] +[json.asd renamed cl-json.asd, asdf cleanup by Pascal Bourguignon +Henrik Hjelte henrik@evahjelte.com**20070324093357] +[json.test renamed cl-json.test +Henrik Hjelte henrik@evahjelte.com**20070324095848] +[Failing alist test by Nathan Hawkins +Henrik Hjelte henrik@evahjelte.com**20070324102326] +[encode-json now tries dotted-list if normal list fails +Henrik Hjelte henrik@evahjelte.com**20070324110354] +[TAG 0.3.0 +henrik@evahjelte.com**20070324141654] +[variable json-symbols-package allows other packages besides keyword for interning json symbols +Henrik Hjelte henrik@evahjelte.com**20070324115951] +[documentation updated +Henrik Hjelte henrik@evahjelte.com**20070324122807] +[test for json-symbols-package +Henrik Hjelte henrik@evahjelte.com**20070324141640] +[version 0.3.1 +Henrik Hjelte henrik@evahjelte.com**20070324141935] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/inventory =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/inventory 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/inventory 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,9 @@ +Starting with tag: +[TAG 0.3.1 +Henrik Hjelte henrik@evahjelte.com**20070324142014] +[documented parenscript dependency +Henrik Hjelte henrik@evahjelte.com**20070325211904] +[restart functions for json-rpc +Henrik Hjelte henrik@evahjelte.com**20070531134607] +[json-rpc-error-object as in working draft fro json-rpc spec 1.1 +Henrik Hjelte henrik@evahjelte.com**20070531150713] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060130172648-1073e-418fe73231a10472a503fd6a02be8cd4fb2fae3c.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060130172648-1073e-418fe73231a10472a503fd6a02be8cd4fb2fae3c.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060202142849-1073e-1a01685d86ae410a3daf0517a12b5aefa4ad47e5.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060202142849-1073e-1a01685d86ae410a3daf0517a12b5aefa4ad47e5.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060203193308-2eda4-3e8a8b08934e415ee98f432847ba99b2a0f2473b.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060203193308-2eda4-3e8a8b08934e415ee98f432847ba99b2a0f2473b.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060203211337-2eda4-e84b2961e6d77a27f5ad145a8c86e6e1741bff86.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060203211337-2eda4-e84b2961e6d77a27f5ad145a8c86e6e1741bff86.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060205110905-2eda4-d75e1b0c3492c980c371f3245f366fca64303c5b.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060205110905-2eda4-d75e1b0c3492c980c371f3245f366fca64303c5b.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060205170525-2eda4-7a1ca0472deb835294a687b38d17c3c7c6fd99bf.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060205170525-2eda4-7a1ca0472deb835294a687b38d17c3c7c6fd99bf.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060218114508-2eda4-19149c99c1e3fa477e9428078c8080f313e15d62.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060218114508-2eda4-19149c99c1e3fa477e9428078c8080f313e15d62.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060222215326-2eda4-45a4ea19782481ca9ac576abd121369f646fbbcd.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060222215326-2eda4-45a4ea19782481ca9ac576abd121369f646fbbcd.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060223090421-2eda4-15cccaa2bee2022dd3fd03c7648749fea1afc94d.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060223090421-2eda4-15cccaa2bee2022dd3fd03c7648749fea1afc94d.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060818161526-2eda4-151021eec164a7b52d9a4844bfe6a24c6b8b5a63.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060818161526-2eda4-151021eec164a7b52d9a4844bfe6a24c6b8b5a63.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060922142524-2eda4-3a71033e3fe281e3f9aa88777045388f6242df3d.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060922142524-2eda4-3a71033e3fe281e3f9aa88777045388f6242df3d.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060922142711-2eda4-e150e8c262db6cedf82a2b5caed3d7e5aa2c958f.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060922142711-2eda4-e150e8c262db6cedf82a2b5caed3d7e5aa2c958f.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923090745-2eda4-2860a46edd40564768cf5a0805a3903063442a08.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923090745-2eda4-2860a46edd40564768cf5a0805a3903063442a08.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923091853-2eda4-f86b21590e38fdb6a4461efe49be66cf33e62cf7.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923091853-2eda4-f86b21590e38fdb6a4461efe49be66cf33e62cf7.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923103021-2eda4-4c1ababe563eafb2829dde088e91471f83d059a4.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923103021-2eda4-4c1ababe563eafb2829dde088e91471f83d059a4.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923171022-2eda4-87a564361d8011f62b557e75b851012c9bc45580.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060923171022-2eda4-87a564361d8011f62b557e75b851012c9bc45580.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060924093311-2eda4-e9f67bed3e76e28d407dcbf02f47c847fb13a077.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060924093311-2eda4-e9f67bed3e76e28d407dcbf02f47c847fb13a077.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060926135223-f2a76-a2fd736ee3105a64d17620c3f7e8c7b961bdc05d.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20060926135223-f2a76-a2fd736ee3105a64d17620c3f7e8c7b961bdc05d.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061031054156-f2a76-534fb5a215d2339b2244e01ce64ff840ee52a69a.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061031054156-f2a76-534fb5a215d2339b2244e01ce64ff840ee52a69a.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229094512-f2a76-979034ec4301db8ae7fd3698b4369abbb3aa2cbb.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229094512-f2a76-979034ec4301db8ae7fd3698b4369abbb3aa2cbb.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101705-f2a76-121dfafa63680808271452a8990031095330951b.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101705-f2a76-121dfafa63680808271452a8990031095330951b.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101832-f2a76-cb5d7aa34b17526bcf8bffc901f6294eb8b3ef53.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101832-f2a76-cb5d7aa34b17526bcf8bffc901f6294eb8b3ef53.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101922-f2a76-1d8519ead2fbb540ebc80b00a703781043bd7932.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20061229101922-f2a76-1d8519ead2fbb540ebc80b00a703781043bd7932.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324093357-f2a76-c650e69a2e1117bdbb24e22a62a4d39fe37e448f.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324093357-f2a76-c650e69a2e1117bdbb24e22a62a4d39fe37e448f.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324095848-f2a76-f6b5ac53bd541b80e1b47cb674f1d9854809dc98.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324095848-f2a76-f6b5ac53bd541b80e1b47cb674f1d9854809dc98.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324102326-f2a76-3818038b2f27315270dc4e37c067cd43d98cf20d.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324102326-f2a76-3818038b2f27315270dc4e37c067cd43d98cf20d.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324110354-f2a76-d5cde7675cc1c97b68378a778f44eefd916be442.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324110354-f2a76-d5cde7675cc1c97b68378a778f44eefd916be442.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324115951-f2a76-47dba0b50ae12cedb7028aff812c06414fc022da.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324115951-f2a76-47dba0b50ae12cedb7028aff812c06414fc022da.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324122807-f2a76-cf483ee81e42710a183e3c82fb54165a64ef6aca.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324122807-f2a76-cf483ee81e42710a183e3c82fb54165a64ef6aca.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141640-f2a76-131280f2336bfab387055306ecf88f2b48cbae53.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141640-f2a76-131280f2336bfab387055306ecf88f2b48cbae53.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141654-2eda4-2589cb490ac521aa79509558bd0cb13916e6e51d.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141654-2eda4-2589cb490ac521aa79509558bd0cb13916e6e51d.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141935-f2a76-0439a3725d93d42526a2c9d3ec4c821b93b8b771.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324141935-f2a76-0439a3725d93d42526a2c9d3ec4c821b93b8b771.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324142014-f2a76-a446e4d7a4ca95e1e4cffcd7f83f62b0810c94d3.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070324142014-f2a76-a446e4d7a4ca95e1e4cffcd7f83f62b0810c94d3.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070325211904-f2a76-9a9667b1214cb27a87a1fdcc6ce1cf740122b193.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070325211904-f2a76-9a9667b1214cb27a87a1fdcc6ce1cf740122b193.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070531134607-f2a76-04005616b0614ac5bb6190289a43227d24ff648f.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070531134607-f2a76-04005616b0614ac5bb6190289a43227d24ff648f.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070531150713-f2a76-7d556dae2e116b5d8bc955931afe84e602733c37.gz =================================================================== (Binary files differ)

Property changes on: branches/trunk-reorg/thirdparty/cl-json/_darcs/patches/20070531150713-f2a76-7d556dae2e116b5d8bc955931afe84e602733c37.gz ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/binaries =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/binaries 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/binaries 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,39 @@ +# Binary file regexps: +.png$ +.PNG$ +.gz$ +.GZ$ +.pdf$ +.PDF$ +.jpg$ +.JPG$ +.gif$ +.GIF$ +.tar$ +.TAR$ +.bz2$ +.BZ2$ +.z$ +.Z$ +.zip$ +.ZIP$ +.jar$ +.JAR$ +.so$ +.SO$ +.a$ +.A$ +.tgz$ +.TGZ$ +.jpeg$ +.JPEG$ +.mpg$ +.MPG$ +.mpeg$ +.MPEG$ +.iso$ +.ISO$ +.exe$ +.EXE$ +.doc$ +.DOC$

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/boring =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/boring 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/boring 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,34 @@ +# Boring file regexps: +.hi$ +.o$ +.o.cmd$ +# *.ko files aren't boring by default because they might +# be Korean translations rather than kernel modules. +# .ko$ +.ko.cmd$ +.mod.c$ +(^|/).tmp_versions($|/) +(^|/)CVS($|/) +(^|/)RCS($|/) +~$ +#(^|/).[^/] +(^|/)_darcs($|/) +.bak$ +.BAK$ +.orig$ +(^|/)vssver.scc$ +.swp$ +(^|/)MT($|/) +(^|/){arch}($|/) +(^|/).arch-ids($|/) +(^|/), +.class$ +.prof$ +(^|/).DS_Store$ +(^|/)BitKeeper($|/) +(^|/)ChangeSet($|/) +(^|/).svn($|/) +.py[co]$ +# +.cvsignore$ +(^|/)Thumbs.db$

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/defaultrepo =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/defaultrepo 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/defaultrepo 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +http://common-lisp.net/project/cl-json/darcs/cl-json

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/motd ===================================================================

Added: branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/repos =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/repos 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/_darcs/prefs/repos 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +http://common-lisp.net/project/cl-json/darcs/cl-json

Added: branches/trunk-reorg/thirdparty/cl-json/cl-json.asd =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/cl-json.asd 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/cl-json.asd 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,41 @@ +;;; -*- lisp -*- + +(in-package #:cl-user) + +(defpackage #:json-system + (:use #:cl #:asdf)) + +(in-package #:json-system) + +(defsystem :cl-json + :name "cl-json" + :description "JSON in Lisp. JSON (JavaScript Object Notation) is a lightweight data-interchange format." + :version "0.3.2" + :author "Henrik Hjelte henrik@evahjelte.com" + :licence "MIT" + :components ((:static-file "cl-json.asd") + (:module :src + :components ((:file "package") + (:file "common" :depends-on ("package")) + (:file "decoder" :depends-on ("common")) + (:file "encoder" :depends-on ("common")) + (:file "utils" :depends-on ("decoder" "encoder")) + (:file "json-rpc" :depends-on ("package" "common" "utils" "encoder" "decoder"))))) + :depends-on (:parenscript)) + +(defsystem :cl-json.test + :depends-on (:cl-json :fiveam ) + :components ((:module :t + :components ((:file "package") + (:file "testjson" :depends-on ("package" "testdecoder" "testencoder" "testmisc")) + (:file "testmisc" :depends-on ("package" "testdecoder" "testencoder")) + (:file "testdecoder" :depends-on ("package")) + (:file "testencoder" :depends-on ("package")))))) + +;; Copyright (c) 2006 Henrik Hjelte +;; +;; Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: +;; +;; The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/doc/index.html =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/doc/index.html 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/doc/index.html 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,98 @@ +<?xml version="1.0"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> + <head> + <title>CL-JSON</title> + <link rel="stylesheet" type="text/css" href="style.css"/> + <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1"/> +</head> + +<body> + <div class="header"> + <h1>CL-JSON</h1> + <h2>A JSON parser and generator in Common-Lisp.</h2> + + </div> + + <h3>What is JSON?</h3> + +<p><a href="http://www.json.org">JSON</a> is a language independent text format for data-interchange. JSON is especially convenient in web applications, since it is a subset of the literal object notation of <a href="http://www.json.org/js.html">ECMAScript</a>. It can also be an alternative to XML. JSON has good open-source support in many languages.</p> +<h3>Why not use XML instead?</h3> +<li>Some find JSON lighter and more simple, see this <a href="http://www.json.org/xml.html">comparison.</a></li> +<h3>Why not use s-expressions instead?</h3> +<ul> +<li>Many people find parentheses difficult, but brackets and braces easy. That has led to many implementations of JSON. There is no format based on s-expressions implemented in over 20 languages (yet!).</li> +<li>A simple and very fast JSON parser in JavaScript looks like this:<pre>eval('(' + aJSONtext + ')')</pre> +Even a seasoned lisper may find it difficult to make a shorter JavaScript parser for s-expressions.</li> +</ul> + + <h3>Mailing Lists</h3> + <ul> + <li> + <a + href="http://www.common-lisp.net/mailman/listinfo/cl-json-devel%22%3E + cl-json-devel</a><br/>for developers and users.</li> + <li> + <a + href="http://www.common-lisp.net/mailman/listinfo/cl-json-announce%22%3E + cl-json-announce</a><br/>for announcements.</li> + + </ul> + <h3>Documentation</h3> + <p> + You can use any of these functions: + <pre> + decode-json + decode-json-strict + decode-json-from-string + encode-json + encode-json-to-string + + json-bind, use like this: + +(test test-json-bind + (json-bind (hello hi ciao) "{"hello":100,"hi":5}" + (is (= hello 100)) + (is (= hi 5)) + (is-false ciao)))</pre> + + Json-rpc, implements the json-rpc specification. Easily add it to your favourite webserver. + <pre> + defun-json-rpc + export-as-json-rpc + clear-exported + invoke-rpc + </pre> + Tweaking + <pre> + *json-symbols-package* Default keyword, set to a package or nil for current package. + *json-object-factory* Change how objects are decoded to Lisp. + *use-strict-json-rules* + </pre> + + For examples, see the <a href="http://common-lisp.net/project/bese/FiveAM.html">FiveAM</a> based testcases. + + </p> + <h3>Where is it</h3> + <p>A <a href="http://www.darcs.net/">Darcs</a> repository is available.<pre>darcs get http://common-lisp.net/project/cl-json/darcs/cl-json +</pre> + <p>The latest release can be downloaded <a href="http://www.cliki.net/cl-json">here</a>.</p> + <p>You can also install it by asdf-install.</p> + <p>History has shown that the darcs version is probably better than the latest release.</p> + <h3>Dependencies</h3> + cl-json now depends on <a href="http://parenscript.org">parenscript</a> for some functions. + <pre> darcs get http://common-lisp.net/project/ucw/repos/parenscript </pre> + + <h3>License</h3> + <p>MIT-license</p> + <div class="footer"> + <p>Henrik Hjelte</p> 2. Feb. 2006, updated 25 march 2007. + </div> + + <div class="check"> + <a href="http://validator.w3.org/check/referer"> + Valid XHTML 1.0 Strict</a> + </div + </body> +</html>

Added: branches/trunk-reorg/thirdparty/cl-json/doc/style.css =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/doc/style.css 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/doc/style.css 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,60 @@ +.header { + font-size: medium; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 5px; + border-color:#002244; + padding: 1mm 1mm 1mm 5mm; +} + +.footer { + font-size: small; + font-style: italic; + text-align: right; + background-color:#336699; + color:#ffffff; + border-style:solid; + border-width: 2px; + border-color:#002244; + padding: 1mm 1mm 1mm 1mm; +} + +.footer a:link { + font-weight:bold; + color:#ffffff; + background-color: #336699; + text-decoration:underline; +} + +.footer a:visited { + font-weight:bold; + color:#ffffff; + background-color: #336699; + text-decoration:underline; +} + +.footer a:hover { + font-weight:bold; + color:#002244; + background-color: #336699; + text-decoration:underline; } + +.check {font-size: x-small; + text-align:right;} + +.check a:link { font-weight:bold; + color:#a0a0ff; + background-color: #FFFFFF; + text-decoration:underline; } + +.check a:visited { font-weight:bold; + color:#a0a0ff; + background-color: #FFFFFF; + text-decoration:underline; } + +.check a:hover { font-weight:bold; + color:#000000; + background-color: #FFFFFF; + text-decoration:underline; } +

Added: branches/trunk-reorg/thirdparty/cl-json/src/common.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/src/common.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/src/common.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,24 @@ +(in-package :json) + +(defparameter *json-lisp-escaped-chars* + `((#" . #") + (#\ . #\) + (#/ . #/) + (#\b . #\Backspace) + (#\f . ,(code-char 12)) + (#\n . #\Newline) + (#\r . #\Return) + (#\t . #\Tab))) + +(defparameter *use-strict-json-rules* t) + +(defun json-escaped-char-to-lisp(json-escaped-char) + (let ((ch (cdr (assoc json-escaped-char *json-lisp-escaped-chars*)))) + (if *use-strict-json-rules* + (or ch (error 'json-parse-error)) + (or ch json-escaped-char)))) + +(defun lisp-special-char-to-json(lisp-char) + (car (rassoc lisp-char *json-lisp-escaped-chars*))) + +

Added: branches/trunk-reorg/thirdparty/cl-json/src/decoder.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/src/decoder.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/src/decoder.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,163 @@ +(in-package :json) + +(defvar *json-symbols-package* (find-package 'keyword) "The package where json-symbols are interned. Default keyword, nil = current package") + +(defun json-intern (string) + (if *json-symbols-package* + (intern (camel-case-to-lisp string) *json-symbols-package*) + (intern (camel-case-to-lisp string)))) + +(defparameter *json-rules* nil) + +(defparameter *json-object-factory* #'(lambda () nil)) +(defparameter *json-object-factory-add-key-value* #'(lambda (obj key value) + (push (cons (json-intern key) value) + obj))) +(defparameter *json-object-factory-return* #'(lambda (obj) (nreverse obj))) +(defparameter *json-make-big-number* #'(lambda (number-string) (format nil "BIGNUMBER:~a" number-string))) + +(define-condition json-parse-error (error) ()) + +(defun decode-json-from-string (json-string) + (with-input-from-string (stream json-string) + (decode-json stream))) + +(defun decode-json (&optional (stream *standard-input*)) + "Reads a json element from stream" + (funcall (or (cdr (assoc (peek-char t stream) *json-rules*)) + #'read-json-number) + stream)) + +(defun decode-json-strict (&optional (stream *standard-input*)) + "Only objects or arrays on top level, no junk afterwards." + (assert (member (peek-char t stream) '(#{ #[))) + (let ((object (decode-json stream))) + (assert (eq :no-junk (peek-char t stream nil :no-junk))) + object)) + +;;----------------------- + + +(defun add-json-dispatch-rule (character fn) + (push (cons character fn) *json-rules*)) + +(add-json-dispatch-rule #\t #'(lambda (stream) (read-constant stream "true" t))) + +(add-json-dispatch-rule #\f #'(lambda (stream) (read-constant stream "false" nil))) + +(add-json-dispatch-rule #\n #'(lambda (stream) (read-constant stream "null" nil))) + +(defun read-constant (stream expected-string ret-value) + (loop for x across expected-string + for ch = (read-char stream nil nil) + always (char= ch x) + finally (return ret-value))) + +(defun read-json-string (stream) + (read-char stream) + (let ((val (read-json-chars stream '(#")))) + (read-char stream) + val)) + +(add-json-dispatch-rule #" #'read-json-string) + +(defun read-json-object (stream) + (read-char stream) + (let ((obj (funcall *json-object-factory*))) + (if (char= #} (peek-char t stream)) + (read-char stream) + (loop for skip-whitepace = (peek-char t stream) + for key = (read-json-string stream) + for separator = (peek-char t stream) + for skip-separator = (assert (char= #: (read-char stream))) + for value = (decode-json stream) + for terminator = (peek-char t stream) + for skip-terminator = (assert (member (read-char stream) '(#, #}))) + do (setf obj (funcall *json-object-factory-add-key-value* obj key value)) + until (char= #} terminator))) + (funcall *json-object-factory-return* obj))) + +(add-json-dispatch-rule #{ #'read-json-object) + +(defun read-json-array (stream) + (read-char stream) + (if (char= #] (peek-char t stream)) + (progn (read-char stream) nil) + (loop for first-in-element = (assert (not (member (peek-char t stream) '(#, #])))) + for element = (decode-json stream) + for terminator = (peek-char t stream) + for skip-terminator = (assert (member (read-char stream) '(#, #]))) + collect element + until (char= #] terminator)))) + +(add-json-dispatch-rule #[ #'read-json-array) + +(defparameter *digits* '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) +(defparameter *json-number-valid-chars* (concatenate 'list *digits* '(#\e #\E #. #+ #-))) + +(defun read-json-number (stream) + (let ((number-string (read-chars-until stream + :terminator-fn #'(lambda (ch) + (not (member ch *json-number-valid-chars*)))))) + (assert (if (char= (char number-string 0) #\0) + (or (= 1 (length number-string)) (char= #. (char number-string 1))) + t)) + (handler-case + (read-from-string number-string) + (serious-condition (e) + (let ((e-pos (or (position #\e number-string) + (position #\E number-string)))) + (if e-pos + (handler-case + (read-from-string (substitute #\l (aref number-string e-pos) number-string)) + (serious-condition () + (funcall *json-make-big-number* number-string))) + (error "Unexpected error ~S" e))))))) + +(defun read-chars-until(stream &key terminator-fn (char-converter #'(lambda (ch stream) + (declare (ignore stream)) + ch))) + (with-output-to-string (ostr) + (loop + (let ((ch (peek-char nil stream nil nil))) + (when (or (null ch) + (funcall terminator-fn ch)) + (return)) + (write-char (funcall char-converter + (read-char stream nil nil) + stream) + ostr))))) + +(defun read-n-chars (stream n) + (with-output-to-string (ostr) + (dotimes (x n) + (write-char (read-char stream) ostr)))) + +(defun read-json-chars(stream terminators) + (read-chars-until stream :terminator-fn #'(lambda (ch) + (member ch terminators)) + :char-converter #'(lambda (ch stream) + (if (char= ch #\) + (if (char= #\u (peek-char nil stream)) + (code-char (parse-integer (read-n-chars stream 5) :start 1 :radix 16)) + (json-escaped-char-to-lisp (read-char stream))) + ch)))) + +(defun camel-case-to-lisp (string) + "Converts a string in camelCase to the same lisp-friendly syntax used in parenscript. + +(camel-case-to-string "camelCase") -> "CAMEL-CASE" +(camel-case-to-string "CamelCase") -> "*CAMEL-CASE" +(camel-case-to-string "dojo.widget.TreeNode") -> "DOJO.WIDGET.*TREE-NODE" +" + (with-output-to-string (out) + (loop for ch across string + with last-char do + (if (upper-case-p ch) + (progn + (if (and last-char (lower-case-p last-char)) + (write-char #- out) + (write-char #* out)) + (write-char ch out)) + (write-char (char-upcase ch) out)) + (setf last-char ch))))

Added: branches/trunk-reorg/thirdparty/cl-json/src/encoder.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/src/encoder.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/src/encoder.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,112 @@ +(in-package :json) + +(defparameter *symbol-to-string-fn* #'js::symbol-to-js) + +(defgeneric encode-json (object stream)) + +(defun encode-json-to-string(object) + (with-output-to-string (stream) + (encode-json object stream))) + +(defmethod encode-json((nr number) stream) + (write-json-number nr stream)) + +(defmethod encode-json((s string) stream) + (write-json-string s stream)) + +(defmethod encode-json ((c character) stream) + "JSON does not define a character type, we encode characters as strings." + (encode-json (string c) stream)) + +(defmethod encode-json((s symbol) stream) + (cond + ((null s) (write-json-chars "null" stream)) + ((eq 't s) (write-json-chars "true" stream)) + (t (write-json-string (funcall *symbol-to-string-fn* s) stream)))) + +(defmethod encode-json((s list) stream) + (handler-case + (write-string (with-output-to-string (temp) + (call-next-method s temp)) + stream) + (type-error (e) + (declare (ignore e)) + (encode-json-alist s stream)))) + +(defmethod encode-json((s sequence) stream) + (let ((first-element t)) + (write-char #[ stream) + (map nil #'(lambda (element) + (if first-element + (setf first-element nil) + (write-char #, stream)) + (encode-json element stream)) + s) + (write-char #] stream))) + +(defmacro write-json-object (generator-fn stream) + (let ((strm (gensym)) + (first-element (gensym))) + `(let ((,first-element t) + (,strm ,stream)) + (write-char #{ ,strm) + (loop + (multiple-value-bind (more name value) + (,generator-fn) + (unless more (return)) + (if ,first-element + (setf ,first-element nil) + (write-char #, ,strm)) + (encode-json name ,strm) + (write-char #: ,strm) + (encode-json value ,strm))) + (write-char #} ,strm)))) + +(defmethod encode-json((h hash-table) stream) + (with-hash-table-iterator (generator h) + (write-json-object generator stream))) + +(defmacro with-alist-iterator ((generator-fn alist) &body body) + (let ((stack (gensym))) + `(let ((,stack (copy-alist ,alist))) + (flet ((,generator-fn () + (let ((cur (pop ,stack))) + (if cur + (values t (car cur) (cdr cur)) + nil)))) + ,@body)))) + +(defun encode-json-alist (alist stream) + (with-alist-iterator (gen-fn alist) + (write-json-object gen-fn stream))) + +(defun encode-json-alist-to-string(alist) + (with-output-to-string (stream) + (encode-json-alist alist stream))) + + +(defun write-json-string (s stream) + (write-char #" stream) + (if (stringp s) + (write-json-chars s stream) + (encode-json s stream)) + (write-char #" stream)) + +(defun write-json-chars (s stream) + (declare (inline lisp-special-char-to-json)) + (loop for ch across s + for code = (char-code ch) + for special = (lisp-special-char-to-json ch) + do + (cond + ((and special (not (char= special #/))) + (write-char #\ stream) + (write-char special stream)) + ((<= code #x1f) + (format stream "\u~4,'0x" code)) + (t (write-char ch stream))))) + +(defun write-json-number (nr stream) + (if (integerp nr) + (format stream "~d" nr) + (format stream "~f" nr)))

Added: branches/trunk-reorg/thirdparty/cl-json/src/json-rpc.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/src/json-rpc.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/src/json-rpc.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,79 @@ +(in-package :json-rpc) + +;; http://json-rpc.org/wiki/specification +;; http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html + +(defvar *json-rpc-functions* (make-hash-table :test #'equal)) + +(defun clear-exported () + (clrhash *json-rpc-functions*)) + +(defmacro defun-json-rpc (name lambda-list &body body) + "Defines a function and registers it as a json-rpc target." + `(progn + (defun ,name ,lambda-list ,@body) + (export-as-json-rpc #',name (string-downcase (symbol-name ',name))))) + +(defun export-as-json-rpc (func function-name) + (setf (gethash function-name *json-rpc-functions*) func)) + +(defun make-rpc-response (&key result error id) + "When the method invocation completes, the service must reply with a response. The response is a single object serialized using JSON. + +It has three properties: + + * result - The Object that was returned by the invoked method. This must be null in case there was an error invoking the method. + * error - An Error object(unspecified in json-rpc 1.0) if there was an error invoking the method. Null if there was no error. + * id - This must be the same id as the request it is responding to. " + (json:encode-json-alist-to-string + `((:result . ,result) + (:error . ,error) + (:id . ,id)))) + +(defun make-json-rpc-error-object-1.1 (message &key code error-object) + "This code is based on the Working Draft 7 August 2006 of Json-rpc 1.1 specification. + http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html +" + (let ((eo `((:name . "JSONRPCError") + (:code . ,(or code 999)) + (:message . ,message)))) + (if error-object + (append eo `((:error . ,error-object))) + eo))) + +(defun invoke-rpc (json-string) + "A remote method is invoked by sending a request to a remote service. The request is a single object serialized using JSON. + +It has three properties: + + * method - A String containing the name of the method to be invoked. + * params - An Array of objects to pass as arguments to the method. + * id - The request id. This can be of any type. It is used to match the response with the request that it is replying to. " + (json-bind (method params id) json-string + (restart-case + (let ((func (gethash method *json-rpc-functions*))) + (if func + (make-rpc-response :id id :result (restart-case (apply func params) + (use-value (value) + value))) + (make-rpc-response :id id :error (make-json-rpc-error-object-1.1 "Procedure not found")))) + (send-error (message &optional code error-object) + (make-rpc-response :id id :error (make-json-rpc-error-object-1.1 message + :code code + :error-object error-object))) + (send-error-object (error-object) + (make-rpc-response :id id :error error-object)) + (send-nothing () + nil) + (send-internal-error () + (make-rpc-response :id id :error (make-json-rpc-error-object-1.1 "Service error")))))) + +(defmacro def-restart (restart-name &rest (params)) + `(defun ,restart-name (,@params &optional condition) + (let ((restart (find-restart ',restart-name condition))) + (invoke-restart restart ,@params)))) + +(def-restart send-error (errmsg code)) +(def-restart send-error-object (errobject)) +(def-restart send-nothing ()) +(def-restart send-internal-error ())

Added: branches/trunk-reorg/thirdparty/cl-json/src/package.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/src/package.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/src/package.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,38 @@ +(defpackage :json + (:use :common-lisp) + (:export + #:*json-symbols-package* + #:*json-object-factory* + #:*json-object-factory-add-key-value* + #:*json-object-factory-return* + #:*json-make-big-number* + + #:decode-json + #:decode-json-strict + #:decode-json-from-string + + #:*use-strict-json-rules* + #:json-parse-error + + #:encode-json + #:encode-json-to-string + #:encode-json-alist + #:encode-json-alist-to-string + + #:json-bind + )) + +(defpackage :json-rpc + (:use :common-lisp :json) + (:export + #:clear-exported + #:defun-json-rpc + #:export-as-json-rpc + #:invoke-rpc + + ;; restarts + #:send-error + #:send-error-object + #:send-nothing + #:send-internal-error + ))

Added: branches/trunk-reorg/thirdparty/cl-json/src/utils.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/src/utils.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/src/utils.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,47 @@ +(in-package :json) + +;; helpers for json-bind +(defun cdas(item alist) + "Alias for (cdr (assoc item alist))" + (cdr (assoc item alist))) + +(defun last1 (lst) + (first (last lst))) + +(defmacro assoc-lookup (&rest lookuplist) + "(assoc-lookup :x :y alist) => (cdr (assoc :y (cdr (assoc :x alist))))" + (let ((alist-form (last1 lookuplist)) + (lookups (reverse (butlast lookuplist)))) + (labels ((mk-assoc-lookup (lookuplist) + (if lookuplist + `(cdas ,(first lookuplist) ,(mk-assoc-lookup (rest lookuplist))) + alist-form))) + (mk-assoc-lookup lookups)))) + +(defmacro json-bind (vars json-string-or-alist &body body) + (labels ((symbol-as-string (symbol) + (string-downcase (symbol-name symbol))) + (split-by-dots (string) + (loop for ch across string + with x + with b + do (if (char= #. ch) + (progn + (push (concatenate 'string (nreverse b)) x) + (setf b nil)) + (push ch b)) + finally (progn + (push (concatenate 'string (nreverse b)) x) + (return (nreverse x))))) + (lookup-deep (variable) + (mapcar #'json-intern (split-by-dots (symbol-as-string variable))))) + (let ((a-list (gensym))) + `(let ((,a-list (if (stringp ,json-string-or-alist) + (decode-json-from-string ,json-string-or-alist) + ,json-string-or-alist))) + (let ,(loop for v in vars collect `(,v (assoc-lookup ,@(lookup-deep v) + ,a-list))) + ,@body))))) + + +

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail1.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail1.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail1.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +"A JSON payload should be an object or array, not a string." \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail10.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail10.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail10.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Extra value after close": true} "misplaced quoted value" \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail11.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail11.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail11.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Illegal expression": 1 + 2} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail12.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail12.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail12.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Illegal invocation": alert()} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail13.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail13.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail13.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Numbers cannot have leading zeroes": 013} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail14.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail14.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail14.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Numbers cannot be hex": 0x14} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail15.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail15.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail15.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Illegal backslash escape: \x15"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail16.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail16.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail16.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Illegal backslash escape: '"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail17.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail17.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail17.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Illegal backslash escape: \017"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail18.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail18.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail18.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +[[[[[[[[[[[[[[[[[[[["Too deep"]]]]]]]]]]]]]]]]]]]] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail19.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail19.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail19.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Missing colon" null} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail2.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail2.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail2.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Unclosed array" \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail20.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail20.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail20.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Double colon":: null} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail21.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail21.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail21.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Comma instead of colon", null} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail22.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail22.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail22.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Colon instead of comma": false] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail23.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail23.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail23.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Bad value", truth] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail24.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail24.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail24.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +['single quote'] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail3.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail3.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail3.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{unquoted_key: "keys must be quoted} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail4.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail4.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail4.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["extra comma",] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail5.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail5.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail5.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["double extra comma",,] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail6.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail6.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail6.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +[ , "<-- missing value"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail7.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail7.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail7.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Comma after the close"], \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail8.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail8.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail8.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +["Extra close"]] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/fail9.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/fail9.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/fail9.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +{"Extra comma": true,} \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/package.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/package.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/package.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,5 @@ +(defpackage :json-test + (:use :json :json-rpc :common-lisp :5am )) + +(in-package :json-test) +(def-suite json) \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/pass1.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/pass1.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/pass1.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,56 @@ +[ + "JSON Test Pattern pass1", + {"object with 1 member":["array with 1 element"]}, + {}, + [], + -42, + true, + false, + null, + { + "integer": 1234567890, + "real": -9876.543210, + "e": 0.123456789e-12, + "E": 1.234567890E+34, + "": 23456789012E666, + "zero": 0, + "one": 1, + "space": " ", + "quote": """, + "backslash": "\", + "controls": "\b\f\n\r\t", + "slash": "/ & /", + "alpha": "abcdefghijklmnopqrstuvwyz", + "ALPHA": "ABCDEFGHIJKLMNOPQRSTUVWYZ", + "digit": "0123456789", + "special": "`1~!@#$%^&*()_+-={':[,]}|;.</>?", + "hex": "\u0123\u4567\u89AB\uCDEF\uabcd\uef4A", + "true": true, + "false": false, + "null": null, + "array":[ ], + "object":{ }, + "address": "50 St. James Street", + "url": "http://www.JSON.org/", + "comment": "// /* <!-- --", + "# -- --> */": " ", + " s p a c e d " :[1,2 , 3 + +, + +4 , 5 , 6 ,7 ], + "compact": [1,2,3,4,5,6,7], + "jsontext": "{"object with 1 member":["array with 1 element"]}", + "quotes": "&#34; \u0022 %22 0x22 034 &#x22;", + "/\"\uCAFE\uBABE\uAB98\uFCDE\ubcda\uef4A\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?" +: "A key can be any string" + }, + 0.5 ,98.6 +, +99.44 +, + +1066 + + +,"rosebud"] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/pass2.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/pass2.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/pass2.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1 @@ +[[[[[[[[[[[[[[[[[[["Not too deep"]]]]]]]]]]]]]]]]]]] \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/pass3.json =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/pass3.json 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/pass3.json 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,6 @@ +{ + "JSON Test Pattern pass3": { + "The outermost value": "must be an object or array.", + "In this test": "It is an object." + } +}

Added: branches/trunk-reorg/thirdparty/cl-json/t/testdecoder.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/testdecoder.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/testdecoder.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,177 @@ +(in-package :json-test) + +(in-suite json) + +;; Test decoder + +(test json-literal + (is-true (decode-json-from-string " true")) + (is-true (decode-json-from-string " true ")) + (is-true (decode-json-from-string "true ")) + (is-true (decode-json-from-string "true")) + (is-false (decode-json-from-string "trUe ")) + (is-false (decode-json-from-string "false")) + (is-false (decode-json-from-string "null")) + ) + +(test json-string + (is (string= "hello" + (decode-json-from-string " "hello""))) + (is (string= "new-line +returned!" + (decode-json-from-string ""new-line\nreturned!""))) + (is (string= (make-string 1 :initial-element (code-char (+ (* 10 16) 11))) + (decode-json-from-string " "\u00ab"")))) + +(test json-array + (is (equalp + '("hello" "hej" "ciao") + (decode-json-from-string " [ "hello", "hej", + "ciao" ]"))) + (is (equalp '(1 2 3) + (decode-json-from-string "[1,2,3]"))) + (is (equalp '(t nil nil) + (decode-json-from-string "[true,null,false]"))) + (is-false (decode-json-from-string "[]"))) + +(test json-object + (is (equalp '((:hello . "hej") + (:hi . "tjena")) + (decode-json-from-string " { "hello" : "hej" , + "hi" : "tjena" + }"))) + (is-false (decode-json-from-string " { } ")) + (is-false (decode-json-from-string "{}"))) + +(test json-object-factory + (let ((*json-object-factory* #'(lambda () + (make-hash-table))) + (*json-object-factory-add-key-value* #'(lambda (obj key value) + (setf (gethash (intern (string-upcase key)) obj) + value) + obj)) + (*json-object-factory-return* #'identity) + obj) + (setf obj (decode-json-from-string " { "hello" : "hej" , + "hi" : "tjena" + }")) + (is (string= "hej" (gethash 'hello obj))) + (is (string= "tjena" (gethash 'hi obj))))) + +(test json-object-camel-case + (is (equalp '((:hello-key . "hej") + (:*hi-starts-with-upper-case . "tjena")) + (decode-json-from-string " { "helloKey" : "hej" , + "HiStartsWithUpperCase" : "tjena" + }")))) + + + + +(test json-number + (is (= (decode-json-from-string "100") 100)) + (is (= (decode-json-from-string "10.01") 10.01)) + (is (= (decode-json-from-string "-2.3") -2.3)) + (is (= (decode-json-from-string "-2.3e3") -2.3e3)) + (is (= (decode-json-from-string "-3e4") -3e4)) + (is (= (decode-json-from-string "3e4") 3e4)) + #+sbcl + (is (= (decode-json-from-string "2e40") 2d40));;Coerced to double + (is (equalp (decode-json-from-string "2e444") (funcall *json-make-big-number* "2e444")))) + +(defparameter *json-test-files-path* *load-pathname*) + +(defun test-file (name) + (make-pathname :name name :type "json" :defaults *json-test-files-path*)) + +(defun decode-file (path) + (with-open-file (stream path + :direction :input) + (decode-json-strict stream))) + +;; All test files are taken from http://www.crockford.com/JSON/JSON_checker/test/ + +(test pass-1 + (decode-file (test-file "pass1"))) + +(test pass-2 + (decode-file (test-file "pass2"))) + +(test pass-3 + (decode-file (test-file "pass3"))) + +(defparameter *ignore-tests* '( + 1 ; says: "A JSON payload should be an object or array, not a string.", but who cares? + 7 ; says: ["Comma after the close"], ,but decode-file stops parsing after one object has been retrieved + 8 ; says ["Extra close"]] ,but decode-file stops parsing after one object has been retrieved + 10; says {"Extra value after close": true} "misplaced quoted value", but + ; decode-file stops parsing after one object has been retrieved + 18; says [[[[[[[[[[[[[[[[[[[["Too deep"]]]]]]]]]]]]]]]]]]]], but there is no formal limit +)) + +(defparameter *ignore-tests-strict* '( + 18; says [[[[[[[[[[[[[[[[[[[["Too deep"]]]]]]]]]]]]]]]]]]]], but there is no formal limit +)) + +(test fail-files + (dotimes (x 24) + (if (member x *ignore-tests-strict*) + (is-true t) + (5am:signals error + (decode-file (test-file (format nil "fail~a" x))))))) + +(defun contents-of-file(file) + (with-open-file (stream file :direction :input) + (let ((s (make-string (file-length stream)))) + (read-sequence s stream) + s))) + +(test decoder-performance + (let* ((json-string (contents-of-file (test-file "pass1"))) + (chars (length json-string)) + (count 1000)) + (format t "Decoding ~a varying chars from memory ~a times." chars count) + (time + (dotimes (x count) + (let ((discard-soon (decode-json-from-string json-string))) + (funcall #'identity discard-soon))))));Do something so the compiler don't optimize too much + +;;#+when-u-want-profiling +;;(defun profile-decoder-performance() +;; #+sbcl +;; (progn +;; (let ((json-string (contents-of-file (test-file "pass1"))) +;; (count 10)) +;; (format t "Parsing test-file pass1 from memory ~a times." count) +;; (sb-sprof:with-profiling () +;; (dotimes (x count) +;; (let ((discard-soon (decode-json-from-string json-string))) +;; (funcall #'identity discard-soon)))) +;; (sb-sprof:report) +;; nil))) + +(test non-strict-json + (let ((not-strictly-valid ""right\'s of man"")) + (5am:signals json:json-parse-error + (json:decode-json-from-string not-strictly-valid)) + (let ((*use-strict-json-rules* nil)) + (declare (special *use-strict-json-rules*)) + (is (string= (json:decode-json-from-string not-strictly-valid) + "right's of man"))))) + +(test test*json-symbols-package* + (let ((*json-symbols-package* nil) + x) + (setf x (decode-json-from-string "{"x":1}")) + (is (equal (symbol-package (caar x)) + (find-package :json-test)))) + (let ((*json-symbols-package* (find-package :cl-user)) + x) + (setf x (decode-json-from-string "{"x":1}")) + (is (equal (symbol-package (caar x)) + (find-package :cl-user)))) + (let (x) + (setf x (decode-json-from-string "{"x":1}")) + (is (equal (symbol-package (caar x)) + (find-package :keyword))))) +

Added: branches/trunk-reorg/thirdparty/cl-json/t/testencoder.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/testencoder.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/testencoder.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,200 @@ +(in-package :json-test) +(in-suite json) + +(defmacro with-objects-as-hashtables(&body body) + ;;For testing, keys are stored as strings + `(let ((*json-object-factory* #'(lambda () + (make-hash-table :test #'equalp ))) + (*json-object-factory-add-key-value* #'(lambda (obj key value) + (setf (gethash key obj) + value) + obj)) + (*json-object-factory-return* #'identity)) + ,@body)) + +(test json-string() + (is (string= (encode-json-to-string (format nil "hello~&hello")) + ""hello\nhello"")) + (is (string= (encode-json-to-string (format nil ""aquote")) + ""\"aquote""))) + +(test json-literals + (is (string= "true" (encode-json-to-string t))) + (is (string= "null" (encode-json-to-string nil)))) + +(defun is-same-number(nr) + "If it gets decoded back ok then it was encoded ok" + (is (= nr (decode-json-from-string (encode-json-to-string nr))))) + +(test json-number + (is (string= "0" (encode-json-to-string 0))) + (is (string= "13" (encode-json-to-string 13))) + (is (string= "13.02" (encode-json-to-string 13.02))) + + (is-same-number 2e10) + (is-same-number -1.3234e-10) + (is-same-number -1280.12356) + (is-same-number 1d2) + (is-same-number 1l2) + (is-same-number 1s2) + (is-same-number 1f2) + (is-same-number 1e2)) + +(defun decode-then-encode (json) + (with-objects-as-hashtables + (assert (member (elt json 0) '(#{ #[ #" ))) ;must be json + (flet ((normalize (string) + (remove #\Newline (remove #\Space string)))) + (let* ((decoded (decode-json-from-string json)) + (encoded (encode-json-to-string decoded))) +;; (format t "Json:~a~&" json) +;; (format t "Encoded:~a" encoded) + (is (string= (normalize json) + (normalize encoded))))))) + +(test test-encode-json-nathan-hawkins + (let ((foo '((a . 1) (b . 2) (c . 3)))) + (is (string= (encode-json-to-string foo) + "{"a":1,"b":2,"c":3}")))) + +(test test-encode-json-alist + (let ((alist `((:HELLO . 100)(:hi . 5))) + (expected "{"hello":100,"hi":5}")) + (is (string= (with-output-to-string (s) (encode-json-alist alist s)) + expected)))) + +(test test-encode-json-alist-two + (let ((alist `((HELLO . 100)(hi . 5))) + (expected "{"hello":100,"hi":5}")) + (is (string= (with-output-to-string (s) (encode-json-alist alist s)) + expected)))) + +(test test-encode-json-alist-string + (let ((alist `((:hello . "hej")(:hi . "tjena"))) + (expected "{"hello":"hej","hi":"tjena"}")) + (is (string= (with-output-to-string (s) (encode-json-alist alist s)) + expected)))) + +(test test-encode-json-alist-camel-case + (let ((alist `((:hello-message . "hej")(*also-starting-with-upper . "hej"))) + (expected "{"helloMessage":"hej","AlsoStartingWithUpper":"hej"}")) + (is (string= (with-output-to-string (s) (encode-json-alist alist s)) + expected)))) + +(test encode-pass-2 + (decode-then-encode "[[[[[[[[[[[[[[[[[[["Not too deep"]]]]]]]]]]]]]]]]]]]")) + +(test encode-pass-3 + (decode-then-encode "{ + "JSON Test Pattern pass3": { + "The outermost value": "must be an object or array." + } +} +")) + +;; Test inspired by the file pass1. +;; There are too many small differences just to decode-encode the whole pass1 file, +;; Instead the difficult parts are in separate tests below. + +(test controls + (decode-then-encode ""\\b\\f\\n\\r\\"")) + +(test slash + (let* ((z ""/ & /"") + (also-z ""/ & /"") ;Extra quote + (x (encode-json-to-string z)) + (also-x (encode-json-to-string also-z)) + (y (decode-json-from-string x)) + (also-y (decode-json-from-string also-x))) + (is (string= x also-x)) + (is (string= y also-y)) + (is (string= z y)))) + + +(test quoted + (decode-then-encode ""&#34; %22 0x22 034 &#x22;"")) + +(test alpha-1 + (decode-then-encode ""abcdefghijklmnopqrstuvwyz"")) + +(test alpha-2 + (decode-then-encode ""ABCDEFGHIJKLMNOPQRSTUVWYZ"")) + +(test digit + (decode-then-encode ""0123456789"")) + +(test special + (decode-then-encode ""`1~!@#$%^&*()_+-={':[,]}|;.</>?"")) + +(test hex + (decode-then-encode ""\u0123\u4567\u89AB\uCDEF\uabcd\uef4A"")) + +(test true + (decode-then-encode "[ true]")) + +(test false + (is (string= (encode-json-to-string (decode-json-from-string "[false]")) + "[null]")));;We dont separate between false and null +(test null + (decode-then-encode "[null]")) + +(test array + ;;Since empty lists becomes nil in lisp, they are converted back to null + (is (string= (encode-json-to-string (decode-json-from-string "[ ]")) + "null")) + ;;But you can use vectors + (is (string= (encode-json-to-string (vector 1 2)) + "[1,2]"))) + +(test character + ;;Characters are encoded to strings, but when decoded back to string + (is (string= (encode-json-to-string #\a) ""a""))) + + +(test hash-table-symbol + (let ((ht (make-hash-table))) + (setf (gethash 'symbols-are-now-converted-to-camel-case ht) 5) + (is (string= (encode-json-to-string ht) + "{"symbolsAreNowConvertedToCamelCase":5}")))) + +(test hash-table-string + (let ((ht (make-hash-table :test #'equal))) + (setf (gethash "lower x" ht) 5) + (is (string= (encode-json-to-string ht) + "{"lower x":5}")))) + + +(defparameter *encode-performace-test-string* + "{ + "JSON Test Pattern pass3": { + "The outermost value": "must be an object or array.", + "In this test": "It is an object.", + "Performance-1" : 123465.578, + "Performance-2" : 12e4, + "Performance-2" : "asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd", + "Performance-3" : ["asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd", + "asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd", + "asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd", + "asdasdsadsasdasdsdasdasdasdsaaaaaaaaaaaaasdasdasdasdasdsd"] + } +} +") + + + + + +(test encoder-performance + (with-objects-as-hashtables + (let* ((json-string *encode-performace-test-string*) + (chars (length json-string)) + (lisp-obj (decode-json-from-string json-string)) + (count 2000)) + (format t "Encoding ~a varying chars from memory ~a times." chars count) + (time + (dotimes (x count) + (let ((discard-soon (encode-json-to-string lisp-obj))) + (funcall #'identity discard-soon))))))) + + +

Added: branches/trunk-reorg/thirdparty/cl-json/t/testjson.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/testjson.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/testjson.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,2 @@ +(in-package :json-test) +(run! 'json) \ No newline at end of file

Added: branches/trunk-reorg/thirdparty/cl-json/t/testmisc.lisp =================================================================== --- branches/trunk-reorg/thirdparty/cl-json/t/testmisc.lisp 2007-10-07 22:04:17 UTC (rev 2229) +++ branches/trunk-reorg/thirdparty/cl-json/t/testmisc.lisp 2007-10-07 23:18:29 UTC (rev 2230) @@ -0,0 +1,50 @@ +(in-package :json-test) +(in-suite json) + +(test test-json-bind + (json-bind (hello hi ciao) "{"hello":100,"hi":5}" + (is (= hello 100)) + (is (= hi 5)) + (is-false ciao))) + + +(test test-json-bind-advanced + (json-bind (hello-world + sub-obj.property + sub-obj.missing-property + sub-obj.even-deeper-obj.some-stuff) + "{"helloWorld":100,"subObj":{"property":20,"evenDeeperObj":{"someStuff":"Guten Tag"}}}" + (is (= hello-world 100)) + (is (= sub-obj.property 20)) + (is-false sub-obj.missing-property) + (is (string= sub-obj.even-deeper-obj.some-stuff "Guten Tag")))) + +(test test-json-bind-with-alist + (let ((the-alist (decode-json-from-string "{"hello":100,"hi":5}"))) + (json-bind (hello hi ciao) the-alist + (is (= hello 100)) + (is (= hi 5)) + (is-false ciao)))) + +(test assoc-lookup + (is (equalp '(json::cdas widget-id (json::cdas parent data)) + (macroexpand-1 '(json::assoc-lookup parent widget-id data))))) + + +(defun-json-rpc foo (x y) + "Adds two numbers" + (+ x y)) + + +(test test-json-rpc + (let (result) + (setf result (json-rpc:invoke-rpc "{"method":"foo","params":[1,2],"id":999}")) + (is (string= result "{"result":3,"error":null,"id":999}")))) + +(test test-json-rpc-unknown-fn + (let (result) + (setf result (json-rpc:invoke-rpc "{"method":"secretmethod","params":[1,2],"id":"my id"}")) + (json-bind (result error id) result + (is-false result) + (is-true error) + (is (string= id "my id")))))