test/tests.lisp @ a450f8f200cd

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


(defun check-reads-one-object (object string)
  (with-input-from-string (s string)
    (is (same object (jarl:read t s)))
    (signals end-of-file (jarl:read t s))))

(defun check-discards-one-object (string)
  (with-input-from-string (s string)
    (is (null (multiple-value-list (jarl:read nil s))))
    (signals end-of-file (jarl:read t s))))

(defun check-roundtrips (object)
  (is (same object (jarl:read t (jarl:print object nil)))))

(defun check-errors (line col string)
  (dolist (class '(t nil)) ; todo check discarding errors too
    (handler-case
        (progn
          (jarl:read class string)
          (error "Should have signaled a json-parsing-error when parsing ~S but didn't."
                 class))
      (jarl::json-parsing-error (e)
        (is (equal (list class line col)
                   (list class (jarl:line e) (jarl:column e))))))))


;;;; Basic Tests --------------------------------------------------------------
(defmacro define-basic-tests (name &rest clauses)
  `(define-test ,name
     ,@(loop :for (object string) :in clauses :collect
             (alexandria:once-only (object string)
               `(let ((,string (json ,string)))
                  ; Check that the entire string deserializes to the expected form.
                  (check-reads-one-object ,object ,string)
                  ; Check that we can roundtrip the form reliably.
                  (is (same ,object (jarl:read t (jarl:print ,object nil))))
                  ; Check that we can discard it safely.
                  (check-discards-one-object ,string))))))


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


(define-test multiple-objects
  (with-input-from-string (s (json "{} 1 2 [true, false] {'foo': null}"))
    (is (same (h) (jarl:read t s)))
    (is (same 1 (jarl:read t s)))
    (is (same 2 (jarl:read t s)))
    (is (same #(:true :false) (jarl:read t s)))
    (is (same (h "foo" nil) (jarl:read t s)))
    (is (eql :eof (jarl:read t s nil :eof)))
    (signals end-of-file (jarl:read t s))))


;;;; Real-World Data ----------------------------------------------------------
(defmacro define-file-test (name (object path) &body body)
  (alexandria:with-gensyms (string)
    `(define-test ,name
       (let ((,string (alexandria:read-file-into-string ,path)))
         ;; Check that discarding works.
         (check-discards-one-object ,string)
         (let ((,object (jarl:read t ,string)))
           ;; Check that we can discard it.
           (check-roundtrips ,object)
           ;; Other test-specific checks.
           ,@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"))

(define-file-test jira/MVNCENTRAL (o "test/data/jira/MVNCENTRAL.json"))


;;;; Error Tests --------------------------------------------------------------
(defmacro define-error-tests (name &rest clauses)
  `(define-test ,name
     ,@(loop :for (line col string) :in clauses
             :collect `(check-errors ,line ,col (json ,string)))))


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