master 625de7e 1/2: Allow any JSON value at the top level (Bug#42994).

[Philipp Stephani]

branch: master
commit 625de7e403abb24c2d6ae417622fa8c7d6f55530
Author: Philipp Stephani <phst@google.com>
Commit: Philipp Stephani <phst@google.com>

    Allow any JSON value at the top level (Bug#42994).
    
    Newer standards like RFC 8259, which obsoletes the earlier RFC 4627,
    now allow any top-level value unconditionally, so Emacs should too.
    
    * src/json.c (Fjson_serialize, Fjson_insert): Pass JSON_ENCODE_ANY to
    allow serialization of any JSON value.  Call 'lisp_to_json' instead of
    'lisp_to_json_toplevel'.  Remove obsolete comments
    (neither JSON_DECODE_ANY nor JSON_ALLOW_NUL are allowed here).  Reword
    documentation strings.
    (Fjson_parse_string, Fjson_parse_buffer): Pass JSON_DECODE_ANY to
    allow deserialization of any JSON value.  Reword documentation
    strings.
    (lisp_to_json_nonscalar, lisp_to_json_nonscalar_1): Rename from
    "toplevel" to avoid confusion.
    (lisp_to_json): Adapt caller.
    * test/src/json-tests.el (json-serialize/roundtrip-scalars): New unit
    test.
    * doc/lispref/text.texi (Parsing JSON): Update documentation.
---
 doc/lispref/text.texi  |  7 ++---
 src/json.c             | 74 +++++++++++++++++++++++++-------------------------
 test/src/json-tests.el | 28 +++++++++++++++++++
 3 files changed, 68 insertions(+), 41 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index b367346..e47e851 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5288,10 +5288,9 @@ object parsed.
 Signaled when encountering invalid JSON syntax.
 @end table
 
-  Only top-level values (arrays and objects) can be serialized to
-JSON@.  The subobjects within these top-level values can be of any
-type.  Likewise, the parsing functions will only return vectors,
-hashtables, alists, and plists.
+  Top-level values and the subobjects within these top-level values
+can be serialized to JSON@.  Likewise, the parsing functions will
+return any of the possible types described above.
 
 @defun json-serialize object &rest args
 This function returns a new Lisp string which contains the JSON
diff --git a/src/json.c b/src/json.c
index 2901a20..e0e49ae 100644
--- a/src/json.c
+++ b/src/json.c
@@ -329,11 +329,11 @@ struct json_configuration {
 
 static json_t *lisp_to_json (Lisp_Object, struct json_configuration *conf);
 
-/* Convert a Lisp object to a toplevel JSON object (array or object).  */
+/* Convert a Lisp object to a nonscalar JSON object (array or object).  */
 
 static json_t *
-lisp_to_json_toplevel_1 (Lisp_Object lisp,
-                         struct json_configuration *conf)
+lisp_to_json_nonscalar_1 (Lisp_Object lisp,
+                          struct json_configuration *conf)
 {
   json_t *json;
   ptrdiff_t count;
@@ -448,16 +448,17 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp,
   return json;
 }
 
-/* Convert LISP to a toplevel JSON object (array or object).  Signal
+/* Convert LISP to a nonscalar JSON object (array or object).  Signal
    an error of type `wrong-type-argument' if LISP is not a vector,
    hashtable, alist, or plist.  */
 
 static json_t *
-lisp_to_json_toplevel (Lisp_Object lisp, struct json_configuration *conf)
+lisp_to_json_nonscalar (Lisp_Object lisp,
+                        struct json_configuration *conf)
 {
   if (++lisp_eval_depth > max_lisp_eval_depth)
     xsignal0 (Qjson_object_too_deep);
-  json_t *json = lisp_to_json_toplevel_1 (lisp, conf);
+  json_t *json = lisp_to_json_nonscalar_1 (lisp, conf);
   --lisp_eval_depth;
   return json;
 }
@@ -499,7 +500,7 @@ lisp_to_json (Lisp_Object lisp, struct json_configuration 
*conf)
     }
 
   /* LISP now must be a vector, hashtable, alist, or plist.  */
-  return lisp_to_json_toplevel (lisp, conf);
+  return lisp_to_json_nonscalar (lisp, conf);
 }
 
 static void
@@ -557,15 +558,15 @@ DEFUN ("json-serialize", Fjson_serialize, 
Sjson_serialize, 1, MANY,
        NULL,
        doc: /* Return the JSON representation of OBJECT as a string.
 
-OBJECT must be a vector, hashtable, alist, or plist and its elements
-can recursively contain the Lisp equivalents to the JSON null and
-false values, t, numbers, strings, or other vectors hashtables, alists
-or plists.  t will be converted to the JSON true value.  Vectors will
-be converted to JSON arrays, whereas hashtables, alists and plists are
-converted to JSON objects.  Hashtable keys must be strings without
-embedded null characters and must be unique within each object.  Alist
-and plist keys must be symbols; if a key is duplicate, the first
-instance is used.
+OBJECT must be t, a number, string, vector, hashtable, alist, plist,
+or the Lisp equivalents to the JSON null and false values, and its
+elements must recursively consist of the same kinds of values.  t will
+be converted to the JSON true value.  Vectors will be converted to
+JSON arrays, whereas hashtables, alists and plists are converted to
+JSON objects.  Hashtable keys must be strings without embedded null
+characters and must be unique within each object.  Alist and plist
+keys must be symbols; if a key is duplicate, the first instance is
+used.
 
 The Lisp equivalents to the JSON null and false values are
 configurable in the arguments ARGS, a list of keyword/argument pairs:
@@ -603,12 +604,10 @@ usage: (json-serialize OBJECT &rest ARGS)  */)
     {json_object_hashtable, json_array_array, QCnull, QCfalse};
   json_parse_args (nargs - 1, args + 1, &conf, false);
 
-  json_t *json = lisp_to_json_toplevel (args[0], &conf);
+  json_t *json = lisp_to_json (args[0], &conf);
   record_unwind_protect_ptr (json_release_object, json);
 
-  /* If desired, we might want to add the following flags:
-     JSON_DECODE_ANY, JSON_ALLOW_NUL.  */
-  char *string = json_dumps (json, JSON_COMPACT);
+  char *string = json_dumps (json, JSON_COMPACT | JSON_ENCODE_ANY);
   if (string == NULL)
     json_out_of_memory ();
   record_unwind_protect_ptr (json_free, string);
@@ -723,12 +722,10 @@ usage: (json-insert OBJECT &rest ARGS)  */)
   move_gap_both (PT, PT_BYTE);
   struct json_insert_data data;
   data.inserted_bytes = 0;
-  /* If desired, we might want to add the following flags:
-     JSON_DECODE_ANY, JSON_ALLOW_NUL.  */
-  int status
-    /* Could have used json_dumpb, but that became available only in
-       Jansson 2.10, whereas we want to support 2.7 and upward.  */
-    = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT);
+  /* Could have used json_dumpb, but that became available only in
+     Jansson 2.10, whereas we want to support 2.7 and upward.  */
+  int status = json_dump_callback (json, json_insert_callback, &data,
+                                   JSON_COMPACT | JSON_ENCODE_ANY);
   if (status == -1)
     {
       if (CONSP (data.error))
@@ -930,14 +927,14 @@ json_to_lisp (json_t *json, struct json_configuration 
*conf)
 
 DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, MANY,
        NULL,
-       doc: /* Parse the JSON STRING into a Lisp object.
-This is essentially the reverse operation of `json-serialize', which
-see.  The returned object will be a vector, list, hashtable, alist, or
-plist.  Its elements will be the JSON null value, the JSON false
-value, t, numbers, strings, or further vectors, hashtables, alists, or
-plists.  If there are duplicate keys in an object, all but the last
-one are ignored.  If STRING doesn't contain a valid JSON object, this
-function signals an error of type `json-parse-error'.
+       doc: /* Parse the JSON STRING into a Lisp object.  This is
+essentially the reverse operation of `json-serialize', which see.  The
+returned object will be the JSON null value, the JSON false value, t,
+a number, a string, a vector, a list, a hashtable, an alist, or a
+plist.  Its elements will be further objects of these types.  If there
+are duplicate keys in an object, all but the last one are ignored.  If
+STRING doesn't contain a valid JSON object, this function signals an
+error of type `json-parse-error'.
 
 The arguments ARGS are a list of keyword/argument pairs:
 
@@ -982,7 +979,8 @@ usage: (json-parse-string STRING &rest ARGS) */)
   json_parse_args (nargs - 1, args + 1, &conf, true);
 
   json_error_t error;
-  json_t *object = json_loads (SSDATA (encoded), 0, &error);
+  json_t *object
+    = json_loads (SSDATA (encoded), JSON_DECODE_ANY, &error);
   if (object == NULL)
     json_parse_error (&error);
 
@@ -1078,8 +1076,10 @@ usage: (json-parse-buffer &rest args) */)
   ptrdiff_t point = PT_BYTE;
   struct json_read_buffer_data data = {.point = point};
   json_error_t error;
-  json_t *object = json_load_callback (json_read_buffer_callback, &data,
-                                       JSON_DISABLE_EOF_CHECK, &error);
+  json_t *object
+    = json_load_callback (json_read_buffer_callback, &data,
+                          JSON_DECODE_ANY | JSON_DISABLE_EOF_CHECK,
+                          &error);
 
   if (object == NULL)
     json_parse_error (&error);
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
index 4be11b8..908945f 100644
--- a/test/src/json-tests.el
+++ b/test/src/json-tests.el
@@ -51,6 +51,34 @@
       (should (equal (json-parse-buffer) lisp))
       (should (eobp)))))
 
+(ert-deftest json-serialize/roundtrip-scalars ()
+  "Check that Bug#42994 is fixed."
+  (skip-unless (fboundp 'json-serialize))
+  (dolist (case '((:null "null")
+                  (:false "false")
+                  (t "true")
+                  (0 "0")
+                  (123 "123")
+                  (-456 "-456")
+                  (3.75 "3.75")
+                  ;; The noncharacter U+FFFF should be passed through,
+                  ;; cf. 
https://www.unicode.org/faq/private_use.html#noncharacters.
+                  ("abc\uFFFFαβγ𝔸𝐁𝖢\"\\"
+                   "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"")))
+    (cl-destructuring-bind (lisp json) case
+      (ert-info ((format "%S ↔ %S" lisp json))
+        (should (equal (json-serialize lisp) json))
+        (with-temp-buffer
+          (json-insert lisp)
+          (should (equal (buffer-string) json))
+          (should (eobp)))
+        (should (equal (json-parse-string json) lisp))
+        (with-temp-buffer
+          (insert json)
+          (goto-char 1)
+          (should (equal (json-parse-buffer) lisp))
+          (should (eobp)))))))
+
 (ert-deftest json-serialize/object ()
   (skip-unless (fboundp 'json-serialize))
   (let ((table (make-hash-table :test #'equal)))