branch: externals/compat
commit 730f2c5ad62137ae6a6ea002a24ce9418954e441
Author: Philip Kaludercic <phil...@posteo.net>
Commit: Philip Kaludercic <phil...@posteo.net>
Improve json-serialize compatibility
On closer inspection, there were more differences between
`json-encode' and `json-serialize', that have to be rectified before
the object is processed. These include raising errors for the wrong
data-types, where `json-serialize' is more strict than `json-encode'.
---
compat-27.el | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++----
compat-tests.el | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 100 insertions(+), 4 deletions(-)
diff --git a/compat-27.el b/compat-27.el
index b74450f9cb..56f69267a2 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -125,9 +125,10 @@ Letter-case is significant, but text properties are
ignored."
;;;; Defined in json.c
(declare-function json-parse-string nil (string &rest args))
-(declare-function json-encode-string "json" (object))
+(declare-function json-encode "json" (object))
(declare-function json-read-from-string "json" (string))
(declare-function json-read "json" ())
+(defvar json-encoding-pretty-print)
(defvar json-object-type)
(defvar json-array-type)
(defvar json-false)
@@ -165,9 +166,54 @@ any JSON false values."
(void-function t))
:realname compat--json-serialize
(require 'json)
- (let ((json-false (or (plist-get args :false-object) :false))
- (json-null (or (plist-get args :null-object) :null)))
- (json-encode-string object)))
+ (letrec ((fix (lambda (obj)
+ (cond
+ ((hash-table-p obj)
+ (let ((ht (copy-hash-table obj)))
+ (maphash
+ (lambda (key val)
+ (unless (stringp key)
+ (signal
+ 'wrong-type-argument
+ (list 'stringp key)))
+ (puthash key (funcall fix val) ht))
+ obj)
+ ht))
+ ((and (listp obj) (consp (car obj))) ;alist
+ (mapcar
+ (lambda (ent)
+ (cons (symbol-name (car ent))
+ (funcall fix (cdr ent))))
+ obj))
+ ((listp obj) ;plist
+ (let (alist)
+ (while obj
+ (push (cons (cond
+ ((keywordp (car obj))
+ (substring
+ (symbol-name (car obj))
+ 1))
+ ((symbolp (car obj))
+ (symbol-name (car obj)))
+ ((signal
+ 'wrong-type-argument
+ (list 'symbolp (car obj)))))
+ (funcall fix (cadr obj)))
+ alist)
+ (unless (consp (cdr obj))
+ (signal 'wrong-type-argument '(consp nil)))
+ (setq obj (cddr obj)))
+ (nreverse alist)))
+ ((vectorp obj)
+ (let ((vec (make-vector (length obj) nil)))
+ (dotimes (i (length obj))
+ (aset vec i (funcall fix (aref obj i))))
+ vec))
+ (obj))))
+ (json-encoding-pretty-print nil)
+ (json-false (or (plist-get args :false-object) :false))
+ (json-null (or (plist-get args :null-object) :null)))
+ (json-encode (funcall fix object))))
(compat-defun json-insert (object &rest args)
"Insert the JSON representation of OBJECT before point.
diff --git a/compat-tests.el b/compat-tests.el
index 2c0e93d133..d4064246d3 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1222,6 +1222,56 @@ being compared against."
(should (equal (gethash "key" obj) ["abc" 2]))
(should (equal (gethash "yek" obj) :null))))))
+(ert-deftest compat-json-serialize ()
+ "Check if `compat--json-serialize' was implemented properly."
+ (let ((input-1 '((:key . ["abc" 2]) (yek . t)))
+ (input-2 '(:key ["abc" 2] yek t))
+ (input-3 (let ((ht (make-hash-table)))
+ (puthash "key" ["abc" 2] ht)
+ (puthash "yek" t ht)
+ ht)))
+ (should (equal (compat--json-serialize input-1)
+ "{\":key\":[\"abc\",2],\"yek\":true}"))
+ (should (equal (compat--json-serialize input-2)
+ "{\"key\":[\"abc\",2],\"yek\":true}"))
+ (should (member (compat--json-serialize input-2)
+ '("{\"key\":[\"abc\",2],\"yek\":true}"
+ "{\"yek\":true,\"key\":[\"abc\",2]}")))
+ (should-error (compat--json-serialize '(("a" . 1)))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (compat--json-serialize '("a" 1))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (compat--json-serialize '("a" 1 2))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (compat--json-serialize '(:a 1 2))
+ :type '(wrong-type-argument consp nil))
+ (should-error (compat--json-serialize
+ (let ((ht (make-hash-table)))
+ (puthash 'a 1 ht)
+ ht))
+ :type '(wrong-type-argument stringp a))
+ (when (fboundp 'json-serialize)
+ (should (equal (json-serialize input-1)
+ "{\":key\":[\"abc\",2],\"yek\":true}"))
+ (should (equal (json-serialize input-2)
+ "{\"key\":[\"abc\",2],\"yek\":true}"))
+ (should (member (json-serialize input-2)
+ '("{\"key\":[\"abc\",2],\"yek\":true}"
+ "{\"yek\":true,\"key\":[\"abc\",2]}")))
+ (should-error (json-serialize '(("a" . 1)))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (json-serialize '("a" 1))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (json-serialize '("a" 1 2))
+ :type '(wrong-type-argument symbolp "a"))
+ (should-error (json-serialize '(:a 1 2))
+ :type '(wrong-type-argument consp nil))
+ (should-error (json-serialize
+ (let ((ht (make-hash-table)))
+ (puthash 'a 1 ht)
+ ht))
+ :type '(wrong-type-argument stringp a)))))
+
(compat-deftest compat-lookup-key
(let ((a-map (make-sparse-keymap))
(b-map (make-sparse-keymap)))
