;;; json-tests.el --- Test suite for json.el  -*- lexical-binding:t -*-

;; Copyright (C) 2015-2020 Free Software Foundation, Inc.

;; Author: Dmitry Gutov <dgutov@yandex.ru>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Code:

(require 'ert)
(require 'json)
(require 'map)
(require 'seq)

(eval-when-compile
  (require 'cl-lib))

(defmacro json-tests--with-temp-buffer (content &rest body)
  "Create a temporary buffer with CONTENT and evaluate BODY there.
Point is moved to beginning of the buffer."
  (declare (debug t) (indent 1))
  `(with-temp-buffer
     (insert ,content)
     (goto-char (point-min))
     ,@body))

;;; Utilities

(ert-deftest test-json-alist-p ()
  (should (json-alist-p '()))
  (should (json-alist-p '((()))))
  (should (json-alist-p '((a))))
  (should (json-alist-p '((a . 1))))
  (should (json-alist-p '((a . 1) (b 2) (c))))
  (should (json-alist-p '((:a) (:b 2) (:c . 3))))
  (should (json-alist-p '(("a" . 1) ("b" 2) ("c"))))
  (should-not (json-alist-p '(())))
  (should-not (json-alist-p '(a)))
  (should-not (json-alist-p '(a . 1)))
  (should-not (json-alist-p '((a . 1) . [])))
  (should-not (json-alist-p '((a . 1) [])))
  (should-not (json-alist-p '(:a :b :c)))
  (should-not (json-alist-p '(:a 1 :b 2 :c 3)))
  (should-not (json-alist-p '((:a 1) (:b 2) 3)))
  (should-not (json-alist-p '((:a 1) (:b 2) ())))
  (should-not (json-alist-p '(((a) 1) (b 2) (c 3))))
  (should-not (json-alist-p []))
  (should-not (json-alist-p [(a . 1)]))
  (should-not (json-alist-p #s(hash-table))))

(ert-deftest test-json-plist-p ()
  (should (json-plist-p '()))
  (should (json-plist-p '(:a 1)))
  (should (json-plist-p '(:a 1 :b 2 :c 3)))
  (should (json-plist-p '(:a :b)))
  (should (json-plist-p '(:a :b :c :d)))
  (should-not (json-plist-p '(a)))
  (should-not (json-plist-p '(a 1)))
  (should-not (json-plist-p '(a 1 b 2 c 3)))
  (should-not (json-plist-p '("a" 1 "b" 2 "c" 3)))
  (should-not (json-plist-p '(:a)))
  (should-not (json-plist-p '(:a :b :c)))
  (should-not (json-plist-p '(:a 1 :b 2 :c)))
  (should-not (json-plist-p '((:a 1))))
  (should-not (json-plist-p '((:a 1) (:b 2) (:c 3))))
  (should-not (json-plist-p []))
  (should-not (json-plist-p [:a 1]))
  (should-not (json-plist-p #s(hash-table))))

(ert-deftest test-json-plist-nreverse ()
  (should (equal (json--plist-nreverse '()) '()))
  (should (equal (json--plist-nreverse (list :a 1)) '(:a 1)))
  (should (equal (json--plist-nreverse (list :a 1 :b 2)) '(:b 2 :a 1)))
  (should (equal (json--plist-nreverse (list :a 1 :b 2 :c 3))
                 '(:c 3 :b 2 :a 1))))

(ert-deftest test-json-advance ()
  (json-tests--with-temp-buffer "{ \"a\": 1 }"
    (json-advance 0)
    (should (bobp))
    (json-advance)
    (should (= (point) (1+ (point-min))))
    (json-advance 0)
    (should (= (point) (1+ (point-min))))
    (json-advance 1)
    (should (= (point) (+ (point-min) 2)))
    (json-advance 3)
    (should (= (point) (+ (point-min) 5)))))

(ert-deftest test-json-peek ()
  (json-tests--with-temp-buffer ""
    (should (zerop (json-peek))))
  (json-tests--with-temp-buffer "{ \"a\": 1 }"
    (should (= (json-peek) ?\{))
    (goto-char (1- (point-max)))
    (should (= (json-peek) ?\}))
    (json-advance)
    (should (zerop (json-peek)))))

(ert-deftest test-json-pop ()
  (json-tests--with-temp-buffer ""
    (should-error (json-pop) :type 'json-end-of-file))
  (json-tests--with-temp-buffer "{ \"a\": 1 }"
    (should (= (json-pop) ?\{))
    (should (= (point) (1+ (point-min))))
    (goto-char (1- (point-max)))
    (should (= (json-pop) ?\}))
    (should-error (json-pop) :type 'json-end-of-file)))

(ert-deftest test-json-skip-whitespace ()
  (json-tests--with-temp-buffer ""
    (json-skip-whitespace)
    (should (bobp))
    (should (eobp)))
  (json-tests--with-temp-buffer "{}"
    (json-skip-whitespace)
    (should (bobp))
    (json-advance)
    (json-skip-whitespace)
    (should (= (point) (1+ (point-min))))
    (json-advance)
    (json-skip-whitespace)
    (should (eobp)))
  (json-tests--with-temp-buffer "\t\r\n\f\b { \"a\": 1 }"
    (json-skip-whitespace)
    (should (= (json-peek) ?\f)))
  (json-tests--with-temp-buffer "\t\r\n\t { \"a\": 1 }"
    (json-skip-whitespace)
    (should (= (json-peek) ?\{))))

;;; Paths

(ert-deftest test-json-path-to-position-with-objects ()
  (let* ((json-string "{\"foo\": {\"bar\": {\"baz\": \"value\"}}}")
         (matched-path (json-path-to-position 32 json-string)))
    (should (equal (plist-get matched-path :path) '("foo" "bar" "baz")))
    (should (equal (plist-get matched-path :match-start) 25))
    (should (equal (plist-get matched-path :match-end) 32))))

(ert-deftest test-json-path-to-position-with-arrays ()
  (let* ((json-string "{\"foo\": [\"bar\", [\"baz\"]]}")
         (matched-path (json-path-to-position 20 json-string)))
    (should (equal (plist-get matched-path :path) '("foo" 1 0)))
    (should (equal (plist-get matched-path :match-start) 18))
    (should (equal (plist-get matched-path :match-end) 23))))

(ert-deftest test-json-path-to-position-no-match ()
  (let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}")
         (matched-path (json-path-to-position 5 json-string)))
    (should-not matched-path)))

;;; Keywords

(ert-deftest test-json-read-keyword ()
  (json-tests--with-temp-buffer "true"
    (should (eq (json-read-keyword "true") t))
    (should (eobp)))
  (json-tests--with-temp-buffer "true "
    (should (eq (json-read-keyword "true") t))
    (should (eobp)))
  (json-tests--with-temp-buffer "true}"
    (should (eq (json-read-keyword "true") t))
    (should (= (point) (+ (point-min) 4))))
  (json-tests--with-temp-buffer "true false"
    (should (eq (json-read-keyword "true") t))
    (should (= (point) (+ (point-min) 5))))
  (json-tests--with-temp-buffer "true }"
    (should (eq (json-read-keyword "true") t))
    (should (= (point) (+ (point-min) 5))))
  (json-tests--with-temp-buffer "true |"
    (should (eq (json-read-keyword "true") t))
    (should (= (point) (+ (point-min) 5))))
  (json-tests--with-temp-buffer "false"
    (let ((json-false 'false))
      (should (eq (json-read-keyword "false") 'false)))
    (should (eobp)))
  (json-tests--with-temp-buffer "null"
    (let ((json-null 'null))
      (should (eq (json-read-keyword "null") 'null)))
    (should (eobp))))

(ert-deftest test-json-read-keyword-invalid ()
  (json-tests--with-temp-buffer ""
    (should (equal (should-error (json-read-keyword ""))
                   '(json-unknown-keyword "")))
    (should (equal (should-error (json-read-keyword "true"))
                   '(json-unknown-keyword ()))))
  (json-tests--with-temp-buffer "true"
    (should (equal (should-error (json-read-keyword "false"))
                   '(json-unknown-keyword "true"))))
  (json-tests--with-temp-buffer "foo"
    (should (equal (should-error (json-read-keyword "foo"))
                   '(json-unknown-keyword "foo")))
    (should (equal (should-error (json-read-keyword "bar"))
                   '(json-unknown-keyword "bar"))))
  (json-tests--with-temp-buffer " true"
    (should (equal (should-error (json-read-keyword "true"))
                   '(json-unknown-keyword ()))))
  (json-tests--with-temp-buffer "truefalse"
    (should (equal (should-error (json-read-keyword "true"))
                   '(json-unknown-keyword "truefalse"))))
  (json-tests--with-temp-buffer "true|"
    (should (equal (should-error (json-read-keyword "true"))
                   '(json-unknown-keyword "true")))))

(ert-deftest test-json-encode-keyword ()
  (should (equal (json-encode-keyword t) "true"))
  (let ((json-false 'false))
    (should (equal (json-encode-keyword 'false) "false"))
    (should (equal (json-encode-keyword json-false) "false")))
  (let ((json-null 'null))
    (should (equal (json-encode-keyword 'null) "null"))
    (should (equal (json-encode-keyword json-null) "null"))))

;;; Numbers

(ert-deftest test-json-read-integer ()
  (json-tests--with-temp-buffer "0 "
    (should (= (json-read-number) 0))
    (should (eobp)))
  (json-tests--with-temp-buffer "-0 "
    (should (= (json-read-number) 0))
    (should (eobp)))
  (json-tests--with-temp-buffer "3 "
    (should (= (json-read-number) 3))
    (should (eobp)))
  (json-tests--with-temp-buffer "-10 "
    (should (= (json-read-number) -10))
    (should (eobp)))
  (json-tests--with-temp-buffer (format "%d " (1+ most-positive-fixnum))
    (should (= (json-read-number) (1+ most-positive-fixnum)))
    (should (eobp)))
  (json-tests--with-temp-buffer (format "%d " (1- most-negative-fixnum))
    (should (= (json-read-number) (1- most-negative-fixnum)))
    (should (eobp))))

(ert-deftest test-json-read-fraction ()
  (json-tests--with-temp-buffer "0.0 "
    (should (= (json-read-number) 0.0))
    (should (eobp)))
  (json-tests--with-temp-buffer "-0.0 "
    (should (= (json-read-number) 0.0))
    (should (eobp)))
  (json-tests--with-temp-buffer "0.01 "
    (should (= (json-read-number) 0.01))
    (should (eobp)))
  (json-tests--with-temp-buffer "-0.01 "
    (should (= (json-read-number) -0.01))
    (should (eobp)))
  (json-tests--with-temp-buffer "123.456 "
    (should (= (json-read-number) 123.456))
    (should (eobp)))
  (json-tests--with-temp-buffer "-123.456 "
    (should (= (json-read-number) -123.456))
    (should (eobp))))

(ert-deftest test-json-read-exponent ()
  (json-tests--with-temp-buffer "0e0 "
    (should (= (json-read-number) 0e0))
    (should (eobp)))
  (json-tests--with-temp-buffer "-0E0 "
    (should (= (json-read-number) 0e0))
    (should (eobp)))
  (json-tests--with-temp-buffer "-0E+0 "
    (should (= (json-read-number) 0e0))
    (should (eobp)))
  (json-tests--with-temp-buffer "0e-0 "
    (should (= (json-read-number) 0e0))
    (should (eobp)))
  (json-tests--with-temp-buffer "12e34 "
    (should (= (json-read-number) 12e34))
    (should (eobp)))
  (json-tests--with-temp-buffer "-12E34 "
    (should (= (json-read-number) -12e34))
    (should (eobp)))
  (json-tests--with-temp-buffer "-12E+34 "
    (should (= (json-read-number) -12e34))
    (should (eobp)))
  (json-tests--with-temp-buffer "12e-34 "
    (should (= (json-read-number) 12e-34))
    (should (eobp))))

(ert-deftest test-json-read-fraction-exponent ()
  (json-tests--with-temp-buffer "0.0e0 "
    (should (= (json-read-number) 0.0e0))
    (should (eobp)))
  (json-tests--with-temp-buffer "-0.0E0 "
    (should (= (json-read-number) 0.0e0))
    (should (eobp)))
  (json-tests--with-temp-buffer "0.12E-0 "
    (should (= (json-read-number) 0.12e0))
    (should (eobp)))
  (json-tests--with-temp-buffer "-12.34e+56 "
    (should (= (json-read-number) -12.34e+56))
    (should (eobp))))

(ert-deftest test-json-read-number-invalid ()
  (cl-flet ((read (str)
                  ;; Return error and point resulting from reading STR.
                  (json-tests--with-temp-buffer str
                    (cons (should-error (json-read-number)) (point)))))
    ;; POS is where each of its STRINGS becomes invalid.
    (pcase-dolist (`(,pos . ,strings)
                   '((1 "" "+" "-" "." "e" "e1" "abc" "++0" "++1"
                        "+0"  "+0.0" "+12" "+12.34" "+12.34e56"
                        ".0" "+.0" "-.0" ".12" "+.12" "-.12"
                        ".e0" "+.e0" "-.e0" ".0e0" "+.0e0" "-.0e0")
                     (2 "01" "1ee1" "1e++1")
                     (3 "-01")
                     (4 "0.0.0" "1.1.1" "1e1e1")
                     (5 "-0.0.0" "-1.1.1")))
      ;; Expected error and point.
      (let ((res `((json-number-format ,pos) . ,pos)))
        (dolist (str strings)
          (should (equal (read str) res)))))))

(ert-deftest test-json-encode-number ()
  (should (equal (json-encode-number 0) "0"))
  (should (equal (json-encode-number -0) "0"))
  (should (equal (json-encode-number 3) "3"))
  (should (equal (json-encode-number -5) "-5"))
  (should (equal (json-encode-number 123.456) "123.456"))
  (let ((bignum (1+ most-positive-fixnum)))
    (should (equal (json-encode-number bignum)
                   (number-to-string bignum)))))

;;; Strings

(ert-deftest test-json-read-escaped-char ()
  (json-tests--with-temp-buffer "\\\""
    (should (= (json-read-escaped-char) ?\"))
    (should (eobp)))
  (json-tests--with-temp-buffer "\\\\ "
    (should (= (json-read-escaped-char) ?\\))
    (should (= (point) (+ (point-min) 2))))
  (json-tests--with-temp-buffer "\\b "
    (should (= (json-read-escaped-char) ?\b))
    (should (= (point) (+ (point-min) 2))))
  (json-tests--with-temp-buffer "\\f "
    (should (= (json-read-escaped-char) ?\f))
    (should (= (point) (+ (point-min) 2))))
  (json-tests--with-temp-buffer "\\n "
    (should (= (json-read-escaped-char) ?\n))
    (should (= (point) (+ (point-min) 2))))
  (json-tests--with-temp-buffer "\\r "
    (should (= (json-read-escaped-char) ?\r))
    (should (= (point) (+ (point-min) 2))))
  (json-tests--with-temp-buffer "\\t "
    (should (= (json-read-escaped-char) ?\t))
    (should (= (point) (+ (point-min) 2))))
  (json-tests--with-temp-buffer "\\x "
    (should (= (json-read-escaped-char) ?x))
    (should (= (point) (+ (point-min) 2))))
  (json-tests--with-temp-buffer "\\ud800\\uDC00 "
    (should (= (json-read-escaped-char) #x10000))
    (should (= (point) (+ (point-min) 12))))
  (json-tests--with-temp-buffer "\\ud7ff\\udc00 "
    (should (= (json-read-escaped-char) #xd7ff))
    (should (= (point) (+ (point-min) 6))))
  (json-tests--with-temp-buffer "\\uffff "
    (should (= (json-read-escaped-char) #xffff))
    (should (= (point) (+ (point-min) 6))))
  (json-tests--with-temp-buffer "\\ufffff "
    (should (= (json-read-escaped-char) #xffff))
    (should (= (point) (+ (point-min) 6)))))

(ert-deftest test-json-read-escaped-char-invalid ()
  (json-tests--with-temp-buffer ""
    (should-error (json-read-escaped-char)))
  (json-tests--with-temp-buffer "\\"
    (should-error (json-read-escaped-char) :type 'json-end-of-file))
  (json-tests--with-temp-buffer "\\ufff "
    (should (equal (should-error (json-read-escaped-char))
                   (list 'json-string-escape (+ (point-min) 2)))))
  (json-tests--with-temp-buffer "\\ufffg "
    (should (equal (should-error (json-read-escaped-char))
                   (list 'json-string-escape (+ (point-min) 2))))))

(ert-deftest test-json-read-string ()
  (json-tests--with-temp-buffer ""
    (should-error (json-read-string)))
  (json-tests--with-temp-buffer "\"formfeed\f\""
    (should (equal (should-error (json-read-string))
                   '(json-string-format ?\f))))
  (json-tests--with-temp-buffer "\"\""
    (should (equal (json-read-string) "")))
  (json-tests--with-temp-buffer "\"foo \\\"bar\\\"\""
    (should (equal (json-read-string) "foo \"bar\"")))
  (json-tests--with-temp-buffer "\"abcαβγ\""
    (should (equal (json-read-string) "abcαβγ")))
  (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\""
    (should (equal (json-read-string) "\nasdфывfgh\t")))
  ;; Bug#24784
  (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\""
    (should (equal (json-read-string) "\U0001D11E")))
  (json-tests--with-temp-buffer "f"
    (should-error (json-read-string) :type 'json-end-of-file))
  (json-tests--with-temp-buffer "foo"
    (should-error (json-read-string) :type 'json-end-of-file)))

(ert-deftest test-json-encode-string ()
  (should (equal (json-encode-string "") "\"\""))
  (should (equal (json-encode-string "a") "\"a\""))
  (should (equal (json-encode-string "foo") "\"foo\""))
  (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\""))
  (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t")
                 "\"\\nasdфыв\\u001f\u007ffgh\\t\"")))

(ert-deftest test-json-encode-key ()
  (should (equal (json-encode-key "") "\"\""))
  (should (equal (json-encode-key '##) "\"\""))
  (should (equal (json-encode-key :) "\"\""))
  (should (equal (json-encode-key "foo") "\"foo\""))
  (should (equal (json-encode-key 'foo) "\"foo\""))
  (should (equal (json-encode-key :foo) "\"foo\""))
  (should (equal (should-error (json-encode-key 5))
                 '(json-key-format 5)))
  (should (equal (should-error (json-encode-key ["foo"]))
                 '(json-key-format ["foo"])))
  (should (equal (should-error (json-encode-key '("foo")))
                 '(json-key-format ("foo")))))

;;; Objects

(ert-deftest test-json-new-object ()
  (let ((json-object-type 'alist))
    (should-not (json-new-object)))
  (let ((json-object-type 'plist))
    (should-not (json-new-object)))
  (let* ((json-object-type 'hash-table)
         (json-object (json-new-object)))
    (should (hash-table-p json-object))
    (should (map-empty-p json-object))
    (should (eq (hash-table-test json-object) #'equal))))

(ert-deftest test-json-add-to-alist ()
  (let* ((json-object-type 'alist)
         (obj (json-new-object)))
    (let ((json-key-type nil))
      (setq obj (json-add-to-object obj "a" 1))
      (setq obj (json-add-to-object obj "b" 2))
      (should (equal (assq 'a obj) '(a . 1)))
      (should (equal (assq 'b obj) '(b . 2))))
    (let ((json-key-type 'symbol))
      (setq obj (json-add-to-object obj "c" 3))
      (setq obj (json-add-to-object obj "d" 4))
      (should (equal (assq 'c obj) '(c . 3)))
      (should (equal (assq 'd obj) '(d . 4))))
    (let ((json-key-type 'keyword))
      (setq obj (json-add-to-object obj "e" 5))
      (setq obj (json-add-to-object obj "f" 6))
      (should (equal (assq :e obj) '(:e . 5)))
      (should (equal (assq :f obj) '(:f . 6))))
    (let ((json-key-type 'string))
      (setq obj (json-add-to-object obj "g" 7))
      (setq obj (json-add-to-object obj "h" 8))
      (should (equal (assoc "g" obj) '("g" . 7)))
      (should (equal (assoc "h" obj) '("h" . 8))))))

(ert-deftest test-json-add-to-plist ()
  (let* ((json-object-type 'plist)
         (obj (json-new-object)))
    (let ((json-key-type nil))
      (setq obj (json-add-to-object obj "a" 1))
      (setq obj (json-add-to-object obj "b" 2))
      (should (= (plist-get obj :a) 1))
      (should (= (plist-get obj :b) 2)))
    (let ((json-key-type 'keyword))
      (setq obj (json-add-to-object obj "c" 3))
      (setq obj (json-add-to-object obj "d" 4))
      (should (= (plist-get obj :c) 3))
      (should (= (plist-get obj :d) 4)))
    (let ((json-key-type 'symbol))
      (setq obj (json-add-to-object obj "e" 5))
      (setq obj (json-add-to-object obj "f" 6))
      (should (= (plist-get obj 'e) 5))
      (should (= (plist-get obj 'f) 6)))
    (let ((json-key-type 'string))
      (setq obj (json-add-to-object obj "g" 7))
      (setq obj (json-add-to-object obj "h" 8))
      (should (= (lax-plist-get obj "g") 7))
      (should (= (lax-plist-get obj "h") 8)))))

(ert-deftest test-json-add-to-hash-table ()
  (let* ((json-object-type 'hash-table)
         (obj (json-new-object)))
    (let ((json-key-type nil))
      (setq obj (json-add-to-object obj "a" 1))
      (setq obj (json-add-to-object obj "b" 2))
      (should (= (gethash "a" obj) 1))
      (should (= (gethash "b" obj) 2)))
    (let ((json-key-type 'string))
      (setq obj (json-add-to-object obj "c" 3))
      (setq obj (json-add-to-object obj "d" 4))
      (should (= (gethash "c" obj) 3))
      (should (= (gethash "d" obj) 4)))
    (let ((json-key-type 'symbol))
      (setq obj (json-add-to-object obj "e" 5))
      (setq obj (json-add-to-object obj "f" 6))
      (should (= (gethash 'e obj) 5))
      (should (= (gethash 'f obj) 6)))
    (let ((json-key-type 'keyword))
      (setq obj (json-add-to-object obj "g" 7))
      (setq obj (json-add-to-object obj "h" 8))
      (should (= (gethash :g obj) 7))
      (should (= (gethash :h obj) 8)))))

(ert-deftest test-json-read-object ()
  (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }"
    (let ((json-object-type 'alist))
      (should (equal (json-read-object) '((a . 1) (b . 2))))))
  (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }"
    (let ((json-object-type 'plist))
      (should (equal (json-read-object) '(:a 1 :b 2)))))
  (json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }"
    (let* ((json-object-type 'hash-table)
           (hash-table (json-read-object)))
      (should (= (gethash "a" hash-table) 1))
      (should (= (gethash "b" hash-table) 2)))))

(ert-deftest test-json-read-object-empty ()
  (json-tests--with-temp-buffer "{}"
    (let ((json-object-type 'alist))
      (should-not (save-excursion (json-read-object))))
    (let ((json-object-type 'plist))
      (should-not (save-excursion (json-read-object))))
    (let* ((json-object-type 'hash-table)
           (hash-table (json-read-object)))
      (should (hash-table-p hash-table))
      (should (map-empty-p hash-table)))))

(ert-deftest test-json-read-object-invalid ()
  (json-tests--with-temp-buffer "{ \"a\" 1, \"b\": 2 }"
    (should (equal (should-error (json-read-object))
                   '(json-object-format ":" ?1))))
  (json-tests--with-temp-buffer "{ \"a\": 1 \"b\": 2 }"
    (should (equal (should-error (json-read-object))
                   '(json-object-format "," ?\")))))

(ert-deftest test-json-read-object-function ()
  (let* ((pre nil)
         (post nil)
         (keys '("b" "a"))
         (json-pre-element-read-function
          (lambda (key)
            (setq pre 'pre)
            (should (equal key (pop keys)))))
         (json-post-element-read-function
          (lambda () (setq post 'post))))
    (json-tests--with-temp-buffer "{ \"b\": 2, \"a\": 1 }"
      (json-read-object)
      (should (eq pre 'pre))
      (should (eq post 'post)))))

(ert-deftest test-json-encode-hash-table ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print nil))
    (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
    (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
                   "{\"a\":1}"))
    (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
                    '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}")))
    (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
                    '("{\"a\":1,\"b\":2,\"c\":3}"
                      "{\"a\":1,\"c\":3,\"b\":2}"
                      "{\"b\":2,\"a\":1,\"c\":3}"
                      "{\"b\":2,\"c\":3,\"a\":1}"
                      "{\"c\":3,\"a\":1,\"b\":2}"
                      "{\"c\":3,\"b\":2,\"a\":1}")))))

(ert-deftest test-json-encode-hash-table-pretty ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print t)
        (json-encoding-default-indentation " ")
        (json-encoding-lisp-style-closings nil))
    (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
    (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
                   "{\n \"a\": 1\n}"))
    (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
                    '("{\n \"a\": 1,\n \"b\": 2\n}"
                      "{\n \"b\": 2,\n \"a\": 1\n}")))
    (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
                    '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}"
                      "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}"
                      "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}"
                      "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1\n}"
                      "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2\n}"
                      "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}")))))

(ert-deftest test-json-encode-hash-table-lisp-style ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print t)
        (json-encoding-default-indentation " ")
        (json-encoding-lisp-style-closings t))
    (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
    (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
                   "{\n \"a\": 1}"))
    (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
                    '("{\n \"a\": 1,\n \"b\": 2}"
                      "{\n \"b\": 2,\n \"a\": 1}")))
    (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
                    '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}"
                      "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}"
                      "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}"
                      "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1}"
                      "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2}"
                      "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}")))))

(ert-deftest test-json-encode-hash-table-sort ()
  (let ((json-encoding-object-sort-predicate #'string<)
        (json-encoding-pretty-print nil))
    (pcase-dolist (`(,in . ,out)
                   '((#s(hash-table) . "{}")
                     (#s(hash-table data (a 1)) . "{\"a\":1}")
                     (#s(hash-table data (b 2 a 1)) . "{\"a\":1,\"b\":2}")
                     (#s(hash-table data (c 3 b 2 a 1))
                        . "{\"a\":1,\"b\":2,\"c\":3}")))
      (let ((copy (map-pairs in)))
        (should (equal (json-encode-hash-table in) out))
        ;; Ensure sorting isn't destructive.
        (should (seq-set-equal-p (map-pairs in) copy))))))

(ert-deftest test-json-encode-alist ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print nil))
    (should (equal (json-encode-alist ()) "{}"))
    (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}"))
    (should (equal (json-encode-alist '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
    (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
                   "{\"c\":3,\"b\":2,\"a\":1}"))))

(ert-deftest test-json-encode-alist-pretty ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print t)
        (json-encoding-default-indentation " ")
        (json-encoding-lisp-style-closings nil))
    (should (equal (json-encode-alist ()) "{}"))
    (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1\n}"))
    (should (equal (json-encode-alist '((b . 2) (a . 1)))
                   "{\n \"b\": 2,\n \"a\": 1\n}"))
    (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
                   "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}"))))

(ert-deftest test-json-encode-alist-lisp-style ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print t)
        (json-encoding-default-indentation " ")
        (json-encoding-lisp-style-closings t))
    (should (equal (json-encode-alist ()) "{}"))
    (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1}"))
    (should (equal (json-encode-alist '((b . 2) (a . 1)))
                   "{\n \"b\": 2,\n \"a\": 1}"))
    (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
                   "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}"))))

(ert-deftest test-json-encode-alist-sort ()
  (let ((json-encoding-object-sort-predicate #'string<)
        (json-encoding-pretty-print nil))
    (pcase-dolist (`(,in . ,out)
                   '((() . "{}")
                     (((a . 1)) . "{\"a\":1}")
                     (((b . 2) (a . 1)) . "{\"a\":1,\"b\":2}")
                     (((c . 3) (b . 2) (a . 1))
                      . "{\"a\":1,\"b\":2,\"c\":3}")))
      (let ((copy (copy-alist in)))
        (should (equal (json-encode-alist in) out))
        ;; Ensure sorting isn't destructive (bug#40693).
        (should (equal in copy))))))

(ert-deftest test-json-encode-plist ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print nil))
    (should (equal (json-encode-plist ()) "{}"))
    (should (equal (json-encode-plist '(:a 1)) "{\"a\":1}"))
    (should (equal (json-encode-plist '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
    (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
                   "{\"c\":3,\"b\":2,\"a\":1}"))))

(ert-deftest test-json-encode-plist-pretty ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print t)
        (json-encoding-default-indentation " ")
        (json-encoding-lisp-style-closings nil))
    (should (equal (json-encode-plist ()) "{}"))
    (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1\n}"))
    (should (equal (json-encode-plist '(:b 2 :a 1))
                   "{\n \"b\": 2,\n \"a\": 1\n}"))
    (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
                   "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}"))))

(ert-deftest test-json-encode-plist-lisp-style ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print t)
        (json-encoding-default-indentation " ")
        (json-encoding-lisp-style-closings t))
    (should (equal (json-encode-plist ()) "{}"))
    (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1}"))
    (should (equal (json-encode-plist '(:b 2 :a 1))
                   "{\n \"b\": 2,\n \"a\": 1}"))
    (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
                   "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}"))))

(ert-deftest test-json-encode-plist-sort ()
  (let ((json-encoding-object-sort-predicate #'string<)
        (json-encoding-pretty-print nil))
    (pcase-dolist (`(,in . ,out)
                   '((() . "{}")
                     ((:a 1) . "{\"a\":1}")
                     ((:b 2 :a 1) . "{\"a\":1,\"b\":2}")
                     ((:c 3 :b 2 :a 1) . "{\"a\":1,\"b\":2,\"c\":3}")))
      (let ((copy (copy-sequence in)))
        (should (equal (json-encode-plist in) out))
        ;; Ensure sorting isn't destructive.
        (should (equal in copy))))))

(ert-deftest test-json-encode-list ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print nil))
    (should (equal (json-encode-list ()) "{}"))
    (should (equal (json-encode-list '(a)) "[\"a\"]"))
    (should (equal (json-encode-list '(:a)) "[\"a\"]"))
    (should (equal (json-encode-list '("a")) "[\"a\"]"))
    (should (equal (json-encode-list '(a 1)) "[\"a\",1]"))
    (should (equal (json-encode-list '("a" 1)) "[\"a\",1]"))
    (should (equal (json-encode-list '(:a 1)) "{\"a\":1}"))
    (should (equal (json-encode-list '((a . 1))) "{\"a\":1}"))
    (should (equal (json-encode-list '((:a . 1))) "{\"a\":1}"))
    (should (equal (json-encode-list '(:b 2 :a)) "[\"b\",2,\"a\"]"))
    (should (equal (json-encode-list '(4 3 2 1)) "[4,3,2,1]"))
    (should (equal (json-encode-list '(b 2 a 1)) "[\"b\",2,\"a\",1]"))
    (should (equal (json-encode-list '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
    (should (equal (json-encode-list '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
    (should (equal (json-encode-list '((:b . 2) (:a . 1)))
                   "{\"b\":2,\"a\":1}"))
    (should (equal (json-encode-list '((a) 1)) "[[\"a\"],1]"))
    (should (equal (json-encode-list '((:a) 1)) "[[\"a\"],1]"))
    (should (equal (json-encode-list '(("a") 1)) "[[\"a\"],1]"))
    (should (equal (json-encode-list '((a 1) 2)) "[[\"a\",1],2]"))
    (should (equal (json-encode-list '((:a 1) 2)) "[{\"a\":1},2]"))
    (should (equal (json-encode-list '(((a . 1)) 2)) "[{\"a\":1},2]"))
    (should (equal (json-encode-list '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}"))
    (should (equal (json-encode-list '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}"))
    (should-error (json-encode-list '(a . 1)) :type 'wrong-type-argument)
    (should-error (json-encode-list '((a . 1) 2)) :type 'wrong-type-argument)
    (should (equal (should-error (json-encode-list []))
                   '(json-error [])))
    (should (equal (should-error (json-encode-list [a]))
                   '(json-error [a])))))

;;; Arrays

(ert-deftest test-json-read-array ()
  (let ((json-array-type 'vector))
    (json-tests--with-temp-buffer "[]"
      (should (equal (json-read-array) [])))
    (json-tests--with-temp-buffer "[ ]"
      (should (equal (json-read-array) [])))
    (json-tests--with-temp-buffer "[1]"
      (should (equal (json-read-array) [1])))
    (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]"
      (should (equal (json-read-array) [1 2 "a" "b"]))))
  (let ((json-array-type 'list))
    (json-tests--with-temp-buffer "[]"
      (should-not (json-read-array)))
    (json-tests--with-temp-buffer "[ ]"
      (should-not (json-read-array)))
    (json-tests--with-temp-buffer "[1]"
      (should (equal (json-read-array) '(1))))
    (json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]"
      (should (equal (json-read-array) '(1 2 "a" "b")))))
  (json-tests--with-temp-buffer "[1 2]"
    (should (equal (should-error (json-read-array))
                   '(json-array-format "," ?2)))))

(ert-deftest test-json-read-array-function ()
  (let* ((pre nil)
         (post nil)
         (keys '(0 1))
         (json-pre-element-read-function
          (lambda (key)
            (setq pre 'pre)
            (should (equal key (pop keys)))))
         (json-post-element-read-function
          (lambda () (setq post 'post))))
    (json-tests--with-temp-buffer "[1, 0]"
      (json-read-array)
      (should (eq pre 'pre))
      (should (eq post 'post)))))

(ert-deftest test-json-encode-array ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print nil))
    (should (equal (json-encode-array ()) "[]"))
    (should (equal (json-encode-array []) "[]"))
    (should (equal (json-encode-array '(1)) "[1]"))
    (should (equal (json-encode-array '[1]) "[1]"))
    (should (equal (json-encode-array '(2 1)) "[2,1]"))
    (should (equal (json-encode-array '[2 1]) "[2,1]"))
    (should (equal (json-encode-array '[:b a 2 1]) "[\"b\",\"a\",2,1]"))))

(ert-deftest test-json-encode-array-pretty ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print t)
        (json-encoding-default-indentation " ")
        (json-encoding-lisp-style-closings nil))
    (should (equal (json-encode-array ()) "[]"))
    (should (equal (json-encode-array []) "[]"))
    (should (equal (json-encode-array '(1)) "[\n 1\n]"))
    (should (equal (json-encode-array '[1]) "[\n 1\n]"))
    (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1\n]"))
    (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1\n]"))
    (should (equal (json-encode-array '[:b a 2 1])
                   "[\n \"b\",\n \"a\",\n 2,\n 1\n]"))))

(ert-deftest test-json-encode-array-lisp-style ()
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print t)
        (json-encoding-default-indentation " ")
        (json-encoding-lisp-style-closings t))
    (should (equal (json-encode-array ()) "[]"))
    (should (equal (json-encode-array []) "[]"))
    (should (equal (json-encode-array '(1)) "[\n 1]"))
    (should (equal (json-encode-array '[1]) "[\n 1]"))
    (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1]"))
    (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1]"))
    (should (equal (json-encode-array '[:b a 2 1])
                   "[\n \"b\",\n \"a\",\n 2,\n 1]"))))

;;; Reader

(ert-deftest test-json-read ()
  (pcase-dolist (`(,fn . ,contents)
                 '((json-read-string  "\"\"" "\"a\"")
                   (json-read-array   "[]" "[1]")
                   (json-read-object  "{}" "{\"a\":1}")
                   (json-read-keyword "null" "false" "true")
                   (json-read-number
                    "-0" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")))
    (dolist (content contents)
      ;; Check that leading whitespace is skipped.
      (dolist (str (list content (concat " " content)))
        (cl-letf* ((called nil)
                   ((symbol-function fn)
                    (lambda (&rest _) (setq called t))))
          (json-tests--with-temp-buffer str
            ;; We don't care exactly what the return value is (that is
            ;; tested elsewhere), but it should parse without error.
            (should (json-read))
            (should called)))))))

(ert-deftest test-json-read-invalid ()
  (json-tests--with-temp-buffer ""
    (should-error (json-read) :type 'json-end-of-file))
  (json-tests--with-temp-buffer " "
    (should-error (json-read) :type 'json-end-of-file))
  (json-tests--with-temp-buffer "x"
    (should (equal (should-error (json-read))
                  '(json-readtable-error ?x))))
  (json-tests--with-temp-buffer " x"
    (should (equal (should-error (json-read))
                  '(json-readtable-error ?x)))))

(ert-deftest test-json-read-from-string ()
  (dolist (str '("\"\"" "\"a\"" "[]" "[1]" "{}" "{\"a\":1}"
                 "null" "false" "true" "0" "123"))
    (json-tests--with-temp-buffer str
      (should (equal (json-read-from-string str)
                     (json-read))))))

;;; Encoder

(ert-deftest test-json-encode ()
  (should (equal (json-encode t) "true"))
  (let ((json-null 'null))
    (should (equal (json-encode json-null) "null")))
  (let ((json-false 'false))
    (should (equal (json-encode json-false) "false")))
  (should (equal (json-encode "") "\"\""))
  (should (equal (json-encode "foo") "\"foo\""))
  (should (equal (json-encode :) "\"\""))
  (should (equal (json-encode :foo) "\"foo\""))
  (should (equal (json-encode '(1)) "[1]"))
  (should (equal (json-encode 'foo) "\"foo\""))
  (should (equal (json-encode 0) "0"))
  (should (equal (json-encode 123) "123"))
  (let ((json-encoding-object-sort-predicate nil)
        (json-encoding-pretty-print nil))
    (should (equal (json-encode []) "[]"))
    (should (equal (json-encode [1]) "[1]"))
    (should (equal (json-encode #s(hash-table)) "{}"))
    (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}")))
  (with-temp-buffer
    (should (equal (should-error (json-encode (current-buffer)))
                   (list 'json-error (current-buffer))))))

;;; Pretty printing & minimizing

(defun json-tests-equal-pretty-print (original &optional expected)
  "Abort current test if pretty-printing ORIGINAL does not yield EXPECTED.

Both ORIGINAL and EXPECTED should be strings.  If EXPECTED is
nil, ORIGINAL should stay unchanged by pretty-printing."
  (with-temp-buffer
    (insert original)
    (json-pretty-print-buffer)
    (should (equal (buffer-string) (or expected original)))))

(ert-deftest test-json-pretty-print-string ()
  (json-tests-equal-pretty-print "\"\"")
  (json-tests-equal-pretty-print "\"foo\""))

(ert-deftest test-json-pretty-print-atom ()
  (json-tests-equal-pretty-print "true")
  (json-tests-equal-pretty-print "false")
  (json-tests-equal-pretty-print "null"))

(ert-deftest test-json-pretty-print-number ()
  (json-tests-equal-pretty-print "123")
  (json-tests-equal-pretty-print "0.123"))

(ert-deftest test-json-pretty-print-object ()
  ;; Empty (regression test for bug#24252).
  (json-tests-equal-pretty-print "{}")
  ;; One pair.
  (json-tests-equal-pretty-print
   "{\"key\":1}"
   "{\n  \"key\": 1\n}")
  ;; Two pairs.
  (json-tests-equal-pretty-print
   "{\"key1\":1,\"key2\":2}"
   "{\n  \"key1\": 1,\n  \"key2\": 2\n}")
  ;; Nested object.
  (json-tests-equal-pretty-print
   "{\"foo\":{\"key\":1}}"
   "{\n  \"foo\": {\n    \"key\": 1\n  }\n}")
  ;; Nested array.
  (json-tests-equal-pretty-print
   "{\"key\":[1,2]}"
   "{\n  \"key\": [\n    1,\n    2\n  ]\n}"))

(ert-deftest test-json-pretty-print-array ()
  ;; Empty.
  (json-tests-equal-pretty-print "[]")
  ;; One item.
  (json-tests-equal-pretty-print
   "[1]"
   "[\n  1\n]")
  ;; Two items.
  (json-tests-equal-pretty-print
   "[1,2]"
   "[\n  1,\n  2\n]")
  ;; Nested object.
  (json-tests-equal-pretty-print
   "[{\"key\":1}]"
   "[\n  {\n    \"key\": 1\n  }\n]")
  ;; Nested array.
  (json-tests-equal-pretty-print
   "[[1,2]]"
   "[\n  [\n    1,\n    2\n  ]\n]"))

(provide 'json-tests)

;;; json-tests.el ends here
