;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Theresa O'Connor <ted@oconnor.cx>
-;; Version: 1.4
+;; Version: 1.5
;; Keywords: convenience
;; This file is part of GNU Emacs.
;; Learn all about JSON here: <URL:http://json.org/>.
;; The user-serviceable entry points for the parser are the functions
-;; `json-read' and `json-read-from-string'. The encoder has a single
+;; `json-read' and `json-read-from-string'. The encoder has a single
;; entry point, `json-encode'.
;; Since there are several natural representations of key-value pair
-;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
+;; mappings in Elisp (alist, plist, hash-table), `json-read' allows you
;; to specify which you'd prefer (see `json-object-type' and
;; `json-array-type').
;;; Code:
(require 'map)
+(require 'seq)
(require 'subr-x)
;; Parameters
"If non-nil, then the output of `json-encode' will be pretty-printed.")
(defvar json-encoding-lisp-style-closings nil
- "If non-nil, ] and } closings will be formatted lisp-style,
-without indentation.")
+ "If non-nil, delimiters ] and } will be formatted Lisp-style.
+This means they will be placed on the same line as the last
+element of the respective array or object, without indentation.
+Used only when `json-encoding-pretty-print' is non-nil.")
(defvar json-encoding-object-sort-predicate nil
"Sorting predicate for JSON object keys during encoding.
ordered alphabetically.")
(defvar json-pre-element-read-function nil
- "Function called (if non-nil) by `json-read-array' and
-`json-read-object' right before reading a JSON array or object,
-respectively. The function is called with one argument, which is
-the current JSON key.")
+ "If non-nil, a function to call before reading a JSON array or object.
+It is called by `json-read-array' and `json-read-object',
+respectively, with one argument, which is the current JSON key.")
(defvar json-post-element-read-function nil
- "Function called (if non-nil) by `json-read-array' and
-`json-read-object' right after reading a JSON array or object,
-respectively.")
+ "If non-nil, a function to call after reading a JSON array or object.
+It is called by `json-read-array' and `json-read-object',
+respectively, with no arguments.")
\f
;;; Utilities
-(defun json-join (strings separator)
- "Join STRINGS with SEPARATOR."
- (mapconcat 'identity strings separator))
+(define-obsolete-function-alias 'json-join #'string-join "28.1")
(defun json-alist-p (list)
- "Non-null if and only if LIST is an alist with simple keys."
- (while (consp list)
- (setq list (if (and (consp (car list))
- (atom (caar list)))
- (cdr list)
- 'not-alist)))
+ "Non-nil if and only if LIST is an alist with simple keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (consp (car-safe list))
+ (atom (caar list))
+ (setq list (cdr list))))
(null list))
(defun json-plist-p (list)
- "Non-null if and only if LIST is a plist with keyword keys."
- (while (consp list)
- (setq list (if (and (keywordp (car list))
- (consp (cdr list)))
- (cddr list)
- 'not-plist)))
+ "Non-nil if and only if LIST is a plist with keyword keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (keywordp (car-safe list))
+ (consp (cdr list))
+ (setq list (cddr list))))
(null list))
-(defun json--plist-reverse (plist)
- "Return a copy of PLIST in reverse order.
-Unlike `reverse', this keeps the property-value pairs intact."
- (let (res)
- (while plist
- (let ((prop (pop plist))
- (val (pop plist)))
- (push val res)
- (push prop res)))
- res))
-
-(defun json--plist-to-alist (plist)
- "Return an alist of the property-value pairs in PLIST."
- (let (res)
- (while plist
- (let ((prop (pop plist))
- (val (pop plist)))
- (push (cons prop val) res)))
- (nreverse res)))
-
-(defmacro json--with-indentation (body)
+(defun json--plist-nreverse (plist)
+ "Return PLIST in reverse order.
+Unlike `nreverse', this keeps the ordering of each property
+relative to its value intact. Like `nreverse', this function may
+destructively modify PLIST to produce the result."
+ (let (prev (next (cddr plist)))
+ (while next
+ (setcdr (cdr plist) prev)
+ (setq prev plist plist next next (cddr next))
+ (setcdr (cdr plist) prev)))
+ plist)
+
+(defmacro json--with-indentation (&rest body)
+ "Evaluate BODY with the correct indentation for JSON encoding.
+This macro binds `json--encoding-current-indentation' according
+to `json-encoding-pretty-print' around BODY."
+ (declare (debug t) (indent 0))
`(let ((json--encoding-current-indentation
(if json-encoding-pretty-print
(concat json--encoding-current-indentation
json-encoding-default-indentation)
"")))
- ,body))
+ ,@body))
;; Reader utilities
(define-inline json-advance (&optional n)
- "Advance N characters forward."
+ "Advance N characters forward, or 1 character if N is nil.
+On reaching the end of the accessible region of the buffer, stop
+and signal an error."
(inline-quote (forward-char ,n)))
(define-inline json-peek ()
- "Return the character at point."
+ "Return the character at point.
+At the end of the accessible region of the buffer, return 0."
(inline-quote (following-char)))
(define-inline json-pop ()
- "Advance past the character at point, returning it."
+ "Advance past the character at point, returning it.
+Signal `json-end-of-file' if called at the end of the buffer."
(inline-quote
- (let ((char (json-peek)))
- (if (zerop char)
- (signal 'json-end-of-file nil)
- (json-advance)
- char))))
+ (prog1 (or (char-after)
+ (signal 'json-end-of-file ()))
+ (json-advance))))
(define-inline json-skip-whitespace ()
"Skip past the whitespace at point."
;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
;; or https://tools.ietf.org/html/rfc7159#section-2 for the
;; definition of whitespace in JSON.
- (inline-quote (skip-chars-forward "\t\r\n ")))
+ (inline-quote (skip-chars-forward "\t\n\r ")))
\f
;;; Paths
(defvar json--path '()
- "Used internally by `json-path-to-position' to keep track of
-the path during recursive calls to `json-read'.")
+ "Keeps track of the path during recursive calls to `json-read'.
+Used internally by `json-path-to-position'.")
(defun json--record-path (key)
"Record the KEY to the current JSON path.
"Check if the last parsed JSON structure passed POSITION.
Used internally by `json-path-to-position'."
(let ((start (caar json--path)))
- (when (< start position (+ (point) 1))
+ (when (< start position (1+ (point)))
(throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
:match-start start
:match-end (point)))))
:path -- A list of strings and numbers forming the path to
the JSON element at the given position. Strings
denote object names, while numbers denote array
- indexes.
+ indices.
:match-start -- Position where the matched JSON element begins.
:match-end -- Position where the matched JSON element ends.
-This can for instance be useful to determine the path to a JSON
+This can, for instance, be useful to determine the path to a JSON
element in a deeply nested structure."
(save-excursion
(unless string
(let* ((json--path '())
(json-pre-element-read-function #'json--record-path)
(json-post-element-read-function
- (apply-partially #'json--check-position position))
+ (lambda () (json--check-position position)))
(path (catch :json-path
(if string
(json-read-from-string string)
;;; Keywords
-(defvar json-keywords '("true" "false" "null")
+(defconst json-keywords '("true" "false" "null")
"List of JSON keywords.")
+(make-obsolete-variable 'json-keywords "it is no longer used." "28.1")
;; Keyword parsing
+;; Characters that can follow a JSON value.
+(rx-define json--post-value (| (in "\t\n\r ,]}") eos))
+
(defun json-read-keyword (keyword)
- "Read a JSON keyword at point.
-KEYWORD is the keyword expected."
- (unless (member keyword json-keywords)
- (signal 'json-unknown-keyword (list keyword)))
- (mapc (lambda (char)
- (when (/= char (json-peek))
- (signal 'json-unknown-keyword
- (list (save-excursion
- (backward-word-strictly 1)
- (thing-at-point 'word)))))
- (json-advance))
- keyword)
- (json-skip-whitespace)
- (unless (looking-at "\\([],}]\\|$\\)")
- (signal 'json-unknown-keyword
- (list (save-excursion
- (backward-word-strictly 1)
- (thing-at-point 'word)))))
- (cond ((string-equal keyword "true") t)
- ((string-equal keyword "false") json-false)
- ((string-equal keyword "null") json-null)))
+ "Read the expected JSON KEYWORD at point."
+ (prog1 (cond ((equal keyword "true") t)
+ ((equal keyword "false") json-false)
+ ((equal keyword "null") json-null)
+ (t (signal 'json-unknown-keyword (list keyword))))
+ (or (looking-at-p keyword)
+ (signal 'json-unknown-keyword (list (thing-at-point 'word))))
+ (json-advance (length keyword))
+ (or (looking-at-p (rx json--post-value))
+ (signal 'json-unknown-keyword (list (thing-at-point 'word))))
+ (json-skip-whitespace)))
;; Keyword encoding
(defun json-encode-keyword (keyword)
"Encode KEYWORD as a JSON value."
+ (declare (side-effect-free t))
(cond ((eq keyword t) "true")
((eq keyword json-false) "false")
((eq keyword json-null) "null")))
;; Number parsing
-(defun json-read-number (&optional sign)
- "Read the JSON number following point.
-The optional SIGN argument is for internal use.
-
-N.B.: Only numbers which can fit in Emacs Lisp's native number
-representation will be parsed correctly."
- ;; If SIGN is non-nil, the number is explicitly signed.
- (let ((number-regexp
- "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
- (cond ((and (null sign) (= (json-peek) ?-))
- (json-advance)
- (- (json-read-number t)))
- ((and (null sign) (= (json-peek) ?+))
- (json-advance)
- (json-read-number t))
- ((and (looking-at number-regexp)
- (or (match-beginning 1)
- (match-beginning 2)))
- (goto-char (match-end 0))
- (string-to-number (match-string 0)))
- (t (signal 'json-number-format (list (point)))))))
+(rx-define json--number
+ (: (? ?-) ; Sign.
+ (| (: (in "1-9") (* digit)) ?0) ; Integer.
+ (? ?. (+ digit)) ; Fraction.
+ (? (in "Ee") (? (in ?+ ?-)) (+ digit)))) ; Exponent.
+
+(defun json-read-number (&optional _sign)
+ "Read the JSON number following point."
+ (declare (advertised-calling-convention () "28.1"))
+ (or (looking-at (rx json--number))
+ (signal 'json-number-format (list (point))))
+ (goto-char (match-end 0))
+ (prog1 (string-to-number (match-string 0))
+ (or (looking-at-p (rx json--post-value))
+ (signal 'json-number-format (list (point))))
+ (json-skip-whitespace)))
;; Number encoding
-(defun json-encode-number (number)
- "Return a JSON representation of NUMBER."
- (format "%s" number))
+(defalias 'json-encode-number #'number-to-string
+ "Return a JSON representation of NUMBER.")
;;; Strings
-(defvar json-special-chars
+(defconst json-special-chars
'((?\" . ?\")
(?\\ . ?\\)
(?b . ?\b)
(?n . ?\n)
(?r . ?\r)
(?t . ?\t))
- "Characters which are escaped in JSON, with their elisp counterparts.")
+ "Characters which are escaped in JSON, with their Elisp counterparts.")
;; String parsing
(defun json-read-escaped-char ()
"Read the JSON string escaped character at point."
- ;; Skip over the '\'
+ ;; Skip over the '\'.
(json-advance)
- (let* ((char (json-pop))
- (special (assq char json-special-chars)))
+ (let ((char (json-pop)))
(cond
- (special (cdr special))
- ((not (eq char ?u)) char)
+ ((cdr (assq char json-special-chars)))
+ ((/= char ?u) char)
;; Special-case UTF-16 surrogate pairs,
;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that
;; this clause overlaps with the next one and therefore has to
;; come first.
((looking-at
- (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
- "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
+ (rx (group (any "Dd") (any "89ABab") (= 2 xdigit))
+ "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 xdigit))))
(json-advance 10)
(json--decode-utf-16-surrogates
(string-to-number (match-string 1) 16)
(string-to-number (match-string 2) 16)))
((looking-at (rx (= 4 xdigit)))
- (let ((hex (match-string 0)))
- (json-advance 4)
- (string-to-number hex 16)))
+ (json-advance 4)
+ (string-to-number (match-string 0) 16))
(t
(signal 'json-string-escape (list (point)))))))
(defun json-read-string ()
"Read the JSON string at point."
- (unless (= (json-peek) ?\")
- (signal 'json-string-format (list "doesn't start with `\"'!")))
- ;; Skip over the '"'
+ ;; Skip over the '"'.
(json-advance)
(let ((characters '())
(char (json-peek)))
- (while (not (= char ?\"))
+ (while (/= char ?\")
(when (< char 32)
- (signal 'json-string-format (list (prin1-char char))))
+ (if (zerop char)
+ (signal 'json-end-of-file ())
+ (signal 'json-string-format (list char))))
(push (if (= char ?\\)
(json-read-escaped-char)
- (json-pop))
+ (json-advance)
+ char)
characters)
(setq char (json-peek)))
- ;; Skip over the '"'
+ ;; Skip over the '"'.
(json-advance)
(if characters
(concat (nreverse characters))
;; String encoding
+;; Escape only quotation mark, backslash, and the control
+;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
+(rx-define json--escape (in ?\" ?\\ cntrl))
+
+(defvar json--long-string-threshold 200
+ "Length above which strings are considered long for JSON encoding.
+It is generally faster to manipulate such strings in a buffer
+rather than directly.")
+
+(defvar json--string-buffer nil
+ "Buffer used for encoding Lisp strings as JSON.
+Initialized lazily by `json-encode-string'.")
+
(defun json-encode-string (string)
"Return a JSON representation of STRING."
- ;; Reimplement the meat of `replace-regexp-in-string', for
- ;; performance (bug#20154).
- (let ((l (length string))
- (start 0)
- res mb)
- ;; Only escape quotation mark, backslash and the control
- ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
- (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
- (let* ((c (aref string mb))
- (special (rassq c json-special-chars)))
- (push (substring string start mb) res)
- (push (if special
- ;; Special JSON character (\n, \r, etc.).
- (string ?\\ (car special))
- ;; Fallback: UCS code point in \uNNNN form.
- (format "\\u%04x" c))
- res)
- (setq start (1+ mb))))
- (push (substring string start l) res)
- (push "\"" res)
- (apply #'concat "\"" (nreverse res))))
+ ;; Try to avoid buffer overhead in trivial cases, while also
+ ;; avoiding searching pathological strings for escape characters.
+ ;; Since `string-match-p' doesn't take a LIMIT argument, we use
+ ;; string length as our heuristic. See also bug#20154.
+ (if (and (< (length string) json--long-string-threshold)
+ (not (string-match-p (rx json--escape) string)))
+ (concat "\"" string "\"")
+ (with-current-buffer
+ (or json--string-buffer
+ (with-current-buffer (generate-new-buffer " *json-string*")
+ ;; This seems to afford decent performance gains.
+ (setq-local inhibit-modification-hooks t)
+ (setq json--string-buffer (current-buffer))))
+ (insert ?\" string)
+ (goto-char (1+ (point-min)))
+ (while (re-search-forward (rx json--escape) nil 'move)
+ (let ((char (preceding-char)))
+ (delete-char -1)
+ (insert ?\\ (or
+ ;; Special JSON character (\n, \r, etc.).
+ (car (rassq char json-special-chars))
+ ;; Fallback: UCS code point in \uNNNN form.
+ (format "u%04x" char)))))
+ (insert ?\")
+ ;; Empty buffer for next invocation.
+ (delete-and-extract-region (point-min) (point-max)))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
(signal 'json-key-format (list object)))
encoded))
-;;; JSON Objects
+;;; Objects
(defun json-new-object ()
- "Create a new Elisp object corresponding to a JSON object.
+ "Create a new Elisp object corresponding to an empty JSON object.
Please see the documentation of `json-object-type'."
- (cond ((eq json-object-type 'hash-table)
- (make-hash-table :test 'equal))
- (t
- ())))
+ (and (eq json-object-type 'hash-table)
+ (make-hash-table :test #'equal)))
(defun json-add-to-object (object key value)
"Add a new KEY -> VALUE association to OBJECT.
(setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
(let ((json-key-type
- (or json-key-type
- (cdr (assq json-object-type '((hash-table . string)
- (alist . symbol)
- (plist . keyword)))))))
+ (cond (json-key-type)
+ ((eq json-object-type 'hash-table) 'string)
+ ((eq json-object-type 'alist) 'symbol)
+ ((eq json-object-type 'plist) 'keyword))))
(setq key
(cond ((eq json-key-type 'string)
key)
(defun json-read-object ()
"Read the JSON object at point."
- ;; Skip over the "{"
+ ;; Skip over the '{'.
(json-advance)
(json-skip-whitespace)
- ;; read key/value pairs until "}"
+ ;; Read key/value pairs until '}'.
(let ((elements (json-new-object))
key value)
- (while (not (= (json-peek) ?}))
+ (while (/= (json-peek) ?\})
(json-skip-whitespace)
(setq key (json-read-string))
(json-skip-whitespace)
(funcall json-post-element-read-function))
(setq elements (json-add-to-object elements key value))
(json-skip-whitespace)
- (when (/= (json-peek) ?})
+ (when (/= (json-peek) ?\})
(if (= (json-peek) ?,)
(json-advance)
(signal 'json-object-format (list "," (json-peek))))))
- ;; Skip over the "}"
+ ;; Skip over the '}'.
(json-advance)
(pcase json-object-type
('alist (nreverse elements))
- ('plist (json--plist-reverse elements))
+ ('plist (json--plist-nreverse elements))
(_ elements))))
;; Hash table encoding
(defun json-encode-hash-table (hash-table)
"Return a JSON representation of HASH-TABLE."
- (if json-encoding-object-sort-predicate
- (json-encode-alist (map-into hash-table 'list))
- (format "{%s%s}"
- (json-join
- (let (r)
- (json--with-indentation
- (maphash
- (lambda (k v)
- (push (format
- (if json-encoding-pretty-print
- "%s%s: %s"
- "%s%s:%s")
- json--encoding-current-indentation
- (json-encode-key k)
- (json-encode v))
- r))
- hash-table))
- r)
- json-encoding-separator)
- (if (or (not json-encoding-pretty-print)
- json-encoding-lisp-style-closings)
- ""
- json--encoding-current-indentation))))
+ (cond ((hash-table-empty-p hash-table) "{}")
+ (json-encoding-object-sort-predicate
+ (json--encode-alist (map-pairs hash-table) t))
+ (t
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":"))
+ result)
+ (json--with-indentation
+ (maphash
+ (lambda (k v)
+ (push (concat json--encoding-current-indentation
+ (json-encode-key k)
+ kv-sep
+ (json-encode v))
+ result))
+ hash-table))
+ (concat "{"
+ (string-join (nreverse result) json-encoding-separator)
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}")))))
;; List encoding (including alists and plists)
-(defun json-encode-alist (alist)
- "Return a JSON representation of ALIST."
+(defun json--encode-alist (alist &optional destructive)
+ "Return a JSON representation of ALIST.
+DESTRUCTIVE non-nil means it is safe to modify ALIST by
+side-effects."
(when json-encoding-object-sort-predicate
- (setq alist
- (sort alist (lambda (a b)
+ (setq alist (sort (if destructive alist (copy-sequence alist))
+ (lambda (a b)
(funcall json-encoding-object-sort-predicate
(car a) (car b))))))
- (format "{%s%s}"
- (json-join
- (json--with-indentation
- (mapcar (lambda (cons)
- (format (if json-encoding-pretty-print
- "%s%s: %s"
- "%s%s:%s")
- json--encoding-current-indentation
- (json-encode-key (car cons))
- (json-encode (cdr cons))))
- alist))
- json-encoding-separator)
- (if (or (not json-encoding-pretty-print)
- json-encoding-lisp-style-closings)
- ""
- json--encoding-current-indentation)))
+ (concat "{"
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":")))
+ (json--with-indentation
+ (mapconcat (lambda (cons)
+ (concat json--encoding-current-indentation
+ (json-encode-key (car cons))
+ kv-sep
+ (json-encode (cdr cons))))
+ alist
+ json-encoding-separator)))
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}"))
+
+(defun json-encode-alist (alist)
+ "Return a JSON representation of ALIST."
+ (if alist (json--encode-alist alist) "{}"))
(defun json-encode-plist (plist)
"Return a JSON representation of PLIST."
- (if json-encoding-object-sort-predicate
- (json-encode-alist (json--plist-to-alist plist))
- (let (result)
- (json--with-indentation
- (while plist
- (push (concat
- json--encoding-current-indentation
- (json-encode-key (car plist))
- (if json-encoding-pretty-print
- ": "
- ":")
- (json-encode (cadr plist)))
+ (cond ((null plist) "{}")
+ (json-encoding-object-sort-predicate
+ (json--encode-alist (map-pairs plist) t))
+ (t
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":"))
result)
- (setq plist (cddr plist))))
- (concat "{"
- (json-join (nreverse result) json-encoding-separator)
- (if (and json-encoding-pretty-print
- (not json-encoding-lisp-style-closings))
- json--encoding-current-indentation
- "")
- "}"))))
+ (json--with-indentation
+ (while plist
+ (push (concat json--encoding-current-indentation
+ (json-encode-key (pop plist))
+ kv-sep
+ (json-encode (pop plist)))
+ result)))
+ (concat "{"
+ (string-join (nreverse result) json-encoding-separator)
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}")))))
(defun json-encode-list (list)
"Return a JSON representation of LIST.
(defun json-read-array ()
"Read the JSON array at point."
- ;; Skip over the "["
+ ;; Skip over the '['.
(json-advance)
(json-skip-whitespace)
- ;; read values until "]"
- (let (elements)
- (while (not (= (json-peek) ?\]))
+ ;; Read values until ']'.
+ (let (elements
+ (len 0))
+ (while (/= (json-peek) ?\])
(json-skip-whitespace)
(when json-pre-element-read-function
- (funcall json-pre-element-read-function (length elements)))
+ (funcall json-pre-element-read-function len)
+ (setq len (1+ len)))
(push (json-read) elements)
(when json-post-element-read-function
(funcall json-post-element-read-function))
(when (/= (json-peek) ?\])
(if (= (json-peek) ?,)
(json-advance)
- (signal 'json-array-format (list ?, (json-peek))))))
- ;; Skip over the "]"
+ (signal 'json-array-format (list "," (json-peek))))))
+ ;; Skip over the ']'.
(json-advance)
(pcase json-array-type
('vector (nreverse (vconcat elements)))
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
(if (and json-encoding-pretty-print
- (> (length array) 0))
+ (not (seq-empty-p array)))
(concat
+ "["
(json--with-indentation
- (concat (format "[%s" json--encoding-current-indentation)
- (json-join (mapcar 'json-encode array)
- (format "%s%s"
- json-encoding-separator
+ (concat json--encoding-current-indentation
+ (mapconcat #'json-encode array
+ (concat json-encoding-separator
json--encoding-current-indentation))))
- (format "%s]"
- (if json-encoding-lisp-style-closings
- ""
- json--encoding-current-indentation)))
+ (unless json-encoding-lisp-style-closings
+ json--encoding-current-indentation)
+ "]")
(concat "["
- (mapconcat 'json-encode array json-encoding-separator)
+ (mapconcat #'json-encode array json-encoding-separator)
"]")))
\f
-;;; JSON reader.
+;;; Reader
(defmacro json-readtable-dispatch (char)
- "Dispatch reader function for CHAR."
- (declare (debug (symbolp)))
- (let ((table
- '((?t json-read-keyword "true")
- (?f json-read-keyword "false")
- (?n json-read-keyword "null")
- (?{ json-read-object)
- (?\[ json-read-array)
- (?\" json-read-string)))
- res)
- (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (push (list c 'json-read-number) table))
- (pcase-dolist (`(,c . ,rest) table)
- (push `((eq ,char ,c) (,@rest)) res))
- `(cond ,@res (t (signal 'json-readtable-error (list ,char))))))
+ "Dispatch reader function for CHAR at point.
+If CHAR is nil, signal `json-end-of-file'."
+ (declare (debug t))
+ (macroexp-let2 nil char char
+ `(cond ,@(map-apply
+ (lambda (key expr)
+ `((eq ,char ,key) ,expr))
+ `((?\" ,#'json-read-string)
+ (?\[ ,#'json-read-array)
+ (?\{ ,#'json-read-object)
+ (?n ,#'json-read-keyword "null")
+ (?f ,#'json-read-keyword "false")
+ (?t ,#'json-read-keyword "true")
+ ,@(mapcar (lambda (c) (list c #'json-read-number))
+ '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))
+ (,char (signal 'json-readtable-error (list ,char)))
+ (t (signal 'json-end-of-file ())))))
(defun json-read ()
"Parse and return the JSON object following point.
((c . :json-false))])
(b . \"foo\"))"
(json-skip-whitespace)
- (let ((char (json-peek)))
- (if (zerop char)
- (signal 'json-end-of-file nil)
- (json-readtable-dispatch char))))
+ (json-readtable-dispatch (char-after)))
;; Syntactic sugar for the reader
"Read the first JSON object contained in FILE and return it."
(with-temp-buffer
(insert-file-contents file)
- (goto-char (point-min))
(json-read)))
\f
-;;; JSON encoder
+;;; Encoder
(defun json-encode (object)
"Return a JSON representation of OBJECT as a string.
OBJECT should have a structure like one returned by `json-read'.
If an error is detected during encoding, an error based on
`json-error' is signaled."
- (cond ((memq object (list t json-null json-false))
- (json-encode-keyword object))
- ((stringp object) (json-encode-string object))
- ((keywordp object) (json-encode-string
- (substring (symbol-name object) 1)))
- ((listp object) (json-encode-list object))
- ((symbolp object) (json-encode-string
- (symbol-name object)))
- ((numberp object) (json-encode-number object))
- ((arrayp object) (json-encode-array object))
- ((hash-table-p object) (json-encode-hash-table object))
- (t (signal 'json-error (list object)))))
-
-;; Pretty printing & minimizing
+ (cond ((eq object t) (json-encode-keyword object))
+ ((eq object json-null) (json-encode-keyword object))
+ ((eq object json-false) (json-encode-keyword object))
+ ((stringp object) (json-encode-string object))
+ ((keywordp object) (json-encode-string
+ (substring (symbol-name object) 1)))
+ ((listp object) (json-encode-list object))
+ ((symbolp object) (json-encode-string
+ (symbol-name object)))
+ ((numberp object) (json-encode-number object))
+ ((arrayp object) (json-encode-array object))
+ ((hash-table-p object) (json-encode-hash-table object))
+ (t (signal 'json-error (list object)))))
+
+;;; Pretty printing & minimizing
(defun json-pretty-print-buffer (&optional minimize)
"Pretty-print current buffer.
With prefix argument MINIMIZE, minimize it instead."
(interactive "r\nP")
(let ((json-encoding-pretty-print (null minimize))
- ;; Distinguish an empty objects from 'null'
+ ;; Distinguish an empty object from 'null'.
(json-null :json-null)
- ;; Ensure that ordering is maintained
+ ;; Ensure that ordering is maintained.
(json-object-type 'alist)
(orig-buf (current-buffer))
error)
;; them.
(let ((space (buffer-substring
(point)
- (+ (point)
- (skip-chars-forward
- " \t\n" (point-max)))))
+ (+ (point) (skip-chars-forward " \t\n"))))
(json (json-read)))
(setq pos (point)) ; End of last good json-read.
(set-buffer tmp-buf)
"Pretty-print current buffer with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
(interactive "P")
- (let ((json-encoding-object-sort-predicate 'string<))
+ (let ((json-encoding-object-sort-predicate #'string<))
(json-pretty-print-buffer minimize)))
(defun json-pretty-print-ordered (begin end &optional minimize)
"Pretty-print the region with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
(interactive "r\nP")
- (let ((json-encoding-object-sort-predicate 'string<))
+ (let ((json-encoding-object-sort-predicate #'string<))
(json-pretty-print begin end minimize)))
(provide 'json)
(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 (indent 1))
+ (declare (debug t) (indent 1))
`(with-temp-buffer
(insert ,content)
(goto-char (point-min))
;;; Utilities
-(ert-deftest test-json-join ()
- (should (equal (json-join '() ", ") ""))
- (should (equal (json-join '("a" "b" "c") ", ") "a, b, c")))
-
(ert-deftest test-json-alist-p ()
(should (json-alist-p '()))
- (should (json-alist-p '((a 1) (b 2) (c 3))))
- (should (json-alist-p '((:a 1) (:b 2) (:c 3))))
- (should (json-alist-p '(("a" 1) ("b" 2) ("c" 3))))
+ (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) 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 3)))))
-
-(ert-deftest test-json-plist-reverse ()
- (should (equal (json--plist-reverse '()) '()))
- (should (equal (json--plist-reverse '(:a 1)) '(:a 1)))
- (should (equal (json--plist-reverse '(:a 1 :b 2 :c 3))
+ (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-plist-to-alist ()
- (should (equal (json--plist-to-alist '()) '()))
- (should (equal (json--plist-to-alist '(:a 1)) '((:a . 1))))
- (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3))
- '((:a . 1) (:b . 2) (:c . 3)))))
-
(ert-deftest test-json-advance ()
(json-tests--with-temp-buffer "{ \"a\": 1 }"
(json-advance 0)
- (should (= (point) (point-min)))
+ (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) 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 (equal (json-peek) ?{))))
+ (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 (equal (json-pop) ?{))
- (should (= (point) (+ (point-min) 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 (equal (char-after) ?\f)))
+ (should (= (json-peek) ?\f)))
(json-tests--with-temp-buffer "\t\r\n\t { \"a\": 1 }"
(json-skip-whitespace)
- (should (equal (char-after) ?{))))
+ (should (= (json-peek) ?\{))))
;;; Paths
(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 (null matched-path))))
+ (should-not matched-path)))
;;; Keywords
(ert-deftest test-json-read-keyword ()
(json-tests--with-temp-buffer "true"
- (should (json-read-keyword "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-error
- (json-read-keyword "false") :type 'json-unknown-keyword))
+ (should (equal (should-error (json-read-keyword "false"))
+ '(json-unknown-keyword "true"))))
(json-tests--with-temp-buffer "foo"
- (should-error
- (json-read-keyword "foo") :type 'json-unknown-keyword)))
+ (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"))
- (should (equal (json-encode-keyword json-false) "false"))
- (should (equal (json-encode-keyword json-null) "null")))
+ (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-number ()
- (json-tests--with-temp-buffer "3"
- (should (= (json-read-number) 3)))
- (json-tests--with-temp-buffer "-5"
- (should (= (json-read-number) -5)))
- (json-tests--with-temp-buffer "123.456"
- (should (= (json-read-number) 123.456)))
- (json-tests--with-temp-buffer "1e3"
- (should (= (json-read-number) 1e3)))
- (json-tests--with-temp-buffer "2e+3"
- (should (= (json-read-number) 2e3)))
- (json-tests--with-temp-buffer "3E3"
- (should (= (json-read-number) 3e3)))
- (json-tests--with-temp-buffer "1e-7"
- (should (= (json-read-number) 1e-7)))
- (json-tests--with-temp-buffer "abc"
- (should-error (json-read-number) :type 'json-number-format)))
+(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")))
+ (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
+;;; Strings
(ert-deftest test-json-read-escaped-char ()
(json-tests--with-temp-buffer "\\\""
- (should (equal (json-read-escaped-char) ?\"))))
+ (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-error (json-read-string) :type 'json-string-format))
+ (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αβγ\""
;; 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-string-format)))
+ (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-error (json-encode-key 5) :type 'json-key-format)
- (should-error (json-encode-key ["foo"]) :type 'json-key-format)
- (should-error (json-encode-key '("foo")) :type 'json-key-format))
+ (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 (equal (json-new-object) '())))
+ (should-not (json-new-object)))
(let ((json-object-type 'plist))
- (should (equal (json-new-object) '())))
+ (should-not (json-new-object)))
(let* ((json-object-type 'hash-table)
(json-object (json-new-object)))
(should (hash-table-p json-object))
- (should (= (hash-table-count json-object) 0))))
+ (should (map-empty-p json-object))
+ (should (eq (hash-table-test json-object) #'equal))))
-(ert-deftest test-json-add-to-object ()
+(ert-deftest test-json-add-to-alist ()
(let* ((json-object-type 'alist)
- (json-key-type nil)
(obj (json-new-object)))
- (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 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)
- (json-key-type nil)
(obj (json-new-object)))
- (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 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)
- (json-key-type nil)
(obj (json-new-object)))
- (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 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 'hash-table)
(hash-table (json-read-object)))
(should (= (gethash "a" hash-table) 1))
- (should (= (gethash "b" hash-table) 2))))
+ (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-error (json-read-object) :type 'json-object-format)))
+ (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 ((hash-table (make-hash-table))
- (json-encoding-object-sort-predicate 'string<)
+ (let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (puthash :a 1 hash-table)
- (puthash :b 2 hash-table)
- (puthash :c 3 hash-table)
- (should (equal (json-encode hash-table)
- "{\"a\":1,\"b\":2,\"c\":3}"))))
-
-(ert-deftest json-encode-simple-alist ()
- (let ((json-encoding-pretty-print nil))
- (should (equal (json-encode '((a . 1) (b . 2)))
- "{\"a\":1,\"b\":2}"))))
-
-(ert-deftest test-json-encode-plist ()
- (let ((plist '(:a 1 :b 2))
+ (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))
- (should (equal (json-encode plist) "{\"a\":1,\"b\":2}"))))
-
-(ert-deftest test-json-encode-plist-with-sort-predicate ()
- (let ((plist '(:c 3 :a 1 :b 2))
- (json-encoding-object-sort-predicate 'string<)
+ (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 plist) "{\"a\":1,\"b\":2,\"c\":3}"))))
+ (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-alist-with-sort-predicate ()
- (let ((alist '((:c . 3) (:a . 1) (:b . 2)))
- (json-encoding-object-sort-predicate 'string<)
+(ert-deftest test-json-encode-plist ()
+ (let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}"))))
+ (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-pretty-print nil))
- (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 (equal (json-encode-list '(1 2 3 4)) "[1,2,3,4]"))))
+ (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-error (json-read-array) :type 'json-error)))
+ (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-pretty-print nil))
- (should (equal (json-encode-array [1 2 "a" "b"])
- "[1,2,\"a\",\"b\"]"))))
+ (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 ()
- (json-tests--with-temp-buffer "{ \"a\": 1 }"
- ;; We don't care exactly what the return value is (that is tested
- ;; in `test-json-read-object'), but it should parse without error.
- (should (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 "xxx"
- (let ((err (should-error (json-read) :type 'json-readtable-error)))
- (should (equal (cdr err) '(?x))))))
+ (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 ()
- (let ((json-string "{ \"a\": 1 }"))
- (json-tests--with-temp-buffer json-string
- (should (equal (json-read-from-string json-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))))))
-;;; JSON encoder
+;;; 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-error (json-encode (current-buffer)) :type 'json-error)))
+ (should (equal (should-error (json-encode (current-buffer)))
+ (list 'json-error (current-buffer))))))
-;;; Pretty-print
+;;; Pretty printing & minimizing
(defun json-tests-equal-pretty-print (original &optional expected)
"Abort current test if pretty-printing ORIGINAL does not yield EXPECTED.
(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
- "{}"
- "{\n}")
- ;; one pair
+ ;; 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
+ ;; Two pairs.
(json-tests-equal-pretty-print
"{\"key1\":1,\"key2\":2}"
"{\n \"key1\": 1,\n \"key2\": 2\n}")
- ;; embedded object
+ ;; Nested object.
(json-tests-equal-pretty-print
"{\"foo\":{\"key\":1}}"
"{\n \"foo\": {\n \"key\": 1\n }\n}")
- ;; embedded array
+ ;; 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
+ ;; Empty.
(json-tests-equal-pretty-print "[]")
- ;; one item
+ ;; One item.
(json-tests-equal-pretty-print
"[1]"
"[\n 1\n]")
- ;; two items
+ ;; Two items.
(json-tests-equal-pretty-print
"[1,2]"
"[\n 1,\n 2\n]")
- ;; embedded object
+ ;; Nested object.
(json-tests-equal-pretty-print
"[{\"key\":1}]"
"[\n {\n \"key\": 1\n }\n]")
- ;; embedded array
+ ;; Nested array.
(json-tests-equal-pretty-print
"[[1,2]]"
"[\n [\n 1,\n 2\n ]\n]"))
(provide 'json-tests)
+
;;; json-tests.el ends here
projects / emacs.git / commitdiff