--- 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 <steve@stevelosh.com>"
: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"))))
--- 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 "<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"))
+