commit d87bdd2f8a5da117e5e4d7ea0c26de0f91c424f2 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sun Dec 24 11:29:36 2017 -0800 Make main_thread_id private * src/sysdep.c (main_thread_id) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Now static. diff --git a/src/sysdep.c b/src/sysdep.c index e223a67787..9522aa4b04 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1671,7 +1671,7 @@ emacs_sigaction_init (struct sigaction *action, signal_handler_t handler) } #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD -pthread_t main_thread_id; +static pthread_t main_thread_id; #endif /* SIG has arrived at the current process. Deliver it to the main diff --git a/src/syssignal.h b/src/syssignal.h index 61e1c5f60e..b43a2562e3 100644 --- a/src/syssignal.h +++ b/src/syssignal.h @@ -32,7 +32,6 @@ extern void unblock_tty_out_signal (sigset_t const *); #ifdef HAVE_PTHREAD #include -extern pthread_t main_thread_id; /* If defined, asynchronous signals delivered to a non-main thread are forwarded to the main thread. */ #define FORWARD_SIGNAL_TO_MAIN_THREAD commit 9982be8f015facb4a615d7a94b10c7078c1a8e7c Author: Paul Eggert Date: Sun Dec 24 11:25:11 2017 -0800 On non-MS-Windows, omit unnecessary polling functions * src/keyboard.c (poll_for_input_1) [!CYGWIN && !DOS_NT]: Remove. (input_polling_used) [!DOS_NT]: Remove. diff --git a/src/keyboard.c b/src/keyboard.c index 375aa4f606..b9929b3909 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1871,6 +1871,7 @@ int poll_suppress_count; static struct atimer *poll_timer; +#if defined CYGWIN || defined DOS_NT /* Poll for input, so that we catch a C-g if it comes in. */ void poll_for_input_1 (void) @@ -1879,6 +1880,7 @@ poll_for_input_1 (void) && !waiting_for_input) gobble_input (); } +#endif /* Timer callback function for poll_timer. TIMER is equal to poll_timer. */ @@ -1930,20 +1932,22 @@ start_polling (void) #endif } +#ifdef DOS_NT /* True if we are using polling to handle input asynchronously. */ bool input_polling_used (void) { -#ifdef POLL_FOR_INPUT +# ifdef POLL_FOR_INPUT /* XXX This condition was (read_socket_hook && !interrupt_input), but read_socket_hook is not global anymore. Let's pretend that it's always set. */ return !interrupt_input; -#else - return 0; -#endif +# else + return false; +# endif } +#endif /* Turn off polling. */ commit 3f63ae54ecc22de51930cba1b118e93f7decd45e Author: Philipp Stephani Date: Sun Dec 24 14:12:19 2017 +0100 Add more Unicode test cases for JSON conversion * test/src/json-tests.el (json-parse-string/string) (json-serialize/string, json-serialize/invalid-unicode) (json-parse-string/invalid-unicode): Add more Unicode test cases. diff --git a/test/src/json-tests.el b/test/src/json-tests.el index b23439a59f..e394583bc7 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -92,7 +92,9 @@ (should (equal (json-parse-string "[\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"]") ["\nasdфывfgh\t"])) (should (equal (json-parse-string "[\"\\uD834\\uDD1E\"]") ["\U0001D11E"])) - (should-error (json-parse-string "foo") :type 'json-parse-error)) + (should-error (json-parse-string "foo") :type 'json-parse-error) + ;; FIXME: Is this the right behavior? + (should (equal (json-parse-string "[\"\u00C4\xC3\x84\"]") ["\u00C4\u00C4"]))) (ert-deftest json-serialize/string () (skip-unless (fboundp 'json-serialize)) @@ -100,7 +102,9 @@ (should (equal (json-serialize ["a\n\fb"]) "[\"a\\n\\fb\"]")) (should (equal (json-serialize ["\nasdфыв\u001f\u007ffgh\t"]) "[\"\\nasdфыв\\u001F\u007ffgh\\t\"]")) - (should (equal (json-serialize ["a\0b"]) "[\"a\\u0000b\"]"))) + (should (equal (json-serialize ["a\0b"]) "[\"a\\u0000b\"]")) + ;; FIXME: Is this the right behavior? + (should (equal (json-serialize ["\u00C4\xC3\x84"]) "[\"\u00C4\u00C4\"]"))) (ert-deftest json-serialize/invalid-unicode () (skip-unless (fboundp 'json-serialize)) @@ -109,7 +113,8 @@ (should-error (json-serialize ["a\uDBBBb"]) :type 'json-out-of-memory) (should-error (json-serialize ["u\x110000v"]) :type 'json-out-of-memory) (should-error (json-serialize ["u\x3FFFFFv"]) :type 'json-out-of-memory) - (should-error (json-serialize ["u\xCCv"]) :type 'json-out-of-memory)) + (should-error (json-serialize ["u\xCCv"]) :type 'json-out-of-memory) + (should-error (json-serialize ["u\u00C4\xCCv"]) :type 'json-out-of-memory)) (ert-deftest json-parse-string/null () (skip-unless (fboundp 'json-parse-string)) @@ -119,22 +124,33 @@ (ert-deftest json-parse-string/invalid-unicode () "Some examples from -https://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt." +https://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt. +Test with both unibyte and multibyte strings." (skip-unless (fboundp 'json-parse-string)) ;; Invalid UTF-8 code unit sequences. (should-error (json-parse-string "[\"\x80\"]") :type 'json-parse-error) + (should-error (json-parse-string "[\"\u00C4\x80\"]") :type 'json-parse-error) (should-error (json-parse-string "[\"\xBF\"]") :type 'json-parse-error) + (should-error (json-parse-string "[\"\u00C4\xBF\"]") :type 'json-parse-error) (should-error (json-parse-string "[\"\xFE\"]") :type 'json-parse-error) + (should-error (json-parse-string "[\"\u00C4\xFE\"]") :type 'json-parse-error) (should-error (json-parse-string "[\"\xC0\xAF\"]") :type 'json-parse-error) - (should-error (json-parse-string "[\"\xC0\x80\"]") :type 'json-parse-error) + (should-error (json-parse-string "[\"\u00C4\xC0\xAF\"]") + :type 'json-parse-error) + (should-error (json-parse-string "[\"\u00C4\xC0\x80\"]") + :type 'json-parse-error) ;; Surrogates. (should-error (json-parse-string "[\"\uDB7F\"]") :type 'json-parse-error) (should-error (json-parse-string "[\"\xED\xAD\xBF\"]") :type 'json-parse-error) + (should-error (json-parse-string "[\"\u00C4\xED\xAD\xBF\"]") + :type 'json-parse-error) (should-error (json-parse-string "[\"\uDB7F\uDFFF\"]") :type 'json-parse-error) (should-error (json-parse-string "[\"\xED\xAD\xBF\xED\xBF\xBF\"]") + :type 'json-parse-error) + (should-error (json-parse-string "[\"\u00C4\xED\xAD\xBF\xED\xBF\xBF\"]") :type 'json-parse-error)) (ert-deftest json-parse-string/incomplete () commit f552a957ada23a7ff182fc1ab94221ced3ed1713 Author: Philipp Stephani Date: Wed Dec 13 22:41:28 2017 +0100 Accept alists when serializing JSON * src/json.c (lisp_to_json_toplevel_1): Also accept alists representing objects. * src/json.c (Fjson_serialize): Update docstring. * test/src/json-tests.el (json-serialize/object): Add unit tests for serializing alists. * doc/lispref/text.texi (Parsing JSON): Document that serialization functions accept alists. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 561ad80434..7a1983641f 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4929,14 +4929,16 @@ represented using Lisp vectors. @item JSON has only one map type, the object. JSON objects are represented -using Lisp hashtables or alists. +using Lisp hashtables or alists. When an alist contains several +elements with the same key, Emacs uses only the first element for +serialization, in accordance with the behavior of @code{assq}. @end itemize @noindent -Note that @code{nil} represents the empty JSON object, @code{@{@}}, -not @code{null}, @code{false}, or an empty array, all of which are -different JSON values. +Note that @code{nil} is a valid alist and represents the empty JSON +object, @code{@{@}}, not @code{null}, @code{false}, or an empty array, +all of which are different JSON values. If some Lisp object can't be represented in JSON, the serialization functions will signal an error of type @code{wrong-type-argument}. diff --git a/src/json.c b/src/json.c index c1daba199c..f615c4269f 100644 --- a/src/json.c +++ b/src/json.c @@ -367,12 +367,48 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json) clear_unwind_protect (count); return unbind_to (count, Qnil); } + else if (NILP (lisp)) + { + *json = json_check (json_object ()); + return Qnil; + } + else if (CONSP (lisp)) + { + Lisp_Object tail = lisp; + *json = json_check (json_object ()); + ptrdiff_t count = SPECPDL_INDEX (); + record_unwind_protect_ptr (json_release_object, *json); + FOR_EACH_TAIL (tail) + { + Lisp_Object pair = XCAR (tail); + CHECK_CONS (pair); + Lisp_Object key_symbol = XCAR (pair); + Lisp_Object value = XCDR (pair); + CHECK_SYMBOL (key_symbol); + Lisp_Object key = SYMBOL_NAME (key_symbol); + /* We can't specify the length, so the string must be + null-terminated. */ + check_string_without_embedded_nulls (key); + const char *key_str = SSDATA (key); + /* Only add element if key is not already present. */ + if (json_object_get (*json, key_str) == NULL) + { + int status + = json_object_set_new (*json, key_str, lisp_to_json (value)); + if (status == -1) + json_out_of_memory (); + } + } + CHECK_LIST_END (tail, lisp); + clear_unwind_protect (count); + return unbind_to (count, Qnil); + } wrong_type_argument (Qjson_value_p, lisp); } /* Convert LISP to a toplevel JSON object (array or object). Signal - an error of type `wrong-type-argument' if LISP is not a vector or - hashtable. */ + an error of type `wrong-type-argument' if LISP is not a vector, + hashtable, or alist. */ static json_t * lisp_to_json_toplevel (Lisp_Object lisp) @@ -413,19 +449,20 @@ lisp_to_json (Lisp_Object lisp) return json_check (json_stringn (SSDATA (encoded), SBYTES (encoded))); } - /* LISP now must be a vector or hashtable. */ + /* LISP now must be a vector, hashtable, or alist. */ return lisp_to_json_toplevel (lisp); } DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, 1, NULL, doc: /* Return the JSON representation of OBJECT as a string. -OBJECT must be a vector or hashtable, and its elements can recursively -contain `:null', `:false', t, numbers, strings, or other vectors and -hashtables. `:null', `:false', and t will be converted to JSON null, -false, and true values, respectively. Vectors will be converted to -JSON arrays, and hashtables to JSON objects. Hashtable keys must be -strings without embedded null characters and must be unique within -each object. */) +OBJECT must be a vector, hashtable, or alist, and its elements can +recursively contain `:null', `:false', t, numbers, strings, or other +vectors hashtables, and alist. `:null', `:false', and t will be +converted to JSON null, false, and true values, respectively. Vectors +will be converted to JSON arrays, and hashtables and alists to JSON +objects. Hashtable keys must be strings without embedded null +characters and must be unique within each object. Alist keys must be +symbols; if a key is duplicate, the first instance is used. */) (Lisp_Object object) { ptrdiff_t count = SPECPDL_INDEX (); diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 5d9f6b3840..b23439a59f 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -50,7 +50,19 @@ (puthash "abc" [1 2 t] table) (puthash "def" :null table) (should (equal (json-serialize table) - "{\"abc\":[1,2,true],\"def\":null}")))) + "{\"abc\":[1,2,true],\"def\":null}"))) + (should (equal (json-serialize '((abc . [1 2 t]) (def . :null))) + "{\"abc\":[1,2,true],\"def\":null}")) + (should (equal (json-serialize nil) "{}")) + (should (equal (json-serialize '((abc))) "{\"abc\":{}}")) + (should (equal (json-serialize '((a . 1) (b . 2) (a . 3))) + "{\"a\":1,\"b\":2}")) + (should-error (json-serialize '(abc)) :type 'wrong-type-argument) + (should-error (json-serialize '((a 1))) :type 'wrong-type-argument) + (should-error (json-serialize '((1 . 2))) :type 'wrong-type-argument) + (should-error (json-serialize '((a . 1) . b)) :type 'wrong-type-argument) + (should-error (json-serialize '#1=((a . 1) . #1#)) :type 'circular-list) + (should-error (json-serialize '(#1=(a #1#))))) (ert-deftest json-serialize/object-with-duplicate-keys () (skip-unless (fboundp 'json-serialize)) commit 3455192777459a08a38b0adb311a76202e29f48d Author: Philipp Stephani Date: Tue Dec 19 00:04:29 2017 +0100 JSON serialization: reject duplicate keys in hashtables * src/json.c (lisp_to_json_toplevel_1): Reject duplicate keys in hashtables. * test/src/json-tests.el (json-serialize/object-with-duplicate-keys): Add unit tests. diff --git a/src/json.c b/src/json.c index 689f6ac510..c1daba199c 100644 --- a/src/json.c +++ b/src/json.c @@ -352,7 +352,12 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json) /* 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), + const char *key_str = SSDATA (key); + /* Reject duplicate keys. These are possible if the hash + table test is not `equal'. */ + if (json_object_get (*json, key_str) != NULL) + wrong_type_argument (Qjson_value_p, lisp); + int status = json_object_set_new (*json, key_str, lisp_to_json (HASH_VALUE (h, i))); if (status == -1) /* FIXME: A failure here might also indicate that the diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 9884e9a2d5..5d9f6b3840 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -52,6 +52,14 @@ (should (equal (json-serialize table) "{\"abc\":[1,2,true],\"def\":null}")))) +(ert-deftest json-serialize/object-with-duplicate-keys () + (skip-unless (fboundp 'json-serialize)) + (let ((table (make-hash-table :test #'eq))) + (puthash (copy-sequence "abc") [1 2 t] table) + (puthash (copy-sequence "abc") :null table) + (should (equal (hash-table-count table) 2)) + (should-error (json-serialize table) :type 'wrong-type-argument))) + (ert-deftest json-parse-string/object () (skip-unless (fboundp 'json-parse-string)) (let ((input