bug#42545: 28.0.50; json-pretty-print cant't handle json having "t" as a key

["Basil L. Contovounesios" <contovob@tcd.ie>]

[-- Attachment #1: Type: text/plain, Size: 2766 bytes --]

"Basil L. Contovounesios" <contovob@tcd.ie> writes:

> Marcelo Muñoz <ma.munoz.araya@gmail.com> writes:
>
>> Try to apply json-pretty-print to follow json:
>>
>> {"t": 1, "key":2}
>>
>> fail with the message:  json-pretty-print: Bad JSON object key: t
>
> Here are some simpler repros:
>
> (json-encode '((nil . 0)))
> (json-encode '((t . 0)))
> (json-encode-key nil)
> (json-encode-key t)
>
> All of these fail with json-key-format since at least as far back as
> Emacs 24.5.

[...]

> See also https://debbugs.gnu.org/24252#26 for some precedent in
> rewriting json-encode-key without relying on json-encode.
>
> I'm AFK until start of August, but I'll try to have a better look at
> this when I get the chance if no-one beats me to it.

Sorry, finally got around to this.  The attached patch should fix this
issue while also speeding up encoding in a backward compatible way.
Using the same benchmark as https://bugs.gnu.org/40693#89 I get the
following:

  encode canada.json
  old
  (1.409496598 96 0.7710352720000002)
  (1.406660968 96 0.7707586369999997)
  (1.406515696 96 0.7698804519999998)
  (1.4098724120000001 96 0.7712946)
  new
  (1.452364951 96 0.7682001569999999)
  (1.451790854 96 0.7712237389999999)
  (1.452158289 96 0.7710199420000006)
  (1.4520665160000001 96 0.7707500029999999)

This shows that the two extra cases of funcall+cond in json-encode
slightly slow down encoding of large numbers of numbers, but I doubt
it's significant enough.  If it is, we can probably just tweak the
dispatch order in json-encode.

  encode citm_catalog.json
  old
  (2.7812737399999996 272 2.1942181940000003)
  (2.77954628 272 2.1904517840000004)
  (2.779567506 272 2.1901039010000005)
  (2.778913438 272 2.189370834)
  new
  (0.7056556740000001 68 0.55314481)
  (0.704577043 68 0.5515927839999994)
  (0.702683784 68 0.5491281600000004)
  (0.703850623 68 0.5503691039999996)

  encode twitter.json
  old
  (1.427292653 148 1.1098771399999983)
  (1.428440774 148 1.109535473000001)
  (1.4265714 148 1.1097104909999977)
  (1.426152699 148 1.110347719)
  new
  (0.365952034 40 0.29652698499999985)
  (0.366947621 40 0.29772050399999905)
  (0.36731820000000004 40 0.29776995099999937)
  (0.366228327 40 0.29696426200000126)

These show that examples with more realistic objects are encoded far
faster.

Decoding performance is not affected.

This change fixes some errors in json.el and brings it a tiny bit closer
to json.c in handling confusable keys, but doesn't go all the way, for
backward compatibility.  For example, json-encode and json-serialize
still disagree on ((:t . 1)), (("t" . 1)), (t 1), ("t" 1), hash tables
with non-string keys, etc.

WDYT?

-- 
Basil


[-- Attachment #2: 0001-Fix-json.el-encoding-of-confusable-object-keys.patch --]
[-- Type: text/x-diff, Size: 11054 bytes --]

From 911fa28836888fc1d5c9f16fda6ebbb188bfbac5 Mon Sep 17 00:00:00 2001
From: "Basil L. Contovounesios" <contovob@tcd.ie>
Date: Thu, 11 Feb 2021 12:00:05 +0000
Subject: [PATCH] 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.
---
 lisp/json.el            | 36 ++++++++++---------
 test/lisp/json-tests.el | 79 ++++++++++++++++++++++++++++++++++++-----
 2 files changed, 90 insertions(+), 25 deletions(-)

diff --git a/lisp/json.el b/lisp/json.el
index 1f1f608eab..f20123fcfb 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -438,7 +438,8 @@ json-encode-string
               ;; This seems to afford decent performance gains.
               (setq-local inhibit-modification-hooks t)
               (setq json--string-buffer (current-buffer))))
-      (insert ?\" (substring-no-properties string)) ; see bug#43549
+      ;; 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)))
@@ -452,14 +453,20 @@ json-encode-string
       ;; 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)))))
+
 (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'."
-  (let ((encoded (json-encode object)))
-    (unless (stringp (json-read-from-string encoded))
-      (signal 'json-key-format (list object)))
-    encoded))
+  ;; Encoding must be a JSON string.
+  (or (json--encode-stringlike object)
+      (signal 'json-key-format (list object))))
 
 ;;; Objects
 
@@ -652,11 +659,10 @@ json-read-array
 ;; Array encoding
 
 (defun json-encode-array (array)
-  "Return a JSON representation of ARRAY."
+  "Return a JSON representation of ARRAY.
+ARRAY can also be a list."
   (if (and json-encoding-pretty-print
-           (if (listp array)
-               array
-             (> (length array) 0)))
+           (not (length= array 0)))
       (concat
        "["
        (json--with-indentation
@@ -737,15 +743,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 ((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)))
+  (cond ((json-encode-keyword object))
         ((listp object)         (json-encode-list object))
-        ((symbolp object)       (json-encode-string
-                                 (symbol-name 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))
@@ -774,6 +774,8 @@ json-pretty-print
         (json-null :json-null)
         ;; Ensure that ordering is maintained.
         (json-object-type 'alist)
+        ;; Ensure that keys survive roundtrip (bug#24252, bug#42545).
+        (json-key-type 'string)
         (orig-buf (current-buffer))
         error)
     ;; Strategy: Repeatedly `json-read' from the original buffer and
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 11b61d8b47..9886dc0d45 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -421,12 +421,21 @@ 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 "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 @@ test-json-encode-hash-table
     (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 @@ test-json-encode-alist
   (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 @@ test-json-encode-plist
     (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 @@ test-json-pretty-print-object
   ;; 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.
-- 
2.30.0