Accept alists when serializing JSON

* src/json.c (lisp_to_json_toplevel_1): Also accept alists
representing objects.

* src/json.c (Fjson_serialize): Update docstring.

* test/src/json-tests.el (json-serialize/object): Add unit tests for
serializing alists.

* doc/lispref/text.texi (Parsing JSON): Document that serialization
functions accept alists.

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 561ad804344c715994cdf0e0d6762a77ffa4b2bb..7a1983641fd6fed1f0cc6fc8da04b5d654bf2a26 100644 (file)
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4929,14 +4929,16 @@ represented using Lisp vectors.
 
 @item
 JSON has only one map type, the object.  JSON objects are represented
-using Lisp hashtables or alists.
+using Lisp hashtables or alists.  When an alist contains several
+elements with the same key, Emacs uses only the first element for
+serialization, in accordance with the behavior of @code{assq}.
 
 @end itemize
 
 @noindent
-Note that @code{nil} represents the empty JSON object, @code{@{@}},
-not @code{null}, @code{false}, or an empty array, all of which are
-different JSON values.
+Note that @code{nil} is a valid alist and represents the empty JSON
+object, @code{@{@}}, not @code{null}, @code{false}, or an empty array,
+all of which are different JSON values.
 
   If some Lisp object can't be represented in JSON, the serialization
 functions will signal an error of type @code{wrong-type-argument}.

diff --git a/src/json.c b/src/json.c
index c1daba199c387e3f693f014a38222e410ab28110..f615c4269f19ec79726b3db62bb9e15320de3a85 100644 (file)
--- a/src/json.c
+++ b/src/json.c
@@ -367,12 +367,48 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json)
       clear_unwind_protect (count);
       return unbind_to (count, Qnil);
     }
+  else if (NILP (lisp))
+    {
+      *json = json_check (json_object ());
+      return Qnil;
+    }
+  else if (CONSP (lisp))
+    {
+      Lisp_Object tail = lisp;
+      *json = json_check (json_object ());
+      ptrdiff_t count = SPECPDL_INDEX ();
+      record_unwind_protect_ptr (json_release_object, *json);
+      FOR_EACH_TAIL (tail)
+        {
+          Lisp_Object pair = XCAR (tail);
+          CHECK_CONS (pair);
+          Lisp_Object key_symbol = XCAR (pair);
+          Lisp_Object value = XCDR (pair);
+          CHECK_SYMBOL (key_symbol);
+          Lisp_Object key = SYMBOL_NAME (key_symbol);
+          /* We can't specify the length, so the string must be
+             null-terminated.  */
+          check_string_without_embedded_nulls (key);
+          const char *key_str = SSDATA (key);
+          /* Only add element if key is not already present.  */
+          if (json_object_get (*json, key_str) == NULL)
+            {
+              int status
+                = json_object_set_new (*json, key_str, lisp_to_json (value));
+              if (status == -1)
+                json_out_of_memory ();
+            }
+        }
+      CHECK_LIST_END (tail, lisp);
+      clear_unwind_protect (count);
+      return unbind_to (count, Qnil);
+    }
   wrong_type_argument (Qjson_value_p, lisp);
 }
 
 /* Convert LISP to a toplevel JSON object (array or object).  Signal
-   an error of type `wrong-type-argument' if LISP is not a vector or
-   hashtable.  */
+   an error of type `wrong-type-argument' if LISP is not a vector,
+   hashtable, or alist.  */
 
 static json_t *
 lisp_to_json_toplevel (Lisp_Object lisp)
@@ -413,19 +449,20 @@ lisp_to_json (Lisp_Object lisp)
       return json_check (json_stringn (SSDATA (encoded), SBYTES (encoded)));
     }
 
-  /* LISP now must be a vector or hashtable.  */
+  /* LISP now must be a vector, hashtable, or alist.  */
   return lisp_to_json_toplevel (lisp);
 }
 
 DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, 1, NULL,
        doc: /* Return the JSON representation of OBJECT as a string.
-OBJECT must be a vector or hashtable, and its elements can recursively
-contain `:null', `:false', t, numbers, strings, or other vectors and
-hashtables.  `:null', `:false', and t will be converted to JSON null,
-false, and true values, respectively.  Vectors will be converted to
-JSON arrays, and hashtables to JSON objects.  Hashtable keys must be
-strings without embedded null characters and must be unique within
-each object.  */)
+OBJECT must be a vector, hashtable, or alist, and its elements can
+recursively contain `:null', `:false', t, numbers, strings, or other
+vectors hashtables, and alist.  `:null', `:false', and t will be
+converted to JSON null, false, and true values, respectively.  Vectors
+will be converted to JSON arrays, and hashtables and alists to JSON
+objects.  Hashtable keys must be strings without embedded null
+characters and must be unique within each object.  Alist keys must be
+symbols; if a key is duplicate, the first instance is used.  */)
   (Lisp_Object object)
 {
   ptrdiff_t count = SPECPDL_INDEX ();

diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 5d9f6b3840c681af44d00537c0b367dcf0a2da0f..b23439a59fd7209576c6b8d78b9964226f49aedb 100644 (file)
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -50,7 +50,19 @@
     (puthash "abc" [1 2 t] table)
     (puthash "def" :null table)
     (should (equal (json-serialize table)
-                   "{\"abc\":[1,2,true],\"def\":null}"))))
+                   "{\"abc\":[1,2,true],\"def\":null}")))
+  (should (equal (json-serialize '((abc . [1 2 t]) (def . :null)))
+                 "{\"abc\":[1,2,true],\"def\":null}"))
+  (should (equal (json-serialize nil) "{}"))
+  (should (equal (json-serialize '((abc))) "{\"abc\":{}}"))
+  (should (equal (json-serialize '((a . 1) (b . 2) (a . 3)))
+                 "{\"a\":1,\"b\":2}"))
+  (should-error (json-serialize '(abc)) :type 'wrong-type-argument)
+  (should-error (json-serialize '((a 1))) :type 'wrong-type-argument)
+  (should-error (json-serialize '((1 . 2))) :type 'wrong-type-argument)
+  (should-error (json-serialize '((a . 1) . b)) :type 'wrong-type-argument)
+  (should-error (json-serialize '#1=((a . 1) . #1#)) :type 'circular-list)
+  (should-error (json-serialize '(#1=(a #1#)))))
 
 (ert-deftest json-serialize/object-with-duplicate-keys ()
   (skip-unless (fboundp 'json-serialize))