test/tests.lisp @ 88008e9aeac3

(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))


;;;; 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]"))


;;;; 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"))