# HG changeset patch # User Steve Losh # Date 1597114454 14400 # Node ID 4c59ba2362d86d3e0070a9f202e5ab1f3c32372c # Parent 9e6018aa6c5d2296e45d084c83c1411e096179dc Add basic tests diff -r 9e6018aa6c5d -r 4c59ba2362d8 jarl.asd --- a/jarl.asd Tue Jul 28 22:54:19 2020 -0400 +++ b/jarl.asd Mon Aug 10 22:54:14 2020 -0400 @@ -22,7 +22,7 @@ :author "Steve Losh " :license "MIT" - :depends-on (:jarl :1am) + :depends-on (:jarl :1am :alexandria) :serial t :components ((:module "test" @@ -31,4 +31,4 @@ (:file "tests")))) :perform (asdf:test-op (op system) - (funcall (read-from-string "jarl.test:run-tests")))) + (funcall (read-from-string "jarl/test:run-tests")))) diff -r 9e6018aa6c5d -r 4c59ba2362d8 src/main.lisp --- a/src/main.lisp Tue Jul 28 22:54:19 2020 -0400 +++ b/src/main.lisp Mon Aug 10 22:54:14 2020 -0400 @@ -246,14 +246,15 @@ (defmethod read% ((class (eql t)) contained-class input) (skip-whitespace input) - (ecase (p input) + (case (p input) (:eof (r input) (e 't input "got ~S" :eof)) ((#\t #\f) (read% 'keyword nil input)) (#\n (read% 'null nil input)) (#\" (read% 'string nil input)) (#\{ (read% 'hash-table '(t) input)) (#\[ (read% 'vector '(t) input)) - ((#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (read% 'number nil input)))) + ((#\- #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9) (read% 'number nil input)) + (t (e 't input "unexpected character ~S" (r input))))) ;;;; Object Parsers ----------------------------------------------------------- diff -r 9e6018aa6c5d -r 4c59ba2362d8 src/package.lisp --- a/src/package.lisp Tue Jul 28 22:54:19 2020 -0400 +++ b/src/package.lisp Mon Aug 10 22:54:14 2020 -0400 @@ -2,5 +2,6 @@ (:use :cl) (:shadow :read :print) (:export - :read-json - :print-json)) + :read :print + + :json-parsing-error :line :column)) diff -r 9e6018aa6c5d -r 4c59ba2362d8 test/package.lisp --- a/test/package.lisp Tue Jul 28 22:54:19 2020 -0400 +++ b/test/package.lisp Mon Aug 10 22:54:14 2020 -0400 @@ -1,3 +1,3 @@ -(defpackage :jarl.test +(defpackage :jarl/test (:use :cl :1am) (:export :run-tests)) diff -r 9e6018aa6c5d -r 4c59ba2362d8 test/tests.lisp --- a/test/tests.lisp Tue Jul 28 22:54:19 2020 -0400 +++ b/test/tests.lisp Mon Aug 10 22:54:14 2020 -0400 @@ -1,5 +1,4 @@ -(in-package :jarl.test) - +(in-package :jarl/test) ;;;; Utils -------------------------------------------------------------------- (defmacro define-test (name &body body) @@ -7,11 +6,208 @@ (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)) -;;;; Tests -------------------------------------------------------------------- -(define-test noop - (is (= 1 1))) +(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)) + + +;;;; 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 #xDEAD) (code-char #xBEEF)) "'\\uDEAD\\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]")) + + +;;;; 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 "") + (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")) +