[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3f082af: Various json.el improvements
|
From: |
Basil L. Contovounesios |
|
Subject: |
master 3f082af: Various json.el improvements |
|
Date: |
Fri, 22 May 2020 10:53:51 -0400 (EDT) |
branch: master
commit 3f082af536c33ba713561e7ad4b691aaad488701
Author: Basil L. Contovounesios <address@hidden>
Commit: Basil L. Contovounesios <address@hidden>
Various json.el improvements
* etc/NEWS: Announce that json-read-number is now stricter.
* json.el: Bump package version.
(json-encoding-lisp-style-closings, json-pre-element-read-function)
(json-post-element-read-function, json-advance, json-peek)
(json--path): Clarify and improve style of doc strings.
(json-join): Define as an obsolete alias of string-join.
(json-alist-p, json-plist-p): Refactor for speed and declare as
pure, side-effect-free, and error-free.
(json--plist-reverse): Rename function...
(json--plist-nreverse): ...to this, making it destructive for speed.
All callers changed.
(json--plist-to-alist): Remove, replacing single use with map-pairs.
(json--with-indentation): Accept multiple forms as arguments, fix
their indentation, and allow them to be instrumented for debugging.
Add docstring.
(json-pop, json-read-keyword, json-add-to-object)
(json-encode-array): Simplify for speed.
(json-skip-whitespace): Put newline before carriage return for
likely frequency of occurrence, and so that the characters appear in
increasing order.
(json--check-position): Use 1+.
(json-path-to-position): Open code apply-partially.
(json-keywords): Turn into a defconst and mark as obsolete now that
it is no longer used.
(json--post-value, json--number, json--escape): New rx definitions.
(json-encode-keyword): Declare as side-effect-free.
(json-read-number): Reject leading zeros and plus signs, and make
integer part mandatory in accordance with JSON standards and for
consistency with native JSON parsing functions. Eagerly signal
json-number-format when garbage follows a valid number, e.g., when
reading "1.1.1", instead of leaving that up to the caller. Remove
optional internal argument from advertised calling convention now
that the function is no longer recursive.
(json-encode-number): Define as an alias of number-to-string.
(json-special-chars): Turn into a defconst.
(json-read-escaped-char, json-new-object, json-read-file)
(json-pretty-print): Simplify.
(json-read-string): For consistency with other json.el error
reporting, remove check for leading '"', and use the integer value
rather than the printed representation of characters in error data.
At EOB signal json-end-of-file instead of json-string-format.
(json--long-string-threshold, json--string-buffer): New variables.
(json-encode-string): Reimplement in terms of buffer manipulation
for speed (bug#20154).
(json-read-object): Escape ?\} properly.
(json--encode-alist): New function extracted from json-encode-alist.
(json-encode-hash-table, json-encode-alist, json-encode-plist): Use
it to avoid destructively modifying the argument when
json-encoding-object-sort-predicate is non-nil without incurring
unnecessary copying (bug#40693). Encode empty object as "{}" even
when pretty-printing. Simplify for speed.
(json-read-array): Avoid recomputing list length on each iteration
when json-pre-element-read-function is non-nil. Make first element
of json-array-format error data a string for consistency with
json-object-format and to make the displayed error message clearer.
(json-readtable-dispatch): Accept any kind of argument, not just
symbols. Generate the table in a simpler manner so the dispatch
order is clearer. Remove dispatch on ?+ and ?. now that
json-read-number is stricter and for consistency with native JSON
parsing functions. Signal json-end-of-file if argument is nil.
(json-read): Simplify accordingly.
(json-encode): Avoid allocating a list on each invocation.
* lisp/jsonrpc.el (jsonrpc--json-read, jsonrpc--json-encode): Check
whether native JSON functions are fboundp only once, at load time.
* lisp/progmodes/python.el (python--parse-json-array): New function.
(python-shell-prompt-detect): Use it to parse JSON directly as a
list rather than converting from a vector.
* test/lisp/json-tests.el (json-tests--with-temp-buffer): Allow
instrumenting for debugging.
(test-json-join, test-json-plist-to-alist): Remove tests.
(test-json-alist-p, test-json-plist-p, test-json-advance)
(test-json-peek, test-json-pop, test-json-skip-whitespace)
(test-json-read-keyword, test-json-encode-keyword)
(test-json-encode-number, test-json-read-escaped-char)
(test-json-read-string, test-json-encode-string)
(test-json-encode-key, test-json-new-object)
(test-json-encode-hash-table, test-json-encode-plist)
(test-json-encode-list, test-json-read-array)
(test-json-encode-array, test-json-read)
(test-json-read-from-string, test-json-encode): Extend tests.
(test-json-plist-reverse): Rename test...
(test-json-plist-nreverse): ...to this and avoid modifying literal
lists.
(test-json-read-number): Rename test...
(test-json-read-integer): ...to this, focusing on integers.
(test-json-add-to-object): Rename test...
(test-json-add-to-alist): ...to this, focusing on alists.
(json-encode-simple-alist): Rename test...
(test-json-encode-alist): ...to this, extending it.
(test-json-encode-alist-with-sort-predicate): Rename test...
(test-json-encode-alist-sort): ...to this, extending it.
(test-json-encode-plist-with-sort-predicate): Rename test...
(test-json-encode-plist-sort): ...to this, extending it.
(test-json-read-keyword-invalid, test-json-read-fraction)
(test-json-read-exponent, test-json-read-fraction-exponent)
(test-json-read-number-invalid)
(test-json-read-escaped-char-invalid, test-json-add-to-plist)
(test-json-add-to-hash-table, test-json-read-object-empty)
(test-json-read-object-invalid, test-json-read-object-function)
(test-json-encode-hash-table-pretty)
(test-json-encode-hash-table-lisp-style)
(test-json-encode-hash-table-sort, test-json-encode-alist-pretty)
(test-json-encode-alist-lisp-style, test-json-encode-plist-pretty)
(test-json-encode-plist-lisp-style, test-json-read-array-function)
(test-json-encode-array-pretty, test-json-encode-array-lisp-style)
(test-json-read-invalid): New tests.
(test-json-path-to-position-no-match): Use should-not.
(test-json-read-object): Move error check to new test
test-json-read-object-invalid.
(test-json-pretty-print-object): Adapt test now that empty objects
are pretty-printed as "{}".
---
etc/NEWS | 9 +
lisp/json.el | 576 ++++++++++++++++---------------
lisp/jsonrpc.el | 50 +--
lisp/progmodes/python.el | 21 +-
test/lisp/json-tests.el | 865 +++++++++++++++++++++++++++++++++++++++--------
5 files changed, 1063 insertions(+), 458 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index 1bf1403..4533dc4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -360,6 +360,15 @@ either an internal or external browser.
*** New user option 'project-vc-merge-submodules'.
+** json.el
+
+---
+*** JSON number parsing is now stricter.
+Numbers with a leading plus sign, leading zeros, or a missing integer
+component are now rejected by 'json-read' and friends. This makes
+them more compliant with the JSON specification and consistent with
+the native JSON parsing functions.
+
* New Modes and Packages in Emacs 28.1
diff --git a/lisp/json.el b/lisp/json.el
index 6f3b791..9002e86 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Theresa O'Connor <address@hidden>
-;; Version: 1.4
+;; Version: 1.5
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -29,11 +29,11 @@
;; 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').
@@ -55,6 +55,7 @@
;;; Code:
(require 'map)
+(require 'seq)
(require 'subr-x)
;; Parameters
@@ -113,8 +114,10 @@ Used only when `json-encoding-pretty-print' is non-nil.")
"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.
@@ -124,88 +127,81 @@ instance, setting this to `string<' will have JSON object
keys
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.")
;;; 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."
@@ -213,7 +209,7 @@ Unlike `reverse', this keeps the property-value pairs
intact."
;; 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 ")))
@@ -236,8 +232,8 @@ Unlike `reverse', this keeps the property-value pairs
intact."
;;; 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.
@@ -248,7 +244,7 @@ Used internally by `json-path-to-position'."
"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)))))
@@ -266,13 +262,13 @@ properties:
: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
@@ -280,7 +276,7 @@ element in a deeply nested structure."
(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)
@@ -290,38 +286,33 @@ element in a deeply nested structure."
;;; 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")))
@@ -330,37 +321,31 @@ KEYWORD is the keyword expected."
;; 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)
@@ -368,7 +353,7 @@ representation will be parsed correctly."
(?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
@@ -378,48 +363,47 @@ representation will be parsed correctly."
(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))
@@ -427,29 +411,47 @@ representation will be parsed correctly."
;; 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.
@@ -460,15 +462,13 @@ this signals `json-key-format'."
(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.
@@ -476,10 +476,10 @@ Returns the updated object, which you should save, e.g.:
(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)
@@ -499,13 +499,13 @@ Please see the documentation of `json-object-type' and
`json-key-type'."
(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)
@@ -520,94 +520,94 @@ Please see the documentation of `json-object-type' and
`json-key-type'."
(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.
@@ -625,15 +625,17 @@ become JSON objects."
(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))
@@ -641,8 +643,8 @@ become JSON objects."
(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)))
@@ -653,42 +655,43 @@ become JSON objects."
(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)
"]")))
-;;; 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.
@@ -706,10 +709,7 @@ you will get the following structure returned:
((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
@@ -724,12 +724,11 @@ you will get the following structure returned:
"Read the first JSON object contained in FILE and return it."
(with-temp-buffer
(insert-file-contents file)
- (goto-char (point-min))
(json-read)))
-;;; JSON encoder
+;;; Encoder
(defun json-encode (object)
"Return a JSON representation of OBJECT as a string.
@@ -737,20 +736,21 @@ you will get the following structure returned:
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.
@@ -769,9 +769,9 @@ MAX-SECS.")
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)
@@ -800,9 +800,7 @@ With prefix argument MINIMIZE, minimize it instead."
;; 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)
@@ -832,14 +830,14 @@ With prefix argument MINIMIZE, minimize it instead."
"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)
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 293dfaa..42e7701 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -37,7 +37,6 @@
;;; Code:
(require 'cl-lib)
-(require 'json)
(require 'eieio)
(eval-when-compile (require 'subr-x))
(require 'warnings)
@@ -470,26 +469,35 @@ With optional CLEANUP, kill any associated buffers."
;;;
(define-error 'jsonrpc-error "jsonrpc-error")
-(defun jsonrpc--json-read ()
- "Read JSON object in buffer, move point to end of buffer."
- ;; TODO: I guess we can make these macros if/when jsonrpc.el
- ;; goes into Emacs core.
- (cond ((fboundp 'json-parse-buffer) (json-parse-buffer
- :object-type 'plist
- :null-object nil
- :false-object :json-false))
- (t (let ((json-object-type 'plist))
- (json-read)))))
-
-(defun jsonrpc--json-encode (object)
- "Encode OBJECT into a JSON string."
- (cond ((fboundp 'json-serialize) (json-serialize
- object
- :false-object :json-false
- :null-object nil))
- (t (let ((json-false :json-false)
- (json-null nil))
- (json-encode object)))))
+(defalias 'jsonrpc--json-read
+ (if (fboundp 'json-parse-buffer)
+ (lambda ()
+ (json-parse-buffer :object-type 'plist
+ :null-object nil
+ :false-object :json-false))
+ (require 'json)
+ (defvar json-object-type)
+ (declare-function json-read "json" ())
+ (lambda ()
+ (let ((json-object-type 'plist))
+ (json-read))))
+ "Read JSON object in buffer, move point to end of buffer.")
+
+(defalias 'jsonrpc--json-encode
+ (if (fboundp 'json-serialize)
+ (lambda (object)
+ (json-serialize object
+ :false-object :json-false
+ :null-object nil))
+ (require 'json)
+ (defvar json-false)
+ (defvar json-null)
+ (declare-function json-encode "json" (object))
+ (lambda (object)
+ (let ((json-false :json-false)
+ (json-null nil))
+ (json-encode object))))
+ "Encode OBJECT into a JSON string.")
(cl-defun jsonrpc--reply
(connection id &key (result nil result-supplied-p) (error nil
error-supplied-p))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 67383b3..1ca9f01 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -261,7 +261,6 @@
(require 'ansi-color)
(require 'cl-lib)
(require 'comint)
-(require 'json)
(require 'tramp-sh)
;; Avoid compiler warnings
@@ -2276,6 +2275,18 @@ Do not set this variable directly, instead use
Do not set this variable directly, instead use
`python-shell-prompt-set-calculated-regexps'.")
+(defalias 'python--parse-json-array
+ (if (fboundp 'json-parse-string)
+ (lambda (string)
+ (json-parse-string string :array-type 'list))
+ (require 'json)
+ (defvar json-array-type)
+ (declare-function json-read-from-string "json" (string))
+ (lambda (string)
+ (let ((json-array-type 'list))
+ (json-read-from-string string))))
+ "Parse the JSON array in STRING into a Lisp list.")
+
(defun python-shell-prompt-detect ()
"Detect prompts for the current `python-shell-interpreter'.
When prompts can be retrieved successfully from the
@@ -2324,11 +2335,11 @@ detection and just returns nil."
(catch 'prompts
(dolist (line (split-string output "\n" t))
(let ((res
- ;; Check if current line is a valid JSON array
- (and (string= (substring line 0 2) "[\"")
+ ;; Check if current line is a valid JSON array.
+ (and (string-prefix-p "[\"" line)
(ignore-errors
- ;; Return prompts as a list, not vector
- (append (json-read-from-string line) nil)))))
+ ;; Return prompts as a list.
+ (python--parse-json-array line)))))
;; The list must contain 3 strings, where the first
;; is the input prompt, the second is the block
;; prompt and the last one is the output prompt. The
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index ac9706a..a0e8c87 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -21,11 +21,16 @@
(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))
@@ -33,66 +38,107 @@ Point is moved to beginning of the buffer."
;;; 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
@@ -113,59 +159,243 @@ Point is moved to beginning of the buffer."
(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αβγ\""
@@ -175,57 +405,117 @@ Point is moved to beginning of the buffer."
;; 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 }"
@@ -238,94 +528,384 @@ Point is moved to beginning of the buffer."
(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.
@@ -351,46 +931,45 @@ nil, ORIGINAL should stay unchanged by pretty-printing."
(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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 3f082af: Various json.el improvements,
Basil L. Contovounesios <=