| author |
Steve Losh <steve@stevelosh.com> |
| date |
Tue, 11 Aug 2020 23:09:18 -0400 |
| parents |
6823350d3792 |
| children |
b8a38e34e840 |
(in-package :jarl/test)
;;;; Utils --------------------------------------------------------------------
(defmacro define-test (name &body body)
`(test ,(intern (concatenate 'string (symbol-name 'test-) (symbol-name name)))
(let ((*package* ,*package*))
,@body)))
(defun run-tests ()
(1am:run))
(defun json (string)
;; This makes it less miserable to write JSON strings in Lisp.
(substitute #\" #\' string))
(defgeneric same (a b))
(defmethod same (a b)
(equal a b))
(defmethod same ((a vector) (b vector))
(and (= (length a) (length b))
(every #'same a b)))
(defmethod same ((a hash-table) (b hash-table))
(and (= (hash-table-count a)
(hash-table-count b))
(not (maphash (lambda (ak av)
(multiple-value-bind (bv found) (gethash ak b)
(when (or (not found) (not (same av bv)))
(return-from same nil))))
a))))
(defun h (&rest keys-and-values)
(alexandria:plist-hash-table keys-and-values :test #'equal))
(defun v (&rest values)
(coerce values 'vector))
(defun set-equal (x y)
(and (null (set-difference x y :test #'equal))
(null (set-difference y x :test #'equal))))
;;;; Basic Tests --------------------------------------------------------------
(defmacro define-basic-tests (name &rest clauses)
`(define-test ,name
,@(loop :for (object string) :in clauses :collect
(alexandria:once-only (object string)
`(progn
; check that the string deserializes to the expected form
(is (same ,object (jarl:read t (json ,string))))
; check that we can roundtrip the form reliably
(is (same ,object (jarl:read t (jarl:print ,object nil)))))))))
(define-basic-tests null
(nil "null"))
(define-basic-tests keywords
(:true "true")
(:false "false"))
(define-basic-tests integers
(0 "0")
(0 "-0")
(1 "1")
(-1 "-1")
(10 "10")
(-10 "-10")
(123456789123456789123456789 "123456789123456789123456789")
(-123456789123456789123456789 "-123456789123456789123456789"))
(define-basic-tests floats
(0.0d0 "0e0")
(0.0d0 "0.0e0")
(-0.0d0 "-0.0e0")
(1.0d0 "1e0")
(1.0d0 "1e+0")
(1.0d0 "1e-0")
(1.2d0 "1.2e0")
(1.2d0 "1.2e+0")
(1.2d0 "1.2e-0")
(100.0d0 "1e2")
(100.0d0 "1e+2")
(123.4d0 "0.01234e+4")
(0.1234d0 "1.234e-1")
(1.234d-10 "1.234e-10"))
(define-basic-tests strings
("" "''")
(" " "' '")
(" " " ' ' ")
("foo" "'foo'")
("\"foo" "'\\'foo'")
("f\\oo" "'f\\\\oo'")
((format nil "foo~%bar") "'foo\\nbar'")
((format nil "foo~Abar" #\tab) "'foo\\tbar'")
((format nil "u: ~A" (code-char #x1234)) "'u: \\u1234'")
((format nil "(~A)" (code-char #xCAFE)) "'(\\uCaFe)'")
((format nil "~A~A" (code-char #xABCD) (code-char #xBEEF)) "'\\uABCD\\ubeef'"))
(define-basic-tests vectors
(#() "[]")
(#(1) "[1]")
(#(1 2 3) "[1,2,3]")
(#("meow" "wow") "['meow', 'wow']")
(#(1 nil "meow" :false -2 :true) "[1, null, 'meow', false, -2, true]")
(#(#(1 2) #() #(3.0d0 4.0d0 5.0d0)) "[[1, 2], [], [3e0, 40e-1, 0.5e1]]"))
(define-basic-tests objects
((h) "{}")
((h "foo" 1 "bar" 2) "{'foo': 1, 'bar': 2}")
((h "foo" 1 "bar" 2) "{'bar': 2, 'foo': 1}")
((h "foo" (h "a" nil "b" :false)
"bar" :true
"baz" (v (h) (h) (h)))
"{'foo': {'a': null, 'b': false},
'bar': true,
'baz': [{},{},{}]}"))
(define-basic-tests whitespace
(#() "[ ]")
((h) " { }")
((v (v) (h)) " [[ ] , { }]")
(#(1 2 3 4 5) " [ 1, 2 ,3, 4,5]"))
;;;; Real-World Data ----------------------------------------------------------
(defmacro define-file-test (name (object path) &body body)
`(define-test ,name
(let ((,object (with-open-file (s ,path)
(jarl:read t s))))
;; Check that we can roundtrip it first.
(is (same ,object (jarl:read t (jarl:print ,object nil))))
,@body)))
(define-file-test github/sjl (o "test/data/github/sjl.json")
(is (string= "sjl" (gethash "login" o)))
(is (= 182 (gethash "public_repos" o))))
(define-file-test github/sjl-repos (o "test/data/github/sjl-repos.json")
(is (set-equal '(:true :false)
(remove-duplicates (map 'list (lambda (r) (gethash "fork" r)) o)))))
(define-file-test reddit/r-common_lisp (o "test/data/reddit/r-common_lisp.json"))
;;;; Error Tests --------------------------------------------------------------
(defmacro define-error-tests (name &rest clauses)
`(define-test ,name
,@(loop :for (line col string) :in clauses :collect
(alexandria:once-only (line col string)
`(handler-case (progn (jarl:read t (json ,string))
(error "Should have signaled a json-parsing-error but didn't."))
(jarl::json-parsing-error
(e)
(1am:is (equal (cons ,line ,col)
(cons (jarl:line e)
(jarl:column e))))))))))
(define-error-tests trash
(1 1 "meow")
(1 3 "number")
(1 4 "truthy")
(1 3 "famous")
(1 1 "<what>")
(1 1 "(cons nil nil)")
(1 1 "NULL")
(1 1 "undefined")
(1 1 "NaN")
(1 1 ":::")
(1 1 "&rest")
(1 1 "]")
(1 1 "}"))
(define-error-tests bad-eof
(1 4 "nul")
(1 4 "tru")
(1 5 "fals")
(1 2 "[")
(1 7 "['no',")
(1 6 "['no'")
(1 5 "[[[{")
(1 2 "{")
(1 6 "{'foo")
(1 7 "{'foo'")
(1 8 "{'foo':")
(1 10 "{'foo': 1")
(1 11 "{'foo': 1,")
(1 2 "'")
(1 7 "'whops")
(1 9 "'whops\\'")
(1 2 "1.")
(1 2 "1e")
(1 3 "1e-")
(1 3 "1e+")
(1 1 "-"))
(define-error-tests mispaired-delimiters
(1 2 "{]")
(1 2 "[}")
(1 10 "[1, [2, 3}]"))
(define-error-tests commas
(1 1 ",")
(1 2 "[,]")
(1 4 "[1 2]")
(1 4 "[1,,2]")
(1 2 "{,}")
(1 9 "{'a': 1,}")
(1 9 "{'a': 1,, 'b': 2}")
(1 5 "{'a', 1}")
(1 2 "{,'a': 1}"))
(define-error-tests unescaped-string-chars
;; todo more of these
(2 0 (format nil "'~%'")))
(define-error-tests bad-unicode-sequence
;; todo more of these
(1 4 "'\\uNOPE'")
(1 6 "'\\u12'")
(1 4 "'\\u 1234'")
(1 4 "'\\uUUID'"))
(define-error-tests bad-escape
;; todo more of these
(1 3 "'\\x'"))
(define-error-tests leading-zero
(1 1 "01")
(1 1 "00")
(1 1 "00.0"))