From 428339e2316a552713b265193d6648125042cc98 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
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.
---
test/lisp/json-tests.el | 194 ++++++++++++++++++++++++------------------------
1 file changed, 96 insertions(+), 98 deletions(-)
(limited to 'test/lisp/json-tests.el')
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