From 3958c8757e9ee8c6be06c5b6dac371e38978501f Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 21 Feb 2021 20:10:08 +0000 Subject: [PATCH] Speed up json.el encoding This replaces most json-encode-* functions with similar json--print-* counterparts that insert into the current buffer instead of returning a string. Some unused but useful json-encode-* functions are kept for backward compatibility and as a public API, and the rest are deprecated. * etc/NEWS: Announce obsoletions. * lisp/json.el: Document organization of library. Make subsection headings more consistent. (json--encoding-current-indentation): Rename... (json--print-indentation-prefix): ...to this, to reflect new use. (json--encode-stringlike, json--encode-alist): Rename... (json--print-stringlike, json--print-alist): ...to these, respectively, and encode argument into current buffer instead. All callers changed. (json--print-string, json--print-unordered-map, json--print-array) (json--print): New functions. (json-encode-string, json-encode-plist, json-encode-array) (json-encode): Use them, respectively. (json-encode-number, json-encode-hash-table): Mark as obsolete aliases of json-encode. (json-encode-key, json-encode-list): Mark as obsolete in preference for json-encode. (json--print-indentation-depth, json--print-keyval-separator): New variables. (json--with-output-to-string): New macro. (json--print-indentation, json--print-keyword, json--print-key) (json--print-pair, json--print-map, json--print-list): New functions. (json--with-indentation): Use json--print-indentation-depth to avoid unnecessary string allocation. (json-encoding-default-indentation, json-pretty-print-max-secs): Clarify docstrings. (json--escape, json--long-string-threshold, json--string-buffer): Remove; no longer used. * lisp/progmodes/js.el (js--js-encode-value): Replace json-encode-string and json-encode-number with json-encode. (js-eval-defun): Use json--print-list to avoid json-encode-list->insert roundtrip. * test/lisp/json-tests.el (test-json-encode-number) (test-json-encode-hash-table, test-json-encode-hash-table-pretty) (test-json-encode-hash-table-lisp-style) (test-json-encode-hash-table-sort, test-json-encode-list): Replace uses of obsolete functions with the equivalent use of json-encode. (test-json-encode-key): Suppress obsoletion warnings. --- etc/NEWS | 10 ++ lisp/json.el | 368 +++++++++++++++++++++------------------- lisp/progmodes/js.el | 6 +- test/lisp/json-tests.el | 184 ++++++++++---------- 4 files changed, 296 insertions(+), 272 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 52c32768af..1fd0873f4e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1529,6 +1529,16 @@ 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. +--- +*** Some JSON encoding functions are now obsolete. +The functions 'json-encode-number', 'json-encode-hash-table', +'json-encode-key', and 'json-encode-list' are now obsolete. + +The first two are kept as aliases of 'json-encode', which should be +used instead. Uses of 'json-encode-list' should be changed to call +one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or +'json-encode-array' instead. + ** xml.el *** XML serialization functions now reject invalid characters. diff --git a/lisp/json.el b/lisp/json.el index f20123fcfb..eb655162d3 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -40,6 +40,17 @@ ;; Similarly, since `false' and `null' are distinct in JSON, you can ;; distinguish them by binding `json-false' and `json-null' as desired. +;;; Organization: + +;; Historically json.el used the prefix `json-read-' for decoding and +;; the prefix `json-encode-' for encoding. Many of these definitions +;; are used by external packages since few were marked as internal. +;; Optimizing the encoder to manipulate a buffer rather than strings +;; while minimizing code duplication therefore necessitated a new +;; namespace `json--print-'. This rendered many encoding functions +;; obsolete and unused, but those considered externally useful are +;; kept for backward compatibility and as a public API. + ;;; History: ;; 2006-03-11 - Initial version. @@ -57,7 +68,7 @@ (require 'map) (require 'subr-x) -;; Parameters +;;;; Parameters (defvar json-object-type 'alist "Type to convert JSON objects to. @@ -102,13 +113,22 @@ json-encoding-separator "Value to use as an element separator when encoding.") (defvar json-encoding-default-indentation " " - "The default indentation level for encoding. + "String used for a single indentation level during encoding. +This value is repeated for each further nested element. Used only when `json-encoding-pretty-print' is non-nil.") -(defvar json--encoding-current-indentation "\n" - "Internally used to keep track of the current indentation level of encoding. +(defvar json--print-indentation-prefix "\n" + "String used to start indentation during encoding. Used only when `json-encoding-pretty-print' is non-nil.") +(defvar json--print-indentation-depth 0 + "Current indentation level during encoding. +Dictates repetitions of `json-encoding-default-indentation'. +Used only when `json-encoding-pretty-print' is non-nil.") + +(defvar json--print-keyval-separator ":" + "String used to separate key-value pairs during encoding.") + (defvar json-encoding-pretty-print nil "If non-nil, then the output of `json-encode' will be pretty-printed.") @@ -137,7 +157,7 @@ json-post-element-read-function -;;; Utilities +;;;; Utilities (define-obsolete-function-alias 'json-join #'string-join "28.1") @@ -169,18 +189,38 @@ json--plist-nreverse (setcdr (cdr plist) prev))) plist) +;; Encoder utilities + +(defmacro json--with-output-to-string (&rest body) + "Eval BODY in a temporary buffer bound to `standard-output'. +Return the resulting buffer contents as a string." + (declare (indent 0) (debug t)) + `(with-output-to-string + (with-current-buffer standard-output + ;; This affords decent performance gains. + (setq-local inhibit-modification-hooks t) + ,@body))) + (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." + "Eval BODY with the JSON encoding nesting incremented by one step. +This macro sets up appropriate variable bindings for +`json--print-indentation' to produce the correct indentation when +`json-encoding-pretty-print' is non-nil." (declare (debug t) (indent 0)) - `(let ((json--encoding-current-indentation - (if json-encoding-pretty-print - (concat json--encoding-current-indentation - json-encoding-default-indentation) - ""))) + `(let ((json--print-indentation-prefix + (if json-encoding-pretty-print json--print-indentation-prefix "")) + (json--print-keyval-separator (if json-encoding-pretty-print ": " ":")) + (json--print-indentation-depth (1+ json--print-indentation-depth))) ,@body)) +(defun json--print-indentation () + "Insert the current indentation for JSON encoding at point. +Has no effect if `json-encoding-pretty-print' is nil." + (when json-encoding-pretty-print + (insert json--print-indentation-prefix) + (dotimes (_ json--print-indentation-depth) + (insert json-encoding-default-indentation)))) + ;; Reader utilities (define-inline json-advance (&optional n) @@ -210,8 +250,6 @@ json-skip-whitespace ;; definition of whitespace in JSON. (inline-quote (skip-chars-forward "\t\n\r "))) - - ;; Error conditions (define-error 'json-error "Unknown JSON error") @@ -228,7 +266,7 @@ 'json-end-of-file -;;; Paths +;;;; Paths (defvar json--path '() "Keeps track of the path during recursive calls to `json-read'. @@ -283,7 +321,9 @@ json-path-to-position (when (plist-get path :path) path)))) -;;; Keywords + + +;;;; Keywords (defconst json-keywords '("true" "false" "null") "List of JSON keywords.") @@ -316,7 +356,13 @@ json-encode-keyword ((eq keyword json-false) "false") ((eq keyword json-null) "null"))) -;;; Numbers +(defun json--print-keyword (keyword) + "Insert KEYWORD as a JSON value at point. +Return nil if KEYWORD is not recognized as a JSON keyword." + (prog1 (setq keyword (json-encode-keyword keyword)) + (and keyword (insert keyword)))) + +;;;; Numbers ;; Number parsing @@ -339,10 +385,9 @@ json-read-number ;; Number encoding -(defalias 'json-encode-number #'number-to-string - "Return a JSON representation of NUMBER.") +(define-obsolete-function-alias 'json-encode-number #'json-encode "28.1") -;;; Strings +;;;; Strings (defconst json-special-chars '((?\" . ?\") @@ -410,65 +455,52 @@ json-read-string ;; 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--print-string (string &optional from) + "Insert a JSON representation of STRING at point. +FROM is the index of STRING to start from and defaults to 0." + (goto-char (prog1 (1+ (point)) + ;; Strip `read-only' property (bug#43549). + (insert ?\" (substring-no-properties string from)))) + ;; Escape only quotation mark, backslash, and the control + ;; characters U+0000 to U+001F (RFC 4627, ECMA-404). + (while (re-search-forward (rx (in ?\" ?\\ cntrl)) 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 ?\") + string) (defun json-encode-string (string) "Return a JSON representation of STRING." - ;; 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 "\"" (substring-no-properties string) "\"") - (with-current-buffer - (or json--string-buffer - (with-current-buffer (generate-new-buffer " *json-string*" t) - ;; This seems to afford decent performance gains. - (setq-local inhibit-modification-hooks t) - (setq json--string-buffer (current-buffer)))) - ;; Strip `read-only' property (bug#43549). - (insert ?\" (substring-no-properties 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))))) + (json--with-output-to-string (json--print-string string))) -(defun json--encode-stringlike (object) - "Return OBJECT encoded as a JSON string, or nil if not possible." - (cond ((stringp object) (json-encode-string object)) - ((keywordp object) (json-encode-string - (substring (symbol-name object) 1))) - ((symbolp object) (json-encode-string (symbol-name object))))) +(defun json--print-stringlike (object) + "Insert OBJECT encoded as a JSON string at point. +Return nil if OBJECT cannot be encoded as a JSON string." + (cond ((stringp object) (json--print-string object)) + ((keywordp object) (json--print-string (symbol-name object) 1)) + ((symbolp object) (json--print-string (symbol-name object))))) + +(defun json--print-key (object) + "Insert a JSON key representation of OBJECT at point. +Signal `json-key-format' if it cannot be encoded as a string." + (or (json--print-stringlike object) + (signal 'json-key-format (list object)))) (defun json-encode-key (object) "Return a JSON representation of OBJECT. If the resulting JSON object isn't a valid JSON object key, this signals `json-key-format'." - ;; Encoding must be a JSON string. - (or (json--encode-stringlike object) - (signal 'json-key-format (list object)))) + (declare (obsolete json-encode "28.1")) + (json--with-output-to-string (json--print-key object))) -;;; Objects +;;;; Objects + +;; JSON object parsing (defun json-new-object () "Create a new Elisp object corresponding to an empty JSON object. @@ -501,8 +533,6 @@ json-add-to-object ((eq json-object-type 'plist) (cons key (cons value object)))))) -;; JSON object parsing - (defun json-read-object () "Read the JSON object at point." ;; Skip over the '{'. @@ -537,95 +567,81 @@ json-read-object ('plist (json--plist-nreverse elements)) (_ elements)))) +;; JSON object encoding + +(defun json--print-pair (key val) + "Insert JSON representation of KEY-VAL pair at point. +This always inserts a trailing `json-encoding-separator'." + (json--print-indentation) + (json--print-key key) + (insert json--print-keyval-separator) + (json--print val) + (insert json-encoding-separator)) + +(defun json--print-map (map) + "Insert JSON object representation of MAP at point. +This works for any MAP satisfying `mapp'." + (insert ?\{) + (unless (map-empty-p map) + (json--with-indentation + (map-do #'json--print-pair map) + (delete-char (- (length json-encoding-separator)))) + (or json-encoding-lisp-style-closings + (json--print-indentation))) + (insert ?\})) + +(defun json--print-unordered-map (map) + "Like `json--print-map', but optionally sort MAP first. +If `json-encoding-object-sort-predicate' is non-nil, this first +transforms an unsortable MAP into a sortable alist." + (if (and json-encoding-object-sort-predicate + (not (map-empty-p map))) + (json--print-alist (map-pairs map) t) + (json--print-map map))) + ;; Hash table encoding -(defun json-encode-hash-table (hash-table) - "Return a JSON representation of HASH-TABLE." - (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) - "}"))))) +(define-obsolete-function-alias 'json-encode-hash-table #'json-encode "28.1") ;; List encoding (including alists and plists) -(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 (if destructive alist (copy-sequence alist)) - (lambda (a b) - (funcall json-encoding-object-sort-predicate - (car a) (car b)))))) - (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--print-alist (alist &optional destructive) + "Insert a JSON representation of ALIST at point. +Sort ALIST first if `json-encoding-object-sort-predicate' is +non-nil. Sorting can optionally be DESTRUCTIVE for speed." + (json--print-map (if (and json-encoding-object-sort-predicate alist) + (sort (if destructive alist (copy-sequence alist)) + (lambda (a b) + (funcall json-encoding-object-sort-predicate + (car a) (car b)))) + alist))) + +;; The following two are unused but useful to keep around due to the +;; inherent ambiguity of lists. (defun json-encode-alist (alist) "Return a JSON representation of ALIST." - (if alist (json--encode-alist alist) "{}")) + (json--with-output-to-string (json--print-alist alist))) (defun json-encode-plist (plist) "Return a JSON representation of 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) - (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) - "}"))))) + (json--with-output-to-string (json--print-unordered-map plist))) + +(defun json--print-list (list) + "Like `json-encode-list', but insert the JSON at point." + (cond ((json-alist-p list) (json--print-alist list)) + ((json-plist-p list) (json--print-unordered-map list)) + ((listp list) (json--print-array list)) + ((signal 'json-error (list list))))) (defun json-encode-list (list) "Return a JSON representation of LIST. -Tries to DWIM: simple lists become JSON arrays, while alists and plists -become JSON objects." - (cond ((json-alist-p list) (json-encode-alist list)) - ((json-plist-p list) (json-encode-plist list)) - ((listp list) (json-encode-array list)) - (t - (signal 'json-error (list list))))) +Tries to DWIM: alists and plists become JSON objects, while +simple lists become JSON arrays." + (declare (obsolete json-encode "28.1")) + (json--with-output-to-string (json--print-list list))) -;;; Arrays +;;;; Arrays ;; Array parsing @@ -658,28 +674,32 @@ json-read-array ;; Array encoding +(defun json--print-array (array) + "Like `json-encode-array', but insert the JSON at point." + (insert ?\[) + (unless (length= array 0) + (json--with-indentation + (json--print-indentation) + (let ((first t)) + (mapc (lambda (elt) + (if first + (setq first nil) + (insert json-encoding-separator) + (json--print-indentation)) + (json--print elt)) + array))) + (or json-encoding-lisp-style-closings + (json--print-indentation))) + (insert ?\])) + (defun json-encode-array (array) "Return a JSON representation of ARRAY. ARRAY can also be a list." - (if (and json-encoding-pretty-print - (not (length= array 0))) - (concat - "[" - (json--with-indentation - (concat json--encoding-current-indentation - (mapconcat #'json-encode array - (concat json-encoding-separator - json--encoding-current-indentation)))) - (unless json-encoding-lisp-style-closings - json--encoding-current-indentation) - "]") - (concat "[" - (mapconcat #'json-encode array json-encoding-separator) - "]"))) + (json--with-output-to-string (json--print-array array))) -;;; Reader +;;;; Reader (defmacro json-readtable-dispatch (char) "Dispatch reader function for CHAR at point. @@ -735,7 +755,17 @@ json-read-file -;;; Encoder +;;;; Encoder + +(defun json--print (object) + "Like `json-encode', but insert or print the JSON at point." + (cond ((json--print-keyword object)) + ((listp object) (json--print-list object)) + ((json--print-stringlike object)) + ((numberp object) (prin1 object)) + ((arrayp object) (json--print-array object)) + ((hash-table-p object) (json--print-unordered-map object)) + ((signal 'json-error (list object))))) (defun json-encode (object) "Return a JSON representation of OBJECT as a string. @@ -743,15 +773,9 @@ json-encode 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 ((json-encode-keyword object)) - ((listp object) (json-encode-list object)) - ((json--encode-stringlike 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))))) + (json--with-output-to-string (json--print object))) -;;; Pretty printing & minimizing +;;;; Pretty printing & minimizing (defun json-pretty-print-buffer (&optional minimize) "Pretty-print current buffer. @@ -762,7 +786,7 @@ json-pretty-print-buffer (defvar json-pretty-print-max-secs 2.0 "Maximum time for `json-pretty-print's comparison. The function `json-pretty-print' uses `replace-region-contents' -(which see) passing the value of this variable as argument +\(which see) passing the value of this variable as argument MAX-SECS.") (defun json-pretty-print (begin end &optional minimize) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 21bda08680..059122df4f 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3699,8 +3699,7 @@ js--js-encode-value Strings and numbers are JSON-encoded. Lists (including nil) are made into JavaScript array literals and their contents encoded with `js--js-encode-value'." - (cond ((stringp x) (json-encode-string x)) - ((numberp x) (json-encode-number x)) + (cond ((or (stringp x) (numberp x)) (json-encode x)) ((symbolp x) (format "{objid:%S}" (symbol-name x))) ((js--js-handle-p x) @@ -4390,7 +4389,8 @@ js-eval-defun (with-temp-buffer (insert js--js-inserter) (insert "(") - (insert (json-encode-list defun-info)) + (let ((standard-output (current-buffer))) + (json--print-list defun-info)) (insert ",\n") (insert defun-body) (insert "\n)") diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index 9886dc0d45..c2392e1683 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -329,13 +329,13 @@ test-json-read-number-invalid (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 0) "0")) + (should (equal (json-encode -0) "0")) + (should (equal (json-encode 3) "3")) + (should (equal (json-encode -5) "-5")) + (should (equal (json-encode 123.456) "123.456")) (let ((bignum (1+ most-positive-fixnum))) - (should (equal (json-encode-number bignum) + (should (equal (json-encode bignum) (number-to-string bignum))))) ;;; Strings @@ -421,27 +421,28 @@ test-json-encode-string "\"\\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 'a) "\"a\"")) - (should (equal (json-encode-key :a) "\"a\"")) - (should (equal (json-encode-key "a") "\"a\"")) - (should (equal (json-encode-key t) "\"t\"")) - (should (equal (json-encode-key :t) "\"t\"")) - (should (equal (json-encode-key "t") "\"t\"")) - (should (equal (json-encode-key nil) "\"nil\"")) - (should (equal (json-encode-key :nil) "\"nil\"")) - (should (equal (json-encode-key "nil") "\"nil\"")) - (should (equal (json-encode-key ":a") "\":a\"")) - (should (equal (json-encode-key ":t") "\":t\"")) - (should (equal (json-encode-key ":nil") "\":nil\"")) - (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"))))) + (with-suppressed-warnings ((obsolete json-encode-key)) + (should (equal (json-encode-key '##) "\"\"")) + (should (equal (json-encode-key :) "\"\"")) + (should (equal (json-encode-key "") "\"\"")) + (should (equal (json-encode-key 'a) "\"a\"")) + (should (equal (json-encode-key :a) "\"a\"")) + (should (equal (json-encode-key "a") "\"a\"")) + (should (equal (json-encode-key t) "\"t\"")) + (should (equal (json-encode-key :t) "\"t\"")) + (should (equal (json-encode-key "t") "\"t\"")) + (should (equal (json-encode-key nil) "\"nil\"")) + (should (equal (json-encode-key :nil) "\"nil\"")) + (should (equal (json-encode-key "nil") "\"nil\"")) + (should (equal (json-encode-key ":a") "\":a\"")) + (should (equal (json-encode-key ":t") "\":t\"")) + (should (equal (json-encode-key ":nil") "\":nil\"")) + (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 @@ -578,45 +579,32 @@ test-json-read-object-function (ert-deftest test-json-encode-hash-table () (let ((json-encoding-object-sort-predicate nil) (json-encoding-pretty-print nil)) - (should (equal (json-encode-hash-table #s(hash-table)) "{}")) - (should (equal (json-encode-hash-table #s(hash-table data (a 1))) + (should (equal (json-encode #s(hash-table)) "{}")) + (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}")) + (should (equal (json-encode #s(hash-table data (t 1))) "{\"t\":1}")) + (should (equal (json-encode #s(hash-table data (nil 1))) "{\"nil\":1}")) + (should (equal (json-encode #s(hash-table data (:a 1))) "{\"a\":1}")) + (should (equal (json-encode #s(hash-table data (:t 1))) "{\"t\":1}")) + (should (equal (json-encode #s(hash-table data (:nil 1))) "{\"nil\":1}")) + (should (equal (json-encode #s(hash-table test equal data ("a" 1))) "{\"a\":1}")) - (should (equal (json-encode-hash-table #s(hash-table data (t 1))) + (should (equal (json-encode #s(hash-table test equal data ("t" 1))) "{\"t\":1}")) - (should (equal (json-encode-hash-table #s(hash-table data (nil 1))) + (should (equal (json-encode #s(hash-table test equal data ("nil" 1))) "{\"nil\":1}")) - (should (equal (json-encode-hash-table #s(hash-table data (:a 1))) - "{\"a\":1}")) - (should (equal (json-encode-hash-table #s(hash-table data (:t 1))) - "{\"t\":1}")) - (should (equal (json-encode-hash-table #s(hash-table data (:nil 1))) - "{\"nil\":1}")) - (should (equal (json-encode-hash-table - #s(hash-table test equal data ("a" 1))) - "{\"a\":1}")) - (should (equal (json-encode-hash-table - #s(hash-table test equal data ("t" 1))) - "{\"t\":1}")) - (should (equal (json-encode-hash-table - #s(hash-table test equal data ("nil" 1))) - "{\"nil\":1}")) - (should (equal (json-encode-hash-table - #s(hash-table test equal data (":a" 1))) + (should (equal (json-encode #s(hash-table test equal data (":a" 1))) "{\":a\":1}")) - (should (equal (json-encode-hash-table - #s(hash-table test equal data (":t" 1))) + (should (equal (json-encode #s(hash-table test equal data (":t" 1))) "{\":t\":1}")) - (should (equal (json-encode-hash-table - #s(hash-table test equal data (":nil" 1))) + (should (equal (json-encode #s(hash-table test equal data (":nil" 1))) "{\":nil\":1}")) - (should (member (json-encode-hash-table #s(hash-table data (t 2 :nil 1))) + (should (member (json-encode #s(hash-table data (t 2 :nil 1))) '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}"))) - (should (member (json-encode-hash-table - #s(hash-table test equal data (:t 2 ":t" 1))) + (should (member (json-encode #s(hash-table test equal data (:t 2 ":t" 1))) '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}"))) - (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) + (should (member (json-encode #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))) + (should (member (json-encode #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}" @@ -629,13 +617,12 @@ test-json-encode-hash-table-pretty (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))) + (should (equal (json-encode #s(hash-table)) "{}")) + (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1\n}")) + (should (member (json-encode #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))) + (should (member (json-encode #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}" @@ -648,13 +635,12 @@ test-json-encode-hash-table-lisp-style (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))) + (should (equal (json-encode #s(hash-table)) "{}")) + (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1}")) + (should (member (json-encode #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))) + (should (member (json-encode #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}" @@ -672,7 +658,7 @@ test-json-encode-hash-table-sort (#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)) + (should (equal (json-encode in) out)) ;; Ensure sorting isn't destructive. (should (seq-set-equal-p (map-pairs in) copy)))))) @@ -785,38 +771,42 @@ test-json-encode-plist-sort (should (equal in copy)))))) (ert-deftest test-json-encode-list () + "Test `json-encode-list' or its more moral equivalents." (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))) + ;; Trick `json-encode' into using `json--print-list'. + (let ((json-null (list nil))) + (should (equal (json-encode ()) "{}"))) + (should (equal (json-encode '(a)) "[\"a\"]")) + (should (equal (json-encode '(:a)) "[\"a\"]")) + (should (equal (json-encode '("a")) "[\"a\"]")) + (should (equal (json-encode '(a 1)) "[\"a\",1]")) + (should (equal (json-encode '("a" 1)) "[\"a\",1]")) + (should (equal (json-encode '(:a 1)) "{\"a\":1}")) + (should (equal (json-encode '((a . 1))) "{\"a\":1}")) + (should (equal (json-encode '((:a . 1))) "{\"a\":1}")) + (should (equal (json-encode '(:b 2 :a)) "[\"b\",2,\"a\"]")) + (should (equal (json-encode '(4 3 2 1)) "[4,3,2,1]")) + (should (equal (json-encode '(b 2 a 1)) "[\"b\",2,\"a\",1]")) + (should (equal (json-encode '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) + (should (equal (json-encode '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) + (should (equal (json-encode '((: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]))))) + (should (equal (json-encode '((a) 1)) "[[\"a\"],1]")) + (should (equal (json-encode '((:a) 1)) "[[\"a\"],1]")) + (should (equal (json-encode '(("a") 1)) "[[\"a\"],1]")) + (should (equal (json-encode '((a 1) 2)) "[[\"a\",1],2]")) + (should (equal (json-encode '((:a 1) 2)) "[{\"a\":1},2]")) + (should (equal (json-encode '(((a . 1)) 2)) "[{\"a\":1},2]")) + (should (equal (json-encode '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}")) + (should (equal (json-encode '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}")) + (should-error (json-encode '(a . 1)) :type 'wrong-type-argument) + (should-error (json-encode '((a . 1) 2)) :type 'wrong-type-argument) + (with-suppressed-warnings ((obsolete json-encode-list)) + (should (equal (should-error (json-encode-list [])) + '(json-error []))) + (should (equal (should-error (json-encode-list [a])) + '(json-error [a])))))) ;;; Arrays -- 2.30.0