From: Philipp Stephani <p.stephani2@gmail.com>
To: emacs-devel@gnu.org
Subject: Re: JSON/YAML/TOML/etc. parsing performance
Date: Mon, 18 Sep 2017 13:26:34 +0000 [thread overview]
Message-ID: <CAArVCkTj_1P+fTDCzEY5xG8bBB7B6ctNkQCv+bAxt=N_cuD05Q@mail.gmail.com> (raw)
In-Reply-To: <CAArVCkQTLp=Cmh-FM1R-WK=WYFX_hP=6XiUUinKRT17bciL+CQ@mail.gmail.com>
[-- Attachment #1.1: Type: text/plain, Size: 1112 bytes --]
Philipp Stephani <p.stephani2@gmail.com> schrieb am So., 17. Sep. 2017 um
20:46 Uhr:
> Ted Zlatanov <tzz@lifelogs.com> schrieb am Sa., 16. Sep. 2017 um
> 17:55 Uhr:
>
>> I wanted to ask if there's any chance of improving the parsing
>> performance of JSON, YAML, TOML, and similar data formats. It's pretty
>> poor today.
>>
>> That could be done in the core with C code, improved Lisp code,
>> integration with an external library, or a mix of those.
>>
>
> I don't know much about the others, but given the importance of JSON as
> data exchange and serialization format, I think it's worthwhile to invest
> some time here. I've implemented a wrapper around the json-c library
> (license: Expat/X11/MIT), resulting in significant speedups using the test
> data from https://github.com/miloyip/nativejson-benchmark: a factor of
> 3.9 to 6.4 for parsing, and a factor of 27 to 67 for serializing. If people
> agree that this is useful I can send a patch.
>
I've discovered that the interface and documentation of Jansson are much
better than the ones of json-c, so I switched to Jansson. I've attached a
patch.
[-- Attachment #1.2: Type: text/html, Size: 1807 bytes --]
[-- Attachment #2: 0001-Implement-native-JSON-support-using-Jansson.txt --]
[-- Type: text/plain, Size: 22836 bytes --]
From 67ad4e22c5a0b5dcc0dea2abdef32ee3c636fade Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Mon, 18 Sep 2017 10:51:39 +0200
Subject: [PATCH] Implement native JSON support using Jansson
* configure.ac: New option --with-json.
* src/json.c (Fjson_serialize, Fjson_insert, Fjson_parse_string)
(Fjson_parse_buffer): New defuns.
(json_out_of_memory, json_parse_error, json_release_object)
(check_string_without_embedded_nulls, json_check, lisp_to_json)
(json_insert, json_insert_callback, json_to_lisp)
(json_read_buffer_callback, Fjson_parse_buffer, define_error): New
helper function.
(syms_of_json): New file.
* src/lisp.h: Declaration for syms_of_json.
* src/emacs.c (main): Enable JSON functions.
* src/Makefile.in (JSON_LIBS, JSON_CFLAGS, JSON_OBJ, EMACS_CFLAGS)
(base_obj, LIBES): Compile json.c if --with-json is enabled.
* test/src/json-tests.el (json-serialize/roundtrip)
(json-serialize/object, json-parse-string/object): New unit tests.
---
configure.ac | 20 ++-
src/Makefile.in | 11 +-
src/emacs.c | 4 +
src/json.c | 442 +++++++++++++++++++++++++++++++++++++++++++++++++
src/lisp.h | 5 +
test/src/json-tests.el | 61 +++++++
6 files changed, 539 insertions(+), 4 deletions(-)
create mode 100644 src/json.c
create mode 100644 test/src/json-tests.el
diff --git a/configure.ac b/configure.ac
index 35b7e69daf..c9ce5ee120 100644
--- a/configure.ac
+++ b/configure.ac
@@ -348,6 +348,7 @@ AC_DEFUN
OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)])
OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
OPTION_DEFAULT_ON([imagemagick],[don't compile with ImageMagick image support])
+OPTION_DEFAULT_ON([json], [don't compile with native JSON support])
OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support])
@@ -2856,6 +2857,22 @@ AC_DEFUN
AC_SUBST(LIBSYSTEMD_LIBS)
AC_SUBST(LIBSYSTEMD_CFLAGS)
+HAVE_JSON=no
+JSON_OBJ=
+
+if test "${with_json}" = yes; then
+ EMACS_CHECK_MODULES([JSON], [jansson >= 2.5],
+ [HAVE_JSON=yes], [HAVE_JSON=no])
+ if test "${HAVE_JSON}" = yes; then
+ AC_DEFINE(HAVE_JSON, 1, [Define if using Jansson.])
+ JSON_OBJ=json.o
+ fi
+fi
+
+AC_SUBST(JSON_LIBS)
+AC_SUBST(JSON_CFLAGS)
+AC_SUBST(JSON_OBJ)
+
NOTIFY_OBJ=
NOTIFY_SUMMARY=no
@@ -5368,7 +5385,7 @@ AC_DEFUN
for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \
- XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do
+ XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2; do
case $opt in
CANNOT_DUMP) eval val=\${$opt} ;;
@@ -5418,6 +5435,7 @@ AC_DEFUN
Does Emacs use -lotf? ${HAVE_LIBOTF}
Does Emacs use -lxft? ${HAVE_XFT}
Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD}
+ Does Emacs use -ljanssoon? ${HAVE_JSON}
Does Emacs directly use zlib? ${HAVE_ZLIB}
Does Emacs have dynamic modules support? ${HAVE_MODULES}
Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}
diff --git a/src/Makefile.in b/src/Makefile.in
index 0e55ad4bb2..4d33682629 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -312,6 +312,10 @@ LIBGNUTLS_CFLAGS =
LIBSYSTEMD_LIBS = @LIBSYSTEMD_LIBS@
LIBSYSTEMD_CFLAGS = @LIBSYSTEMD_CFLAGS@
+JSON_LIBS = @JSON_LIBS@
+JSON_CFLAGS = @JSON_CFLAGS@
+JSON_OBJ = @JSON_OBJ@
+
INTERVALS_H = dispextern.h intervals.h composite.h
GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
@@ -363,7 +367,7 @@ EMACS_CFLAGS=
$(WEBKIT_CFLAGS) \
$(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \
$(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \
- $(LIBSYSTEMD_CFLAGS) \
+ $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \
$(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \
$(WERROR_CFLAGS)
ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS)
@@ -397,7 +401,7 @@ base_obj =
thread.o systhread.o \
$(if $(HYBRID_MALLOC),sheap.o) \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
- $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ)
+ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
## Object files used on some machine or other.
@@ -493,7 +497,8 @@ LIBES =
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \
- $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS)
+ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
+ $(JSON_LIBS)
## FORCE it so that admin/unidata can decide whether these files
## are up-to-date. Although since charprop depends on bootstrap-emacs,
diff --git a/src/emacs.c b/src/emacs.c
index 1ad8af70a7..eb5f1128f6 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1610,6 +1610,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_threads ();
syms_of_profiler ();
+#ifdef HAVE_JSON
+ syms_of_json ();
+#endif
+
keys_of_casefiddle ();
keys_of_cmds ();
keys_of_buffer ();
diff --git a/src/json.c b/src/json.c
new file mode 100644
index 0000000000..628de82921
--- /dev/null
+++ b/src/json.c
@@ -0,0 +1,442 @@
+/* JSON parsing and serialization.
+
+Copyright (C) 2017 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include <stddef.h>
+#include <stdint.h>
+
+#include <jansson.h>
+
+#include "lisp.h"
+#include "buffer.h"
+
+static _Noreturn void
+json_out_of_memory (void)
+{
+ xsignal0 (Qjson_out_of_memory);
+}
+
+static _Noreturn void
+json_parse_error (const json_error_t *error)
+{
+ xsignal (Qjson_parse_error,
+ list5 (build_string (error->text), build_string (error->source),
+ make_natnum (error->line), make_natnum (error->column),
+ make_natnum (error->position)));
+}
+
+static void
+json_release_object (void *object)
+{
+ json_decref (object);
+}
+
+static void
+check_string_without_embedded_nulls (Lisp_Object object)
+{
+ CHECK_STRING (object);
+ CHECK_TYPE (memchr (SDATA (object), '\0', SBYTES (object)) == NULL,
+ Qstring_without_embedded_nulls_p, object);
+}
+
+static json_t *
+json_check (json_t *object)
+{
+ if (object == NULL)
+ json_out_of_memory ();
+ return object;
+}
+
+static json_t *
+lisp_to_json (Lisp_Object lisp)
+{
+ if (NILP (lisp))
+ return json_check (json_null ());
+ else if (EQ (lisp, QCjson_false))
+ return json_check (json_false ());
+ else if (EQ (lisp, Qt))
+ return json_check (json_true ());
+ else if (INTEGERP (lisp))
+ {
+ CHECK_TYPE_RANGED_INTEGER (json_int_t, lisp);
+ return json_check (json_integer (XINT (lisp)));
+ }
+ else if (FLOATP (lisp))
+ return json_check (json_real (XFLOAT_DATA (lisp)));
+ else if (STRINGP (lisp))
+ {
+ ptrdiff_t size = SBYTES (lisp);
+ eassert (size >= 0);
+ if (size > SIZE_MAX)
+ xsignal1 (Qoverflow_error, build_pure_c_string ("string is too long"));
+ return json_check (json_stringn (SSDATA (lisp), size));
+ }
+ else if (VECTORP (lisp))
+ {
+ if (++lisp_eval_depth > max_lisp_eval_depth)
+ xsignal0 (Qjson_object_too_deep);
+ ptrdiff_t size = ASIZE (lisp);
+ eassert (size >= 0);
+ if (size > SIZE_MAX)
+ xsignal1 (Qoverflow_error, build_pure_c_string ("vector is too long"));
+ json_t *json = json_check (json_array ());
+ for (ptrdiff_t i = 0; i < size; ++i)
+ {
+ int status
+ = json_array_append_new (json, lisp_to_json (AREF (lisp, i)));
+ if (status == -1)
+ json_out_of_memory ();
+ eassert (status == 0);
+ }
+ eassert (json_array_size (json) == size);
+ --lisp_eval_depth;
+ return json;
+ }
+ else if (HASH_TABLE_P (lisp))
+ {
+ if (++lisp_eval_depth > max_lisp_eval_depth)
+ xsignal0 (Qjson_object_too_deep);
+ json_t* json = json_check (json_object ());
+ struct Lisp_Hash_Table *h = XHASH_TABLE (lisp);
+ for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
+ if (!NILP (HASH_HASH (h, i)))
+ {
+ Lisp_Object key = HASH_KEY (h, i);
+ /* We can’t specify the length, so the string must be
+ null-terminated. */
+ check_string_without_embedded_nulls (key);
+ int status = json_object_set_new (json, SSDATA (key),
+ lisp_to_json (HASH_VALUE (h, i)));
+ if (status == -1)
+ json_out_of_memory ();
+ eassert (status == 0);
+ }
+ --lisp_eval_depth;
+ return json;
+ }
+ wrong_type_argument (Qjson_value_p, 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 nil, t, `:json-false', numbers, strings, or other vectors and
+hashtables. nil, t, and `:json-false' will be converted to JSON null,
+true, and false 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. */)
+ (Lisp_Object object)
+{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ json_t *json = lisp_to_json (object);
+ record_unwind_protect_ptr (json_release_object, json);
+
+ char *string = json_dumps (json, JSON_COMPACT);
+ if (string == NULL)
+ json_out_of_memory ();
+ record_unwind_protect_ptr (free, string);
+
+ return unbind_to (count, build_string (string));
+}
+
+struct json_buffer_and_size
+{
+ const char *buffer;
+ size_t size;
+};
+
+static Lisp_Object
+json_insert (Lisp_Object data)
+{
+ const struct json_buffer_and_size *buffer_and_size = XSAVE_POINTER (data, 0);
+ if (FIXNUM_OVERFLOW_P (buffer_and_size->size))
+ xsignal1 (Qoverflow_error, build_pure_c_string ("buffer too large"));
+ Lisp_Object string
+ = make_string (buffer_and_size->buffer, buffer_and_size->size);
+ insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), false);
+ return Qnil;
+}
+
+struct json_insert_data
+{
+ /* nil if json_insert succeeded, otherwise a cons
+ (ERROR-SYMBOL . ERROR-DATA). */
+ Lisp_Object error;
+};
+
+static int
+json_insert_callback (const char *buffer, size_t size, void *data)
+{
+ /* This function may not exit nonlocally. */
+ struct json_insert_data *d = data;
+ struct json_buffer_and_size buffer_and_size
+ = {.buffer = buffer, .size = size};
+ d->error
+ = internal_condition_case_1 (json_insert, make_save_ptr (&buffer_and_size),
+ Qt, Fidentity);
+ return 0;
+}
+
+DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL,
+ doc: /* Insert the JSON representation of OBJECT before point.
+This is the same as (insert (json-serialize OBJECT)), but potentially
+faster. See the function `json-serialize' for allowed values of
+OBJECT. */)
+ (Lisp_Object object)
+{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ json_t *json = lisp_to_json (object);
+ record_unwind_protect_ptr (json_release_object, json);
+
+ struct json_insert_data data;
+ int status
+ = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT);
+ if (status == -1)
+ json_out_of_memory ();
+ eassert (status == 0);
+
+ if (!NILP (data.error))
+ xsignal (XCAR (data.error), XCDR (data.error));
+
+ return unbind_to (count, Qnil);
+}
+
+static Lisp_Object
+json_to_lisp (json_t *json)
+{
+ switch (json_typeof (json))
+ {
+ case JSON_NULL:
+ return Qnil;
+ case JSON_FALSE:
+ return QCjson_false;
+ case JSON_TRUE:
+ return Qt;
+ case JSON_INTEGER:
+ {
+ json_int_t value = json_integer_value (json);
+ if (FIXNUM_OVERFLOW_P (value))
+ xsignal1 (Qoverflow_error,
+ build_pure_c_string ("JSON integer is too large"));
+ return make_number (value);
+ }
+ case JSON_REAL:
+ return make_float (json_real_value (json));
+ case JSON_STRING:
+ {
+ size_t size = json_string_length (json);
+ if (FIXNUM_OVERFLOW_P (size))
+ xsignal1 (Qoverflow_error,
+ build_pure_c_string ("JSON string is too long"));
+ return make_string (json_string_value (json), size);
+ }
+ case JSON_ARRAY:
+ {
+ if (++lisp_eval_depth > max_lisp_eval_depth)
+ xsignal0 (Qjson_object_too_deep);
+ size_t size = json_array_size (json);
+ if (FIXNUM_OVERFLOW_P (size))
+ xsignal1 (Qoverflow_error,
+ build_pure_c_string ("JSON array is too long"));
+ Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound);
+ for (ptrdiff_t i = 0; i < size; ++i)
+ ASET (result, i,
+ json_to_lisp (json_array_get (json, i)));
+ --lisp_eval_depth;
+ return result;
+ }
+ case JSON_OBJECT:
+ {
+ if (++lisp_eval_depth > max_lisp_eval_depth)
+ xsignal0 (Qjson_object_too_deep);
+ size_t size = json_object_size (json);
+ if (FIXNUM_OVERFLOW_P (size))
+ xsignal1 (Qoverflow_error,
+ build_pure_c_string ("JSON object has too many elements"));
+ Lisp_Object result = CALLN (Fmake_hash_table, QCtest, Qequal,
+ QCsize, make_natnum (size));
+ struct Lisp_Hash_Table *h = XHASH_TABLE (result);
+ const char *key_str;
+ json_t *value;
+ json_object_foreach (json, key_str, value)
+ {
+ Lisp_Object key = build_string (key_str);
+ EMACS_UINT hash;
+ ptrdiff_t i = hash_lookup (h, key, &hash);
+ eassert (i < 0);
+ hash_put (h, key, json_to_lisp (value), hash);
+ }
+ --lisp_eval_depth;
+ return result;
+ }
+ }
+ /* Can’t get here. */
+ emacs_abort ();
+}
+
+DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, 1, 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 or hashtable. Its elements
+will be nil, t, `:json-false', numbers, strings, or further vectors
+and hashtables. If there are duplicate keys in an object, all but the
+last one are ignored. If STRING doesn't contain a valid JSON object,
+an error of type `json-parse-error' is signaled. */)
+ (Lisp_Object string)
+{
+ ptrdiff_t count = SPECPDL_INDEX ();
+ check_string_without_embedded_nulls (string);
+
+ json_error_t error;
+ json_t *object = json_loads (SSDATA (string), 0, &error);
+ if (object == NULL)
+ json_parse_error (&error);
+
+ /* Avoid leaking the object in case of further errors. */
+ if (object != NULL)
+ record_unwind_protect_ptr (json_release_object, object);
+
+ return unbind_to (count, json_to_lisp (object));
+}
+
+struct json_read_buffer_data
+{
+ ptrdiff_t point;
+};
+
+static size_t
+json_read_buffer_callback (void *buffer, size_t buflen, void *data)
+{
+ struct json_read_buffer_data *d = data;
+
+ /* First, parse from point to the gap or the end of the accessible
+ portion, whatever is closer. */
+ ptrdiff_t point = d->point;
+ ptrdiff_t end;
+ {
+ bool overflow = INT_ADD_WRAPV (BUFFER_CEILING_OF (point), 1, &end);
+ eassert (!overflow);
+ }
+ size_t count;
+ {
+ bool overflow = INT_SUBTRACT_WRAPV (end, point, &count);
+ eassert (!overflow);
+ }
+ if (buflen < count)
+ count = buflen;
+ memcpy (buffer, BYTE_POS_ADDR (point), count);
+ {
+ bool overflow = INT_ADD_WRAPV (d->point, count, &d->point);
+ eassert (!overflow);
+ }
+ return count;
+}
+
+DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
+ 0, 0, NULL,
+ doc: /* Read JSON object from current buffer starting at point.
+This is similar to `json-parse-string', which see. Move point after
+the end of the object if parsing was successful. On error, point is
+not moved. */)
+ (void)
+{
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ 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);
+
+ if (object == NULL)
+ json_parse_error (&error);
+
+ /* Avoid leaking the object in case of further errors. */
+ record_unwind_protect_ptr (json_release_object, object);
+
+ /* Convert and then move point only if everything succeeded. */
+ Lisp_Object lisp = json_to_lisp (object);
+
+ {
+ /* Adjust point by how much we just read. Do this here because
+ tokener->char_offset becomes incorrect below. */
+ bool overflow = INT_ADD_WRAPV (point, error.position, &point);
+ eassert (!overflow);
+ eassert (point <= ZV_BYTE);
+ SET_PT_BOTH (BYTE_TO_CHAR (point), point);
+ }
+
+ return unbind_to (count, lisp);
+}
+
+/* Simplified version of ‘define-error’ that works with pure
+ objects. */
+
+static void
+define_error (Lisp_Object name, const char *message, Lisp_Object parent)
+{
+ eassert (SYMBOLP (name));
+ eassert (SYMBOLP (parent));
+ Lisp_Object parent_conditions = Fget (parent, Qerror_conditions);
+ eassert (CONSP (parent_conditions));
+ eassert (!NILP (Fmemq (parent, parent_conditions)));
+ eassert (NILP (Fmemq (name, parent_conditions)));
+ Fput (name, Qerror_conditions, pure_cons (name, parent_conditions));
+ Fput (name, Qerror_message, build_pure_c_string (message));
+}
+
+void
+syms_of_json (void)
+{
+ DEFSYM (QCjson_false, ":json-false");
+
+ DEFSYM (Qstring_without_embedded_nulls_p, "string-without-embedded-nulls-p");
+ DEFSYM (Qjson_value_p, "json-value-p");
+
+ DEFSYM (Qjson_error, "json-error");
+ DEFSYM (Qjson_out_of_memory, "json-out-of-memory");
+ DEFSYM (Qjson_parse_error, "json-parse-error");
+ DEFSYM (Qjson_object_too_deep, "json-object-too-deep");
+ define_error (Qjson_error, "generic JSON error", Qerror);
+ define_error (Qjson_out_of_memory, "no free memory for creating JSON object",
+ Qjson_error);
+ define_error (Qjson_parse_error, "could not parse JSON stream",
+ Qjson_error);
+ define_error (Qjson_object_too_deep, "object cyclic or too deep",
+ Qjson_error);
+
+ DEFSYM (Qpure, "pure");
+ DEFSYM (Qside_effect_free, "side-effect-free");
+
+ DEFSYM (Qjson_serialize, "json-serialize");
+ DEFSYM (Qjson_parse_string, "json-parse-string");
+ Fput (Qjson_serialize, Qpure, Qt);
+ Fput (Qjson_serialize, Qside_effect_free, Qt);
+ Fput (Qjson_parse_string, Qpure, Qt);
+ Fput (Qjson_parse_string, Qside_effect_free, Qt);
+
+ defsubr (&Sjson_serialize);
+ defsubr (&Sjson_insert);
+ defsubr (&Sjson_parse_string);
+ defsubr (&Sjson_parse_buffer);
+}
diff --git a/src/lisp.h b/src/lisp.h
index c503082442..8d485098ac 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3440,6 +3440,11 @@ extern int x_bitmap_mask (struct frame *, ptrdiff_t);
extern void reset_image_types (void);
extern void syms_of_image (void);
+#ifdef HAVE_JSON
+/* Defined in json.c. */
+extern void syms_of_json (void);
+#endif
+
/* Defined in insdel.c. */
extern void move_gap_both (ptrdiff_t, ptrdiff_t);
extern _Noreturn void buffer_overflow (void);
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
new file mode 100644
index 0000000000..1d8f9a490b
--- /dev/null
+++ b/test/src/json-tests.el
@@ -0,0 +1,61 @@
+;;; json-tests.el --- unit tests for json.c -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for src/json.c.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'map)
+
+(ert-deftest json-serialize/roundtrip ()
+ (let ((lisp [nil :json-false t 0 123 -456 3.75 "foo"])
+ (json "[null,false,true,0,123,-456,3.75,\"foo\"]"))
+ (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 ()
+ (let ((table (make-hash-table :test #'equal)))
+ (puthash "abc" [1 2 t] table)
+ (puthash "def" nil table)
+ (should (equal (json-serialize table)
+ "{\"abc\":[1,2,true],\"def\":null}"))))
+
+(ert-deftest json-parse-string/object ()
+ (let ((actual
+ (json-parse-string
+ "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n")))
+ (should (hash-table-p actual))
+ (should (equal (hash-table-count actual) 2))
+ (should (equal (cl-sort (map-pairs actual) #'string< :key #'car)
+ '(("abc" . [9 :json-false]) ("def"))))))
+
+(provide 'json-tests)
+;;; json-tests.el ends here
--
2.14.1
next prev parent reply other threads:[~2017-09-18 13:26 UTC|newest]
Thread overview: 81+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-09-16 15:54 JSON/YAML/TOML/etc. parsing performance Ted Zlatanov
2017-09-16 16:02 ` Mark Oteiza
2017-09-17 0:02 ` Richard Stallman
2017-09-17 3:13 ` Mark Oteiza
2017-09-18 0:00 ` Richard Stallman
2017-09-17 0:02 ` Richard Stallman
2017-09-18 13:46 ` Ted Zlatanov
2017-09-17 18:46 ` Philipp Stephani
2017-09-17 19:05 ` Eli Zaretskii
2017-09-17 20:27 ` Philipp Stephani
2017-09-17 22:41 ` Mark Oteiza
2017-09-18 13:53 ` Ted Zlatanov
2017-09-17 21:17 ` Speed of Elisp (was: JSON/YAML/TOML/etc. parsing performance) Stefan Monnier
2017-09-18 13:26 ` Philipp Stephani [this message]
2017-09-18 13:58 ` JSON/YAML/TOML/etc. parsing performance Mark Oteiza
2017-09-18 14:14 ` Philipp Stephani
2017-09-18 14:28 ` Mark Oteiza
2017-09-18 14:36 ` Philipp Stephani
2017-09-18 15:02 ` Eli Zaretskii
2017-09-18 16:14 ` Philipp Stephani
2017-09-18 17:33 ` Eli Zaretskii
2017-09-18 19:57 ` Thien-Thi Nguyen
2017-09-18 14:57 ` Eli Zaretskii
2017-09-18 15:07 ` Mark Oteiza
2017-09-18 15:51 ` Eli Zaretskii
2017-09-18 16:22 ` Philipp Stephani
2017-09-18 18:08 ` Eli Zaretskii
2017-09-19 19:32 ` Richard Stallman
2017-09-18 17:26 ` Glenn Morris
2017-09-18 18:16 ` Eli Zaretskii
2017-09-18 16:08 ` Philipp Stephani
2017-09-19 8:18 ` Philipp Stephani
2017-09-19 19:09 ` Eli Zaretskii
2017-09-28 21:19 ` Philipp Stephani
2017-09-28 21:27 ` Stefan Monnier
2017-09-29 19:55 ` Eli Zaretskii
2017-09-30 22:02 ` Philipp Stephani
2017-10-01 18:06 ` Eli Zaretskii
2017-10-03 12:26 ` Philipp Stephani
2017-10-03 15:31 ` Eli Zaretskii
2017-10-03 15:52 ` Philipp Stephani
2017-10-03 16:26 ` Eli Zaretskii
2017-10-03 17:10 ` Eli Zaretskii
2017-10-03 18:37 ` Philipp Stephani
2017-10-03 20:52 ` Paul Eggert
2017-10-04 5:33 ` Eli Zaretskii
2017-10-04 6:41 ` Paul Eggert
2017-10-04 8:03 ` Eli Zaretskii
2017-10-04 17:51 ` Paul Eggert
2017-10-04 19:38 ` Eli Zaretskii
2017-10-04 21:24 ` Paul Eggert
2017-10-05 1:48 ` Paul Eggert
2017-10-05 7:14 ` Eli Zaretskii
2017-10-08 22:52 ` Philipp Stephani
2017-10-09 5:54 ` Paul Eggert
2017-10-29 20:48 ` Philipp Stephani
2017-10-09 6:38 ` Eli Zaretskii
2017-10-05 7:12 ` Eli Zaretskii
2017-10-06 1:58 ` Paul Eggert
2017-10-06 7:40 ` Eli Zaretskii
2017-10-06 19:36 ` Paul Eggert
2017-10-06 21:03 ` Eli Zaretskii
2017-10-08 23:09 ` Philipp Stephani
2017-10-09 6:19 ` Paul Eggert
2017-10-29 20:48 ` Philipp Stephani
2017-10-29 22:49 ` Philipp Stephani
2017-12-09 23:05 ` Philipp Stephani
2017-12-10 7:08 ` Eli Zaretskii
2017-12-10 13:26 ` Philipp Stephani
2017-12-10 13:32 ` Ted Zlatanov
2017-10-08 23:04 ` Philipp Stephani
2017-10-09 6:47 ` Eli Zaretskii
2017-10-08 17:58 ` Philipp Stephani
2017-10-08 18:42 ` Eli Zaretskii
2017-10-08 23:14 ` Philipp Stephani
2017-10-09 6:53 ` Eli Zaretskii
2017-10-29 20:41 ` Philipp Stephani
2017-10-09 6:22 ` Paul Eggert
2017-10-01 18:38 ` Eli Zaretskii
2017-10-03 12:12 ` Philipp Stephani
2017-10-03 14:54 ` Eli Zaretskii
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAArVCkTj_1P+fTDCzEY5xG8bBB7B6ctNkQCv+bAxt=N_cuD05Q@mail.gmail.com' \
--to=p.stephani2@gmail.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.