From 908f251e19dc64c75000f87bc6db4e9a8852d1ad Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 11 Feb 2021 12:00:05 +0000 Subject: Fix json.el encoding of confusable object keys * lisp/json.el (json-encode-string): Clarify commentary. (json--encode-stringlike): New function that covers a subset of json-encode. (json-encode-key): Use it for more efficient encoding and validation, and to avoid mishandling confusable keys like boolean symbols (bug#42545). (json-encode-array): Make it clearer that argument can be a list. (json-encode): Reuse json-encode-keyword and json--encode-stringlike for a subset of the dispatch logic. (json-pretty-print): Ensure confusable keys like ":a" survive a decoding/encoding roundtrip (bug#24252, bug#45032). * test/lisp/json-tests.el (test-json-encode-string) (test-json-encode-hash-table, test-json-encode-alist) (test-json-encode-plist, test-json-pretty-print-object): Test encoding of confusable keys. --- test/lisp/json-tests.el | 79 ++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 71 insertions(+), 8 deletions(-) (limited to 'test/lisp/json-tests.el') diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index 11b61d8b47e..9886dc0d457 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -421,12 +421,21 @@ Point is moved to beginning of the buffer." "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) (ert-deftest test-json-encode-key () - (should (equal (json-encode-key "") "\"\"")) (should (equal (json-encode-key '##) "\"\"")) (should (equal (json-encode-key :) "\"\"")) - (should (equal (json-encode-key "foo") "\"foo\"")) - (should (equal (json-encode-key 'foo) "\"foo\"")) - (should (equal (json-encode-key :foo) "\"foo\"")) + (should (equal (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"])) @@ -572,6 +581,39 @@ Point is moved to beginning of the buffer." (should (equal (json-encode-hash-table #s(hash-table)) "{}")) (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 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))) + "{\":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 (member (json-encode-hash-table #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))) + '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":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))) @@ -638,7 +680,16 @@ Point is moved to beginning of the buffer." (let ((json-encoding-object-sort-predicate nil) (json-encoding-pretty-print nil)) (should (equal (json-encode-alist ()) "{}")) - (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}")) + (should (equal (json-encode-alist '((a . 1) (t . 2) (nil . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '((:a . 1) (:t . 2) (:nil . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '(("a" . 1) ("t" . 2) ("nil" . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '((":a" . 1) (":t" . 2) (":nil" . 3))) + "{\":a\":1,\":t\":2,\":nil\":3}")) + (should (equal (json-encode-alist '((t . 1) (:nil . 2) (":nil" . 3))) + "{\"t\":1,\"nil\":2,\":nil\":3}")) (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}")))) @@ -687,8 +738,14 @@ Point is moved to beginning of the buffer." (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}")))) + (should (equal (json-encode-plist '(":d" 4 "c" 3 b 2 :a 1)) + "{\":d\":4,\"c\":3,\"b\":2,\"a\":1}")) + (should (equal (json-encode-plist '(nil 2 t 1)) + "{\"nil\":2,\"t\":1}")) + (should (equal (json-encode-plist '(:nil 2 :t 1)) + "{\"nil\":2,\"t\":1}")) + (should (equal (json-encode-plist '(":nil" 4 "nil" 3 ":t" 2 "t" 1)) + "{\":nil\":4,\"nil\":3,\":t\":2,\"t\":1}")))) (ert-deftest test-json-encode-plist-pretty () (let ((json-encoding-object-sort-predicate nil) @@ -950,7 +1007,13 @@ nil, ORIGINAL should stay unchanged by pretty-printing." ;; Nested array. (json-tests-equal-pretty-print "{\"key\":[1,2]}" - "{\n \"key\": [\n 1,\n 2\n ]\n}")) + "{\n \"key\": [\n 1,\n 2\n ]\n}") + ;; Confusable keys (bug#24252, bug#42545). + (json-tests-equal-pretty-print + (concat "{\"t\":1,\"nil\":2,\":t\":3,\":nil\":4," + "\"null\":5,\":json-null\":6,\":json-false\":7}") + (concat "{\n \"t\": 1,\n \"nil\": 2,\n \":t\": 3,\n \":nil\": 4," + "\n \"null\": 5,\n \":json-null\": 6,\n \":json-false\": 7\n}"))) (ert-deftest test-json-pretty-print-array () ;; Empty. -- cgit v1.2.3 From 428339e2316a552713b265193d6648125042cc98 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sun, 21 Feb 2021 20:10:08 +0000 Subject: 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 (bug#46761). 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. (test-json-encode-string): Check that text properties are stripped. --- etc/NEWS | 10 ++ lisp/json.el | 370 ++++++++++++++++++++++++++---------------------- lisp/progmodes/js.el | 6 +- test/lisp/json-tests.el | 194 +++++++++++++------------ 4 files changed, 306 insertions(+), 274 deletions(-) (limited to 'test/lisp/json-tests.el') diff --git a/etc/NEWS b/etc/NEWS index 5487448eaeb..2e0628b45ec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1559,6 +1559,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 f20123fcfbc..6677c3b1b37 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 @@ this around your call to `json-read' instead of `setq'ing it.") "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--print-indentation-prefix "\n" + "String used to start indentation during encoding. 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-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 @@ respectively, with no arguments.") -;;; Utilities +;;;; Utilities (define-obsolete-function-alias 'json-join #'string-join "28.1") @@ -169,18 +189,38 @@ destructively modify PLIST to produce the result." (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 @@ Signal `json-end-of-file' if called at the end of the buffer." ;; 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 @@ Signal `json-end-of-file' if called at the end of the buffer." -;;; Paths +;;;; Paths (defvar json--path '() "Keeps track of the path during recursive calls to `json-read'. @@ -283,7 +321,9 @@ element in a deeply nested structure." (when (plist-get path :path) path)))) -;;; Keywords + + +;;;; Keywords (defconst json-keywords '("true" "false" "null") "List of JSON keywords.") @@ -316,7 +356,13 @@ element in a deeply nested structure." ((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 @@ element in a deeply nested structure." ;; 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 @@ element in a deeply nested structure." ;; 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." + (insert ?\") + (goto-char (prog1 (point) (princ string))) + (and from (delete-char 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))))) - -(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))))) + (json--with-output-to-string (json--print-string string))) + +(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 @@ Please see the documentation of `json-object-type' and `json-key-type'." ((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 @@ Please see the documentation of `json-object-type' and `json-key-type'." ('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 @@ become JSON objects." ;; 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 @@ you will get the following structure returned: -;;; 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 @@ 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 ((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 @@ With prefix argument MINIMIZE, minimize it instead." (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 c233dcebe19..eb690a72f6e 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3699,8 +3699,7 @@ Otherwise, use the current value of `process-mark'." 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 @@ If one hasn't been set, or if it's stale, prompt for a new one." (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 9886dc0d457..f400fb064a6 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -329,13 +329,13 @@ Point is moved to beginning of the buffer." (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 @@ -404,6 +404,8 @@ Point is moved to beginning of the buffer." (should (equal (json-read-string) "abcαβγ"))) (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"" (should (equal (json-read-string) "\nasdфывfgh\t"))) + (json-tests--with-temp-buffer "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"" + (should (equal (json-read-string) "abc\uFFFFαβγ𝔸𝐁𝖢\"\\"))) ;; Bug#24784 (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\"" (should (equal (json-read-string) "\U0001D11E"))) @@ -418,30 +420,37 @@ Point is moved to beginning of the buffer." (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\""))) + "\"\\nasdфыв\\u001f\u007ffgh\\t\"")) + ;; Bug#43549. + (should (equal (json-encode-string (propertize "foo" 'read-only t)) + "\"foo\"")) + (should (equal (json-encode-string "a\0b") "\"a\\u0000b\"")) + (should (equal (json-encode-string "abc\uFFFFαβγ𝔸𝐁𝖢\"\\") + "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\""))) (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 +587,32 @@ Point is moved to beginning of the buffer." (ert-deftest test-json-encode-hash-table () (let ((json-encoding-object-sort-predicate nil) (json-encoding-pretty-print nil)) - (should (equal (json-encode-hash-table #s(hash-table)) "{}")) - (should (equal (json-encode-hash-table #s(hash-table data (a 1))) - "{\"a\":1}")) - (should (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 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))) + (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 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 (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 +625,12 @@ Point is moved to beginning of the buffer." (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 +643,12 @@ Point is moved to beginning of the buffer." (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 +666,7 @@ Point is moved to beginning of the buffer." (#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 +779,42 @@ Point is moved to beginning of the buffer." (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 -- cgit v1.2.3