diff options
| author | Philipp Stephani | 2017-09-18 18:00:45 +0200 |
|---|---|---|
| committer | Philipp Stephani | 2017-09-18 18:00:45 +0200 |
| commit | 0925a20e0a48bc5ff8e9bad6ca4aa0a4c91fdc3c (patch) | |
| tree | 504d5533ad5177b4156dcc691cffc62ba510ee3e | |
| parent | cb99cf5a99680af7dc2c49fdf5b840d1ff4dd928 (diff) | |
| download | emacs-0925a20e0a48bc5ff8e9bad6ca4aa0a4c91fdc3c.tar.gz emacs-0925a20e0a48bc5ff8e9bad6ca4aa0a4c91fdc3c.zip | |
Revert "Implement native JSON support using Jansson"
This reverts commit cb99cf5a99680af7dc2c49fdf5b840d1ff4dd928.
| -rw-r--r-- | configure.ac | 20 | ||||
| -rw-r--r-- | src/Makefile.in | 11 | ||||
| -rw-r--r-- | src/emacs.c | 4 | ||||
| -rw-r--r-- | src/json.c | 469 | ||||
| -rw-r--r-- | src/lisp.h | 5 | ||||
| -rw-r--r-- | test/src/json-tests.el | 61 |
6 files changed, 4 insertions, 566 deletions
diff --git a/configure.ac b/configure.ac index c9ce5ee1205..35b7e69daf0 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -348,7 +348,6 @@ OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support]) | |||
| 348 | OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)]) | 348 | OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)]) |
| 349 | OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) | 349 | OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) |
| 350 | OPTION_DEFAULT_ON([imagemagick],[don't compile with ImageMagick image support]) | 350 | OPTION_DEFAULT_ON([imagemagick],[don't compile with ImageMagick image support]) |
| 351 | OPTION_DEFAULT_ON([json], [don't compile with native JSON support]) | ||
| 352 | 351 | ||
| 353 | OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) | 352 | OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) |
| 354 | OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support]) | 353 | OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support]) |
| @@ -2857,22 +2856,6 @@ fi | |||
| 2857 | AC_SUBST(LIBSYSTEMD_LIBS) | 2856 | AC_SUBST(LIBSYSTEMD_LIBS) |
| 2858 | AC_SUBST(LIBSYSTEMD_CFLAGS) | 2857 | AC_SUBST(LIBSYSTEMD_CFLAGS) |
| 2859 | 2858 | ||
| 2860 | HAVE_JSON=no | ||
| 2861 | JSON_OBJ= | ||
| 2862 | |||
| 2863 | if test "${with_json}" = yes; then | ||
| 2864 | EMACS_CHECK_MODULES([JSON], [jansson >= 2.5], | ||
| 2865 | [HAVE_JSON=yes], [HAVE_JSON=no]) | ||
| 2866 | if test "${HAVE_JSON}" = yes; then | ||
| 2867 | AC_DEFINE(HAVE_JSON, 1, [Define if using Jansson.]) | ||
| 2868 | JSON_OBJ=json.o | ||
| 2869 | fi | ||
| 2870 | fi | ||
| 2871 | |||
| 2872 | AC_SUBST(JSON_LIBS) | ||
| 2873 | AC_SUBST(JSON_CFLAGS) | ||
| 2874 | AC_SUBST(JSON_OBJ) | ||
| 2875 | |||
| 2876 | NOTIFY_OBJ= | 2859 | NOTIFY_OBJ= |
| 2877 | NOTIFY_SUMMARY=no | 2860 | NOTIFY_SUMMARY=no |
| 2878 | 2861 | ||
| @@ -5385,7 +5368,7 @@ emacs_config_features= | |||
| 5385 | for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ | 5368 | for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ |
| 5386 | GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ | 5369 | GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ |
| 5387 | LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \ | 5370 | LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \ |
| 5388 | XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2; do | 5371 | XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do |
| 5389 | 5372 | ||
| 5390 | case $opt in | 5373 | case $opt in |
| 5391 | CANNOT_DUMP) eval val=\${$opt} ;; | 5374 | CANNOT_DUMP) eval val=\${$opt} ;; |
| @@ -5435,7 +5418,6 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D | |||
| 5435 | Does Emacs use -lotf? ${HAVE_LIBOTF} | 5418 | Does Emacs use -lotf? ${HAVE_LIBOTF} |
| 5436 | Does Emacs use -lxft? ${HAVE_XFT} | 5419 | Does Emacs use -lxft? ${HAVE_XFT} |
| 5437 | Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD} | 5420 | Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD} |
| 5438 | Does Emacs use -ljanssoon? ${HAVE_JSON} | ||
| 5439 | Does Emacs directly use zlib? ${HAVE_ZLIB} | 5421 | Does Emacs directly use zlib? ${HAVE_ZLIB} |
| 5440 | Does Emacs have dynamic modules support? ${HAVE_MODULES} | 5422 | Does Emacs have dynamic modules support? ${HAVE_MODULES} |
| 5441 | Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS} | 5423 | Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS} |
diff --git a/src/Makefile.in b/src/Makefile.in index 4d33682629e..0e55ad4bb29 100644 --- a/src/Makefile.in +++ b/src/Makefile.in | |||
| @@ -312,10 +312,6 @@ LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@ | |||
| 312 | LIBSYSTEMD_LIBS = @LIBSYSTEMD_LIBS@ | 312 | LIBSYSTEMD_LIBS = @LIBSYSTEMD_LIBS@ |
| 313 | LIBSYSTEMD_CFLAGS = @LIBSYSTEMD_CFLAGS@ | 313 | LIBSYSTEMD_CFLAGS = @LIBSYSTEMD_CFLAGS@ |
| 314 | 314 | ||
| 315 | JSON_LIBS = @JSON_LIBS@ | ||
| 316 | JSON_CFLAGS = @JSON_CFLAGS@ | ||
| 317 | JSON_OBJ = @JSON_OBJ@ | ||
| 318 | |||
| 319 | INTERVALS_H = dispextern.h intervals.h composite.h | 315 | INTERVALS_H = dispextern.h intervals.h composite.h |
| 320 | 316 | ||
| 321 | GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ | 317 | GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ |
| @@ -367,7 +363,7 @@ EMACS_CFLAGS=-Demacs $(MYCPPFLAGS) -I. -I$(srcdir) \ | |||
| 367 | $(WEBKIT_CFLAGS) \ | 363 | $(WEBKIT_CFLAGS) \ |
| 368 | $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ | 364 | $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ |
| 369 | $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ | 365 | $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) \ |
| 370 | $(LIBSYSTEMD_CFLAGS) $(JSON_CFLAGS) \ | 366 | $(LIBSYSTEMD_CFLAGS) \ |
| 371 | $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ | 367 | $(LIBGNUTLS_CFLAGS) $(NOTIFY_CFLAGS) $(CAIRO_CFLAGS) \ |
| 372 | $(WERROR_CFLAGS) | 368 | $(WERROR_CFLAGS) |
| 373 | ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS) | 369 | ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS) |
| @@ -401,7 +397,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ | |||
| 401 | thread.o systhread.o \ | 397 | thread.o systhread.o \ |
| 402 | $(if $(HYBRID_MALLOC),sheap.o) \ | 398 | $(if $(HYBRID_MALLOC),sheap.o) \ |
| 403 | $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ | 399 | $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ |
| 404 | $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) | 400 | $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) |
| 405 | obj = $(base_obj) $(NS_OBJC_OBJ) | 401 | obj = $(base_obj) $(NS_OBJC_OBJ) |
| 406 | 402 | ||
| 407 | ## Object files used on some machine or other. | 403 | ## Object files used on some machine or other. |
| @@ -497,8 +493,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ | |||
| 497 | $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ | 493 | $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ |
| 498 | $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ | 494 | $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ |
| 499 | $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \ | 495 | $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \ |
| 500 | $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \ | 496 | $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) |
| 501 | $(JSON_LIBS) | ||
| 502 | 497 | ||
| 503 | ## FORCE it so that admin/unidata can decide whether these files | 498 | ## FORCE it so that admin/unidata can decide whether these files |
| 504 | ## are up-to-date. Although since charprop depends on bootstrap-emacs, | 499 | ## are up-to-date. Although since charprop depends on bootstrap-emacs, |
diff --git a/src/emacs.c b/src/emacs.c index eb5f1128f6e..1ad8af70a74 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -1610,10 +1610,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem | |||
| 1610 | syms_of_threads (); | 1610 | syms_of_threads (); |
| 1611 | syms_of_profiler (); | 1611 | syms_of_profiler (); |
| 1612 | 1612 | ||
| 1613 | #ifdef HAVE_JSON | ||
| 1614 | syms_of_json (); | ||
| 1615 | #endif | ||
| 1616 | |||
| 1617 | keys_of_casefiddle (); | 1613 | keys_of_casefiddle (); |
| 1618 | keys_of_cmds (); | 1614 | keys_of_cmds (); |
| 1619 | keys_of_buffer (); | 1615 | keys_of_buffer (); |
diff --git a/src/json.c b/src/json.c deleted file mode 100644 index 85abf87e214..00000000000 --- a/src/json.c +++ /dev/null | |||
| @@ -1,469 +0,0 @@ | |||
| 1 | /* JSON parsing and serialization. | ||
| 2 | |||
| 3 | Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | GNU Emacs is free software: you can redistribute it and/or modify | ||
| 8 | it under the terms of the GNU General Public License as published by | ||
| 9 | the Free Software Foundation, either version 3 of the License, or (at | ||
| 10 | your option) any later version. | ||
| 11 | |||
| 12 | GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | GNU General Public License for more details. | ||
| 16 | |||
| 17 | You should have received a copy of the GNU General Public License | ||
| 18 | along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | ||
| 19 | |||
| 20 | #include <config.h> | ||
| 21 | |||
| 22 | #include <stddef.h> | ||
| 23 | #include <stdint.h> | ||
| 24 | |||
| 25 | #include <jansson.h> | ||
| 26 | |||
| 27 | #include "lisp.h" | ||
| 28 | #include "buffer.h" | ||
| 29 | |||
| 30 | static _Noreturn void | ||
| 31 | json_out_of_memory (void) | ||
| 32 | { | ||
| 33 | xsignal0 (Qjson_out_of_memory); | ||
| 34 | } | ||
| 35 | |||
| 36 | static _Noreturn void | ||
| 37 | json_parse_error (const json_error_t *error) | ||
| 38 | { | ||
| 39 | xsignal (Qjson_parse_error, | ||
| 40 | list5 (build_string (error->text), build_string (error->source), | ||
| 41 | make_natnum (error->line), make_natnum (error->column), | ||
| 42 | make_natnum (error->position))); | ||
| 43 | } | ||
| 44 | |||
| 45 | static void | ||
| 46 | json_release_object (void *object) | ||
| 47 | { | ||
| 48 | json_decref (object); | ||
| 49 | } | ||
| 50 | |||
| 51 | static void | ||
| 52 | check_string_without_embedded_nulls (Lisp_Object object) | ||
| 53 | { | ||
| 54 | CHECK_STRING (object); | ||
| 55 | CHECK_TYPE (memchr (SDATA (object), '\0', SBYTES (object)) == NULL, | ||
| 56 | Qstring_without_embedded_nulls_p, object); | ||
| 57 | } | ||
| 58 | |||
| 59 | static json_t * | ||
| 60 | json_check (json_t *object) | ||
| 61 | { | ||
| 62 | if (object == NULL) | ||
| 63 | json_out_of_memory (); | ||
| 64 | return object; | ||
| 65 | } | ||
| 66 | |||
| 67 | /* This returns Lisp_Object so we can use unbind_to. The return value | ||
| 68 | is always nil. */ | ||
| 69 | |||
| 70 | static Lisp_Object | ||
| 71 | lisp_to_json (Lisp_Object lisp, json_t **json) | ||
| 72 | { | ||
| 73 | if (NILP (lisp)) | ||
| 74 | { | ||
| 75 | *json =json_check (json_null ()); | ||
| 76 | return Qnil; | ||
| 77 | } | ||
| 78 | else if (EQ (lisp, QCjson_false)) | ||
| 79 | { | ||
| 80 | *json = json_check (json_false ()); | ||
| 81 | return Qnil; | ||
| 82 | } | ||
| 83 | else if (EQ (lisp, Qt)) | ||
| 84 | { | ||
| 85 | *json = json_check (json_true ()); | ||
| 86 | return Qnil; | ||
| 87 | } | ||
| 88 | else if (INTEGERP (lisp)) | ||
| 89 | { | ||
| 90 | CHECK_TYPE_RANGED_INTEGER (json_int_t, lisp); | ||
| 91 | *json = json_check (json_integer (XINT (lisp))); | ||
| 92 | return Qnil; | ||
| 93 | } | ||
| 94 | else if (FLOATP (lisp)) | ||
| 95 | { | ||
| 96 | *json = json_check (json_real (XFLOAT_DATA (lisp))); | ||
| 97 | return Qnil; | ||
| 98 | } | ||
| 99 | else if (STRINGP (lisp)) | ||
| 100 | { | ||
| 101 | ptrdiff_t size = SBYTES (lisp); | ||
| 102 | eassert (size >= 0); | ||
| 103 | if (size > SIZE_MAX) | ||
| 104 | xsignal1 (Qoverflow_error, build_pure_c_string ("string is too long")); | ||
| 105 | *json = json_check (json_stringn (SSDATA (lisp), size)); | ||
| 106 | return Qnil; | ||
| 107 | } | ||
| 108 | else if (VECTORP (lisp)) | ||
| 109 | { | ||
| 110 | if (++lisp_eval_depth > max_lisp_eval_depth) | ||
| 111 | xsignal0 (Qjson_object_too_deep); | ||
| 112 | ptrdiff_t size = ASIZE (lisp); | ||
| 113 | eassert (size >= 0); | ||
| 114 | if (size > SIZE_MAX) | ||
| 115 | xsignal1 (Qoverflow_error, build_pure_c_string ("vector is too long")); | ||
| 116 | *json = json_check (json_array ()); | ||
| 117 | ptrdiff_t count = SPECPDL_INDEX (); | ||
| 118 | record_unwind_protect_ptr (json_release_object, json); | ||
| 119 | for (ptrdiff_t i = 0; i < size; ++i) | ||
| 120 | { | ||
| 121 | json_t *element; | ||
| 122 | lisp_to_json (AREF (lisp, i), &element); | ||
| 123 | int status = json_array_append_new (*json, element); | ||
| 124 | if (status == -1) | ||
| 125 | json_out_of_memory (); | ||
| 126 | eassert (status == 0); | ||
| 127 | } | ||
| 128 | eassert (json_array_size (*json) == size); | ||
| 129 | clear_unwind_protect (count); | ||
| 130 | --lisp_eval_depth; | ||
| 131 | return unbind_to (count, Qnil); | ||
| 132 | } | ||
| 133 | else if (HASH_TABLE_P (lisp)) | ||
| 134 | { | ||
| 135 | if (++lisp_eval_depth > max_lisp_eval_depth) | ||
| 136 | xsignal0 (Qjson_object_too_deep); | ||
| 137 | struct Lisp_Hash_Table *h = XHASH_TABLE (lisp); | ||
| 138 | *json = json_check (json_object ()); | ||
| 139 | ptrdiff_t count = SPECPDL_INDEX (); | ||
| 140 | record_unwind_protect_ptr (json_release_object, *json); | ||
| 141 | for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i) | ||
| 142 | if (!NILP (HASH_HASH (h, i))) | ||
| 143 | { | ||
| 144 | Lisp_Object key = HASH_KEY (h, i); | ||
| 145 | /* We can’t specify the length, so the string must be | ||
| 146 | null-terminated. */ | ||
| 147 | check_string_without_embedded_nulls (key); | ||
| 148 | json_t *value; | ||
| 149 | lisp_to_json (HASH_VALUE (h, i), &value); | ||
| 150 | int status = json_object_set_new (*json, SSDATA (key), value); | ||
| 151 | if (status == -1) | ||
| 152 | json_out_of_memory (); | ||
| 153 | eassert (status == 0); | ||
| 154 | } | ||
| 155 | clear_unwind_protect (count); | ||
| 156 | --lisp_eval_depth; | ||
| 157 | return unbind_to (count, Qnil); | ||
| 158 | } | ||
| 159 | wrong_type_argument (Qjson_value_p, lisp); | ||
| 160 | } | ||
| 161 | |||
| 162 | DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, 1, NULL, | ||
| 163 | doc: /* Return the JSON representation of OBJECT as a string. | ||
| 164 | OBJECT must be a vector or hashtable, and its elements can recursively | ||
| 165 | contain nil, t, `:json-false', numbers, strings, or other vectors and | ||
| 166 | hashtables. nil, t, and `:json-false' will be converted to JSON null, | ||
| 167 | true, and false values, respectively. Vectors will be converted to | ||
| 168 | JSON arrays, and hashtables to JSON objects. Hashtable keys must be | ||
| 169 | strings without embedded null characters and must be unique within | ||
| 170 | each object. */) | ||
| 171 | (Lisp_Object object) | ||
| 172 | { | ||
| 173 | ptrdiff_t count = SPECPDL_INDEX (); | ||
| 174 | |||
| 175 | json_t *json; | ||
| 176 | lisp_to_json (object, &json); | ||
| 177 | record_unwind_protect_ptr (json_release_object, json); | ||
| 178 | |||
| 179 | char *string = json_dumps (json, JSON_COMPACT); | ||
| 180 | if (string == NULL) | ||
| 181 | json_out_of_memory (); | ||
| 182 | record_unwind_protect_ptr (free, string); | ||
| 183 | |||
| 184 | return unbind_to (count, build_string (string)); | ||
| 185 | } | ||
| 186 | |||
| 187 | struct json_buffer_and_size | ||
| 188 | { | ||
| 189 | const char *buffer; | ||
| 190 | size_t size; | ||
| 191 | }; | ||
| 192 | |||
| 193 | static Lisp_Object | ||
| 194 | json_insert (Lisp_Object data) | ||
| 195 | { | ||
| 196 | const struct json_buffer_and_size *buffer_and_size = XSAVE_POINTER (data, 0); | ||
| 197 | if (FIXNUM_OVERFLOW_P (buffer_and_size->size)) | ||
| 198 | xsignal1 (Qoverflow_error, build_pure_c_string ("buffer too large")); | ||
| 199 | Lisp_Object string | ||
| 200 | = make_string (buffer_and_size->buffer, buffer_and_size->size); | ||
| 201 | insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), false); | ||
| 202 | return Qnil; | ||
| 203 | } | ||
| 204 | |||
| 205 | struct json_insert_data | ||
| 206 | { | ||
| 207 | /* nil if json_insert succeeded, otherwise a cons | ||
| 208 | (ERROR-SYMBOL . ERROR-DATA). */ | ||
| 209 | Lisp_Object error; | ||
| 210 | }; | ||
| 211 | |||
| 212 | static int | ||
| 213 | json_insert_callback (const char *buffer, size_t size, void *data) | ||
| 214 | { | ||
| 215 | /* This function may not exit nonlocally. */ | ||
| 216 | struct json_insert_data *d = data; | ||
| 217 | struct json_buffer_and_size buffer_and_size | ||
| 218 | = {.buffer = buffer, .size = size}; | ||
| 219 | d->error | ||
| 220 | = internal_condition_case_1 (json_insert, make_save_ptr (&buffer_and_size), | ||
| 221 | Qt, Fidentity); | ||
| 222 | return 0; | ||
| 223 | } | ||
| 224 | |||
| 225 | DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL, | ||
| 226 | doc: /* Insert the JSON representation of OBJECT before point. | ||
| 227 | This is the same as (insert (json-serialize OBJECT)), but potentially | ||
| 228 | faster. See the function `json-serialize' for allowed values of | ||
| 229 | OBJECT. */) | ||
| 230 | (Lisp_Object object) | ||
| 231 | { | ||
| 232 | ptrdiff_t count = SPECPDL_INDEX (); | ||
| 233 | |||
| 234 | json_t *json; | ||
| 235 | lisp_to_json (object, &json); | ||
| 236 | record_unwind_protect_ptr (json_release_object, json); | ||
| 237 | |||
| 238 | struct json_insert_data data; | ||
| 239 | int status | ||
| 240 | = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT); | ||
| 241 | if (status == -1) | ||
| 242 | json_out_of_memory (); | ||
| 243 | eassert (status == 0); | ||
| 244 | |||
| 245 | if (!NILP (data.error)) | ||
| 246 | xsignal (XCAR (data.error), XCDR (data.error)); | ||
| 247 | |||
| 248 | return unbind_to (count, Qnil); | ||
| 249 | } | ||
| 250 | |||
| 251 | static Lisp_Object | ||
| 252 | json_to_lisp (json_t *json) | ||
| 253 | { | ||
| 254 | switch (json_typeof (json)) | ||
| 255 | { | ||
| 256 | case JSON_NULL: | ||
| 257 | return Qnil; | ||
| 258 | case JSON_FALSE: | ||
| 259 | return QCjson_false; | ||
| 260 | case JSON_TRUE: | ||
| 261 | return Qt; | ||
| 262 | case JSON_INTEGER: | ||
| 263 | { | ||
| 264 | json_int_t value = json_integer_value (json); | ||
| 265 | if (FIXNUM_OVERFLOW_P (value)) | ||
| 266 | xsignal1 (Qoverflow_error, | ||
| 267 | build_pure_c_string ("JSON integer is too large")); | ||
| 268 | return make_number (value); | ||
| 269 | } | ||
| 270 | case JSON_REAL: | ||
| 271 | return make_float (json_real_value (json)); | ||
| 272 | case JSON_STRING: | ||
| 273 | { | ||
| 274 | size_t size = json_string_length (json); | ||
| 275 | if (FIXNUM_OVERFLOW_P (size)) | ||
| 276 | xsignal1 (Qoverflow_error, | ||
| 277 | build_pure_c_string ("JSON string is too long")); | ||
| 278 | return make_string (json_string_value (json), size); | ||
| 279 | } | ||
| 280 | case JSON_ARRAY: | ||
| 281 | { | ||
| 282 | if (++lisp_eval_depth > max_lisp_eval_depth) | ||
| 283 | xsignal0 (Qjson_object_too_deep); | ||
| 284 | size_t size = json_array_size (json); | ||
| 285 | if (FIXNUM_OVERFLOW_P (size)) | ||
| 286 | xsignal1 (Qoverflow_error, | ||
| 287 | build_pure_c_string ("JSON array is too long")); | ||
| 288 | Lisp_Object result = Fmake_vector (make_natnum (size), Qunbound); | ||
| 289 | for (ptrdiff_t i = 0; i < size; ++i) | ||
| 290 | ASET (result, i, | ||
| 291 | json_to_lisp (json_array_get (json, i))); | ||
| 292 | --lisp_eval_depth; | ||
| 293 | return result; | ||
| 294 | } | ||
| 295 | case JSON_OBJECT: | ||
| 296 | { | ||
| 297 | if (++lisp_eval_depth > max_lisp_eval_depth) | ||
| 298 | xsignal0 (Qjson_object_too_deep); | ||
| 299 | size_t size = json_object_size (json); | ||
| 300 | if (FIXNUM_OVERFLOW_P (size)) | ||
| 301 | xsignal1 (Qoverflow_error, | ||
| 302 | build_pure_c_string ("JSON object has too many elements")); | ||
| 303 | Lisp_Object result = CALLN (Fmake_hash_table, QCtest, Qequal, | ||
| 304 | QCsize, make_natnum (size)); | ||
| 305 | struct Lisp_Hash_Table *h = XHASH_TABLE (result); | ||
| 306 | const char *key_str; | ||
| 307 | json_t *value; | ||
| 308 | json_object_foreach (json, key_str, value) | ||
| 309 | { | ||
| 310 | Lisp_Object key = build_string (key_str); | ||
| 311 | EMACS_UINT hash; | ||
| 312 | ptrdiff_t i = hash_lookup (h, key, &hash); | ||
| 313 | eassert (i < 0); | ||
| 314 | hash_put (h, key, json_to_lisp (value), hash); | ||
| 315 | } | ||
| 316 | --lisp_eval_depth; | ||
| 317 | return result; | ||
| 318 | } | ||
| 319 | } | ||
| 320 | /* Can’t get here. */ | ||
| 321 | emacs_abort (); | ||
| 322 | } | ||
| 323 | |||
| 324 | DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, 1, NULL, | ||
| 325 | doc: /* Parse the JSON STRING into a Lisp object. | ||
| 326 | This is essentially the reverse operation of `json-serialize', which | ||
| 327 | see. The returned object will be a vector or hashtable. Its elements | ||
| 328 | will be nil, t, `:json-false', numbers, strings, or further vectors | ||
| 329 | and hashtables. If there are duplicate keys in an object, all but the | ||
| 330 | last one are ignored. If STRING doesn't contain a valid JSON object, | ||
| 331 | an error of type `json-parse-error' is signaled. */) | ||
| 332 | (Lisp_Object string) | ||
| 333 | { | ||
| 334 | ptrdiff_t count = SPECPDL_INDEX (); | ||
| 335 | check_string_without_embedded_nulls (string); | ||
| 336 | |||
| 337 | json_error_t error; | ||
| 338 | json_t *object = json_loads (SSDATA (string), 0, &error); | ||
| 339 | if (object == NULL) | ||
| 340 | json_parse_error (&error); | ||
| 341 | |||
| 342 | /* Avoid leaking the object in case of further errors. */ | ||
| 343 | if (object != NULL) | ||
| 344 | record_unwind_protect_ptr (json_release_object, object); | ||
| 345 | |||
| 346 | return unbind_to (count, json_to_lisp (object)); | ||
| 347 | } | ||
| 348 | |||
| 349 | struct json_read_buffer_data | ||
| 350 | { | ||
| 351 | ptrdiff_t point; | ||
| 352 | }; | ||
| 353 | |||
| 354 | static size_t | ||
| 355 | json_read_buffer_callback (void *buffer, size_t buflen, void *data) | ||
| 356 | { | ||
| 357 | struct json_read_buffer_data *d = data; | ||
| 358 | |||
| 359 | /* First, parse from point to the gap or the end of the accessible | ||
| 360 | portion, whatever is closer. */ | ||
| 361 | ptrdiff_t point = d->point; | ||
| 362 | ptrdiff_t end; | ||
| 363 | { | ||
| 364 | bool overflow = INT_ADD_WRAPV (BUFFER_CEILING_OF (point), 1, &end); | ||
| 365 | eassert (!overflow); | ||
| 366 | } | ||
| 367 | size_t count; | ||
| 368 | { | ||
| 369 | bool overflow = INT_SUBTRACT_WRAPV (end, point, &count); | ||
| 370 | eassert (!overflow); | ||
| 371 | } | ||
| 372 | if (buflen < count) | ||
| 373 | count = buflen; | ||
| 374 | memcpy (buffer, BYTE_POS_ADDR (point), count); | ||
| 375 | { | ||
| 376 | bool overflow = INT_ADD_WRAPV (d->point, count, &d->point); | ||
| 377 | eassert (!overflow); | ||
| 378 | } | ||
| 379 | return count; | ||
| 380 | } | ||
| 381 | |||
| 382 | DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer, | ||
| 383 | 0, 0, NULL, | ||
| 384 | doc: /* Read JSON object from current buffer starting at point. | ||
| 385 | This is similar to `json-parse-string', which see. Move point after | ||
| 386 | the end of the object if parsing was successful. On error, point is | ||
| 387 | not moved. */) | ||
| 388 | (void) | ||
| 389 | { | ||
| 390 | ptrdiff_t count = SPECPDL_INDEX (); | ||
| 391 | |||
| 392 | ptrdiff_t point = PT_BYTE; | ||
| 393 | struct json_read_buffer_data data = {.point = point}; | ||
| 394 | json_error_t error; | ||
| 395 | json_t *object = json_load_callback (json_read_buffer_callback, &data, | ||
| 396 | JSON_DISABLE_EOF_CHECK, &error); | ||
| 397 | |||
| 398 | if (object == NULL) | ||
| 399 | json_parse_error (&error); | ||
| 400 | |||
| 401 | /* Avoid leaking the object in case of further errors. */ | ||
| 402 | record_unwind_protect_ptr (json_release_object, object); | ||
| 403 | |||
| 404 | /* Convert and then move point only if everything succeeded. */ | ||
| 405 | Lisp_Object lisp = json_to_lisp (object); | ||
| 406 | |||
| 407 | { | ||
| 408 | /* Adjust point by how much we just read. Do this here because | ||
| 409 | tokener->char_offset becomes incorrect below. */ | ||
| 410 | bool overflow = INT_ADD_WRAPV (point, error.position, &point); | ||
| 411 | eassert (!overflow); | ||
| 412 | eassert (point <= ZV_BYTE); | ||
| 413 | SET_PT_BOTH (BYTE_TO_CHAR (point), point); | ||
| 414 | } | ||
| 415 | |||
| 416 | return unbind_to (count, lisp); | ||
| 417 | } | ||
| 418 | |||
| 419 | /* Simplified version of ‘define-error’ that works with pure | ||
| 420 | objects. */ | ||
| 421 | |||
| 422 | static void | ||
| 423 | define_error (Lisp_Object name, const char *message, Lisp_Object parent) | ||
| 424 | { | ||
| 425 | eassert (SYMBOLP (name)); | ||
| 426 | eassert (SYMBOLP (parent)); | ||
| 427 | Lisp_Object parent_conditions = Fget (parent, Qerror_conditions); | ||
| 428 | eassert (CONSP (parent_conditions)); | ||
| 429 | eassert (!NILP (Fmemq (parent, parent_conditions))); | ||
| 430 | eassert (NILP (Fmemq (name, parent_conditions))); | ||
| 431 | Fput (name, Qerror_conditions, pure_cons (name, parent_conditions)); | ||
| 432 | Fput (name, Qerror_message, build_pure_c_string (message)); | ||
| 433 | } | ||
| 434 | |||
| 435 | void | ||
| 436 | syms_of_json (void) | ||
| 437 | { | ||
| 438 | DEFSYM (QCjson_false, ":json-false"); | ||
| 439 | |||
| 440 | DEFSYM (Qstring_without_embedded_nulls_p, "string-without-embedded-nulls-p"); | ||
| 441 | DEFSYM (Qjson_value_p, "json-value-p"); | ||
| 442 | |||
| 443 | DEFSYM (Qjson_error, "json-error"); | ||
| 444 | DEFSYM (Qjson_out_of_memory, "json-out-of-memory"); | ||
| 445 | DEFSYM (Qjson_parse_error, "json-parse-error"); | ||
| 446 | DEFSYM (Qjson_object_too_deep, "json-object-too-deep"); | ||
| 447 | define_error (Qjson_error, "generic JSON error", Qerror); | ||
| 448 | define_error (Qjson_out_of_memory, "no free memory for creating JSON object", | ||
| 449 | Qjson_error); | ||
| 450 | define_error (Qjson_parse_error, "could not parse JSON stream", | ||
| 451 | Qjson_error); | ||
| 452 | define_error (Qjson_object_too_deep, "object cyclic or too deep", | ||
| 453 | Qjson_error); | ||
| 454 | |||
| 455 | DEFSYM (Qpure, "pure"); | ||
| 456 | DEFSYM (Qside_effect_free, "side-effect-free"); | ||
| 457 | |||
| 458 | DEFSYM (Qjson_serialize, "json-serialize"); | ||
| 459 | DEFSYM (Qjson_parse_string, "json-parse-string"); | ||
| 460 | Fput (Qjson_serialize, Qpure, Qt); | ||
| 461 | Fput (Qjson_serialize, Qside_effect_free, Qt); | ||
| 462 | Fput (Qjson_parse_string, Qpure, Qt); | ||
| 463 | Fput (Qjson_parse_string, Qside_effect_free, Qt); | ||
| 464 | |||
| 465 | defsubr (&Sjson_serialize); | ||
| 466 | defsubr (&Sjson_insert); | ||
| 467 | defsubr (&Sjson_parse_string); | ||
| 468 | defsubr (&Sjson_parse_buffer); | ||
| 469 | } | ||
diff --git a/src/lisp.h b/src/lisp.h index 8d485098ac5..c5030824427 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -3440,11 +3440,6 @@ extern int x_bitmap_mask (struct frame *, ptrdiff_t); | |||
| 3440 | extern void reset_image_types (void); | 3440 | extern void reset_image_types (void); |
| 3441 | extern void syms_of_image (void); | 3441 | extern void syms_of_image (void); |
| 3442 | 3442 | ||
| 3443 | #ifdef HAVE_JSON | ||
| 3444 | /* Defined in json.c. */ | ||
| 3445 | extern void syms_of_json (void); | ||
| 3446 | #endif | ||
| 3447 | |||
| 3448 | /* Defined in insdel.c. */ | 3443 | /* Defined in insdel.c. */ |
| 3449 | extern void move_gap_both (ptrdiff_t, ptrdiff_t); | 3444 | extern void move_gap_both (ptrdiff_t, ptrdiff_t); |
| 3450 | extern _Noreturn void buffer_overflow (void); | 3445 | extern _Noreturn void buffer_overflow (void); |
diff --git a/test/src/json-tests.el b/test/src/json-tests.el deleted file mode 100644 index 1d8f9a490ba..00000000000 --- a/test/src/json-tests.el +++ /dev/null | |||
| @@ -1,61 +0,0 @@ | |||
| 1 | ;;; json-tests.el --- unit tests for json.c -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;; Unit tests for src/json.c. | ||
| 23 | |||
| 24 | ;;; Code: | ||
| 25 | |||
| 26 | (require 'cl-lib) | ||
| 27 | (require 'map) | ||
| 28 | |||
| 29 | (ert-deftest json-serialize/roundtrip () | ||
| 30 | (let ((lisp [nil :json-false t 0 123 -456 3.75 "foo"]) | ||
| 31 | (json "[null,false,true,0,123,-456,3.75,\"foo\"]")) | ||
| 32 | (should (equal (json-serialize lisp) json)) | ||
| 33 | (with-temp-buffer | ||
| 34 | (json-insert lisp) | ||
| 35 | (should (equal (buffer-string) json)) | ||
| 36 | (should (eobp))) | ||
| 37 | (should (equal (json-parse-string json) lisp)) | ||
| 38 | (with-temp-buffer | ||
| 39 | (insert json) | ||
| 40 | (goto-char 1) | ||
| 41 | (should (equal (json-parse-buffer) lisp)) | ||
| 42 | (should (eobp))))) | ||
| 43 | |||
| 44 | (ert-deftest json-serialize/object () | ||
| 45 | (let ((table (make-hash-table :test #'equal))) | ||
| 46 | (puthash "abc" [1 2 t] table) | ||
| 47 | (puthash "def" nil table) | ||
| 48 | (should (equal (json-serialize table) | ||
| 49 | "{\"abc\":[1,2,true],\"def\":null}")))) | ||
| 50 | |||
| 51 | (ert-deftest json-parse-string/object () | ||
| 52 | (let ((actual | ||
| 53 | (json-parse-string | ||
| 54 | "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))) | ||
| 55 | (should (hash-table-p actual)) | ||
| 56 | (should (equal (hash-table-count actual) 2)) | ||
| 57 | (should (equal (cl-sort (map-pairs actual) #'string< :key #'car) | ||
| 58 | '(("abc" . [9 :json-false]) ("def")))))) | ||
| 59 | |||
| 60 | (provide 'json-tests) | ||
| 61 | ;;; json-tests.el ends here | ||