test-json-parsing.ss
#lang scheme/base
;; See file "json-parsing.ss" for legal info.
;; $Id: test-json-parsing.ss,v 1.13 2010/12/26 08:58:22 neilpair Exp $

(require (planet neil/testeez:1:1)
         "json-parsing.ss")

(testeez
 "test-json-parsing.ss"

 (test-define "misc. JSON"
              misc-json-str
              "{\"a\":\"b\",\"c\":{\"d\":\"e\",\"f\":[\"g\",\"h\",\"i\"]},\"j\":\"k\",\"A\":null,\"B\":true,\"C\":false,\"D\":42,\"E\":3.1459,\"F\":3.0e+3,\"G\":7e-2} InvalidToken")

 (test/equal "misc. to SJSON"
             (json->sjson misc-json-str #:exhaust? #f)
             ;; Note: "#hasheq" here doesn't permit the "equal?" to work, but
             ;; "make-hasheq" seems to.  Perhaps because the former is mutable,
             ;; and the parser's is not at this time?
             (make-hasheq `((a . "b")
                            (c . ,(make-hasheq '((d . "e")
                                                 (f . ("g" "h" "i")))))
                            (j . "k")
                            (A . #\null)
                            (B . #t)
                            (C . #f)
                            (D . 42)
                            (E . 3.1459)
                            (F . 3000.0)
                            (G . 0.07))))

 (test/equal "misc. to SXML"
             (json->sxml misc-json-str #:exhaust? #f)
             '(*TOP*
               (object
                (member (@ (name "a")) (string "b"))
                (member (@ (name "c"))
                        (object
                         (member (@ (name "d")) (string "e"))
                         (member (@ (name "f"))
                                 (array (string "g")
                                        (string "h")
                                        (string "i")))))
                (member (@ (name "j")) (string "k"))
                (member (@ (name "A")) (null))
                (member (@ (name "B")) (true))
                (member (@ (name "C")) (false))
                (member (@ (name "D")) (number "42"))
                (member (@ (name "E")) (number "3.1459"))
                (member (@ (name "F")) (number "3000.0"))
                (member (@ (name "G")) (number "0.07")))))

 (test/equal "misc. to XML"
             (json->xml misc-json-str #:exhaust? #f)
             "<object><member name=\"a\"><string>b</string></member><member name=\"c\"><object><member name=\"d\"><string>e</string></member><member name=\"f\"><array><string>g</string><string>h</string><string>i</string></array></member></object></member><member name=\"j\"><string>k</string></member><member name=\"A\"><null/></member><member name=\"B\"><true/></member><member name=\"C\"><false/></member><member name=\"D\"><number>42</number></member><member name=\"E\"><number>3.1459</number></member><member name=\"F\"><number>3000.0</number></member><member name=\"G\"><number>0.07</number></member></object>")

 (test/equal "empty string"
             (let ((sxml (json->sxml "")))
               (if (eof-object? sxml) '*eof* sxml))
             '*eof*)

 (test/equal "space string"
             (let ((sxml (json->sxml "  ")))
               (if (eof-object? sxml) '*eof* sxml))
             '*eof*)

 (test/equal "read EOF"
             (let* ((json  "  42  ")
                    (in    (open-input-string json))
                    (sxml1 (json->sxml in #:exhaust? #f))
                    (sxml2 (json->sxml in #:exhaust? #f)))
               (values sxml1 (if (eof-object? sxml2) '*eof* sxml2)))
             (values '(*TOP* (number "42")) '*eof*))

 (test/equal "can read non-JSON immediately after JSON"
             (let* ((json "  [1]hello")
                    (in   (open-input-string json))
                    (sxml (json->sxml in #:exhaust? #f))
                    (str  (read-string 100 in)))
               (values sxml str))
             (values '(*TOP* (array (number "1"))) "hello"))

 (test/equal "escapes in string"
             (json->sjson " \"\\\"a\\\\\\/\\b\\f\\n\\r\\t\\u0000\\u0042\" ")
             "\"a\\/\b\f\n\r\t\u0000B")

 ;; TODO: Test "make-json-fold".

 ;; TODO: Test various error-checking.  Including extraneous stuff after
 ;; various tokens that it should error-catch on, like alpha right after
 ;; number.  See all uses of the error-signalling macro.

 ;; TODO: Add testing for various number formats.  We have already tested
 ;; interactively, but did not capture the tests.
 )