aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPhilipp Stephani2017-09-18 18:00:45 +0200
committerPhilipp Stephani2017-09-18 18:00:45 +0200
commit0925a20e0a48bc5ff8e9bad6ca4aa0a4c91fdc3c (patch)
tree504d5533ad5177b4156dcc691cffc62ba510ee3e
parentcb99cf5a99680af7dc2c49fdf5b840d1ff4dd928 (diff)
downloademacs-0925a20e0a48bc5ff8e9bad6ca4aa0a4c91fdc3c.tar.gz
emacs-0925a20e0a48bc5ff8e9bad6ca4aa0a4c91fdc3c.zip
Revert "Implement native JSON support using Jansson"
This reverts commit cb99cf5a99680af7dc2c49fdf5b840d1ff4dd928.
-rw-r--r--configure.ac20
-rw-r--r--src/Makefile.in11
-rw-r--r--src/emacs.c4
-rw-r--r--src/json.c469
-rw-r--r--src/lisp.h5
-rw-r--r--test/src/json-tests.el61
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])
348OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)]) 348OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)])
349OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) 349OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
350OPTION_DEFAULT_ON([imagemagick],[don't compile with ImageMagick image support]) 350OPTION_DEFAULT_ON([imagemagick],[don't compile with ImageMagick image support])
351OPTION_DEFAULT_ON([json], [don't compile with native JSON support])
352 351
353OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) 352OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
354OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support]) 353OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support])
@@ -2857,22 +2856,6 @@ fi
2857AC_SUBST(LIBSYSTEMD_LIBS) 2856AC_SUBST(LIBSYSTEMD_LIBS)
2858AC_SUBST(LIBSYSTEMD_CFLAGS) 2857AC_SUBST(LIBSYSTEMD_CFLAGS)
2859 2858
2860HAVE_JSON=no
2861JSON_OBJ=
2862
2863if 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
2870fi
2871
2872AC_SUBST(JSON_LIBS)
2873AC_SUBST(JSON_CFLAGS)
2874AC_SUBST(JSON_OBJ)
2875
2876NOTIFY_OBJ= 2859NOTIFY_OBJ=
2877NOTIFY_SUMMARY=no 2860NOTIFY_SUMMARY=no
2878 2861
@@ -5385,7 +5368,7 @@ emacs_config_features=
5385for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ 5368for 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@
312LIBSYSTEMD_LIBS = @LIBSYSTEMD_LIBS@ 312LIBSYSTEMD_LIBS = @LIBSYSTEMD_LIBS@
313LIBSYSTEMD_CFLAGS = @LIBSYSTEMD_CFLAGS@ 313LIBSYSTEMD_CFLAGS = @LIBSYSTEMD_CFLAGS@
314 314
315JSON_LIBS = @JSON_LIBS@
316JSON_CFLAGS = @JSON_CFLAGS@
317JSON_OBJ = @JSON_OBJ@
318
319INTERVALS_H = dispextern.h intervals.h composite.h 315INTERVALS_H = dispextern.h intervals.h composite.h
320 316
321GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ 317GETLOADAVG_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)
373ALL_CFLAGS = $(EMACS_CFLAGS) $(WARN_CFLAGS) $(CFLAGS) 369ALL_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)
405obj = $(base_obj) $(NS_OBJC_OBJ) 401obj = $(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
3Copyright (C) 2017 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or (at
10your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along 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
30static _Noreturn void
31json_out_of_memory (void)
32{
33 xsignal0 (Qjson_out_of_memory);
34}
35
36static _Noreturn void
37json_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
45static void
46json_release_object (void *object)
47{
48 json_decref (object);
49}
50
51static void
52check_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
59static json_t *
60json_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
70static Lisp_Object
71lisp_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
162DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, 1, NULL,
163 doc: /* Return the JSON representation of OBJECT as a string.
164OBJECT must be a vector or hashtable, and its elements can recursively
165contain nil, t, `:json-false', numbers, strings, or other vectors and
166hashtables. nil, t, and `:json-false' will be converted to JSON null,
167true, and false values, respectively. Vectors will be converted to
168JSON arrays, and hashtables to JSON objects. Hashtable keys must be
169strings without embedded null characters and must be unique within
170each 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
187struct json_buffer_and_size
188{
189 const char *buffer;
190 size_t size;
191};
192
193static Lisp_Object
194json_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
205struct json_insert_data
206{
207 /* nil if json_insert succeeded, otherwise a cons
208 (ERROR-SYMBOL . ERROR-DATA). */
209 Lisp_Object error;
210};
211
212static int
213json_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
225DEFUN ("json-insert", Fjson_insert, Sjson_insert, 1, 1, NULL,
226 doc: /* Insert the JSON representation of OBJECT before point.
227This is the same as (insert (json-serialize OBJECT)), but potentially
228faster. See the function `json-serialize' for allowed values of
229OBJECT. */)
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
251static Lisp_Object
252json_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
324DEFUN ("json-parse-string", Fjson_parse_string, Sjson_parse_string, 1, 1, NULL,
325 doc: /* Parse the JSON STRING into a Lisp object.
326This is essentially the reverse operation of `json-serialize', which
327see. The returned object will be a vector or hashtable. Its elements
328will be nil, t, `:json-false', numbers, strings, or further vectors
329and hashtables. If there are duplicate keys in an object, all but the
330last one are ignored. If STRING doesn't contain a valid JSON object,
331an 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
349struct json_read_buffer_data
350{
351 ptrdiff_t point;
352};
353
354static size_t
355json_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
382DEFUN ("json-parse-buffer", Fjson_parse_buffer, Sjson_parse_buffer,
383 0, 0, NULL,
384 doc: /* Read JSON object from current buffer starting at point.
385This is similar to `json-parse-string', which see. Move point after
386the end of the object if parsing was successful. On error, point is
387not 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
422static void
423define_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
435void
436syms_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);
3440extern void reset_image_types (void); 3440extern void reset_image_types (void);
3441extern void syms_of_image (void); 3441extern void syms_of_image (void);
3442 3442
3443#ifdef HAVE_JSON
3444/* Defined in json.c. */
3445extern void syms_of_json (void);
3446#endif
3447
3448/* Defined in insdel.c. */ 3443/* Defined in insdel.c. */
3449extern void move_gap_both (ptrdiff_t, ptrdiff_t); 3444extern void move_gap_both (ptrdiff_t, ptrdiff_t);
3450extern _Noreturn void buffer_overflow (void); 3445extern _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