commit 56274bc0bbfe144ef4af08fc86e9455dabfccf30 (HEAD, refs/remotes/origin/master) Author: Glenn Morris Date: Mon Dec 18 20:08:31 2017 -0500 Add a Makefile rule for running gitmerge * Makefile.in (GITMERGE_EMACS, GITMERGE_NMIN): New variables. (gitmerge): New phony target. diff --git a/Makefile.in b/Makefile.in index 3f46d0acaf..75a501a660 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1155,3 +1155,13 @@ check-declare: exit 1; \ fi $(MAKE) -C lisp $@ + +.PHONY: gitmerge + +GITMERGE_EMACS = ./src/emacs${EXEEXT} +GITMERGE_NMIN = 10 + +gitmerge: + ${GITMERGE_EMACS} -batch --no-site-file --no-site-lisp \ + -l ${srcdir}/admin/gitmerge.el \ + --eval '(setq gitmerge-minimum-missing ${GITMERGE_NMIN})' -f gitmerge commit 066b65d03d4e6a1f666917fcea78998f3d001873 Author: Glenn Morris Date: Mon Dec 18 19:56:21 2017 -0500 Set minimum number of commits for gitmerge in batch mode * admin/gitmerge.el (gitmerge-minimum-missing): New variable. (gitmerge): In batch mode, respect gitmerge-minimum-missing. diff --git a/admin/gitmerge.el b/admin/gitmerge.el index ba9f2b8f80..4bc946e144 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -63,6 +63,9 @@ bump version\\|Auto-commit")) "Regexp matching logs of revisions that might be skipped. `gitmerge-missing' will ask you if it should skip any matches.") +(defvar gitmerge-minimum-missing 10 + "Minimum number of missing commits to consider merging in batch mode.") + (defvar gitmerge-status-file (expand-file-name "gitmerge-status" user-emacs-directory) "File where missing commits will be saved between sessions.") @@ -567,6 +570,12 @@ Branch FROM will be prepended to the list." (setq gitmerge--from from) (when (null gitmerge--commits) (user-error "Nothing to merge")) + (and noninteractive + gitmerge-minimum-missing + (< (length gitmerge--commits) gitmerge-minimum-missing) + (user-error "Number of missing commits (%s) is less than %s" + (length gitmerge--commits) + gitmerge-minimum-missing)) (with-current-buffer (gitmerge-setup-log-buffer gitmerge--commits gitmerge--from) (goto-char (point-min)) commit 2a8d2d5daf55fe70ce3c07c0f0140835f952f56a Author: Glenn Morris Date: Mon Dec 18 19:49:51 2017 -0500 * admin/gitmerge.el (gitmerge-skip-regexp): Be stricter in batch mode. diff --git a/admin/gitmerge.el b/admin/gitmerge.el index efb7d08501..ba9f2b8f80 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -50,8 +50,16 @@ (defvar gitmerge-skip-regexp ;; We used to include "sync" in there, but in my experience it only ;; caused false positives. --Stef - "back[- ]?port\\|cherry picked from commit\\|\\(do\\( no\\|n['’]\\)t\\|no need to\\) merge\\|\ -re-?generate\\|bump version\\|from trunk\\|Auto-commit" + (let ((skip "back[- ]?port\\|cherry picked from commit\\|\ +\\(do\\( no\\|n['’]\\)t\\|no need to\\) merge\\|\ +bump version\\|Auto-commit")) + (if noninteractive skip + ;; "Regenerate" is quite prone to false positives. + ;; We only want to skip merging things like AUTHORS and ldefs-boot. + ;; These should be covered by "bump version" and "auto-commit". + ;; It doesn't do much harm if we merge one of those files by mistake. + ;; So it's better to err on the side of false negatives. + (concat skip "\\|re-?generate\\|from trunk"))) "Regexp matching logs of revisions that might be skipped. `gitmerge-missing' will ask you if it should skip any matches.") commit 1e89864f92b3e1f29592ae914cf6fccce40d49d2 Author: Glenn Morris Date: Mon Dec 18 19:38:25 2017 -0500 Make gitmerge usable in batch mode * admin/gitmerge.el (gitmerge-missing): Add progress messages. (gitmerge-maybe-resume): In batch mode, never resume. (gitmerge): Handle batch mode. diff --git a/admin/gitmerge.el b/admin/gitmerge.el index 5e7d8c3e33..efb7d08501 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -198,6 +198,7 @@ Will detect a default set of skipped revision by looking at cherry mark and search for `gitmerge-skip-regexp'. The result is a list with entries of the form (SHA1 . SKIP), where SKIP denotes if and why this commit should be skipped." + (message "Finding missing commits...") (let (commits) ;; Go through the log and remember all commits that match ;; `gitmerge-skip-regexp' or are marked by --cherry-mark. @@ -220,6 +221,7 @@ if and why this commit should be skipped." (when (re-search-forward gitmerge-skip-regexp nil t) (setcdr (car commits) "R")))))) (delete-region (point) (point-max)))) + (message "Finding missing commits...done") (nreverse commits))) (defun gitmerge-setup-log-buffer (commits from) @@ -474,7 +476,7 @@ If so, add no longer conflicted files and commit." (not (gitmerge-repo-clean))) (user-error "Repository is not clean")) (when statusexist - (if (not (y-or-n-p "Resume merge? ")) + (if (or noninteractive (not (y-or-n-p "Resume merge? "))) (progn (delete-file gitmerge-status-file) ;; No resume. @@ -540,8 +542,12 @@ Branch FROM will be prepended to the list." (list (if (gitmerge-maybe-resume) 'resume - (completing-read "Merge branch: " (gitmerge-get-all-branches) - nil t (gitmerge-default-branch))))))) + (if noninteractive + (or (pop command-line-args-left) + (gitmerge-default-branch)) + (completing-read "Merge branch: " + (gitmerge-get-all-branches) + nil t (gitmerge-default-branch)))))))) (let ((default-directory (vc-git-root default-directory))) (if (eq from 'resume) (progn @@ -563,7 +569,8 @@ Branch FROM will be prepended to the list." "(C) Detected backport (cherry-mark), (R) Log matches " "regexp, (M) Manually picked\n\n") (gitmerge-mode) - (pop-to-buffer (current-buffer)))))) + (pop-to-buffer (current-buffer)) + (if noninteractive (gitmerge-start-merge)))))) (defun gitmerge-start-merge () (interactive) commit 91031a2cfd6b6a3b17c0f8724fd5cccf7c32ed5b Author: Philipp Stephani Date: Mon Dec 18 23:58:48 2017 +0100 ; Add a couple of encoding-related FIXMEs to json.c * src/json.c (json_make_string, json_build_string, json_encode) (lisp_to_json_toplevel_1, lisp_to_json): Add FIXMEs for problematic string error reporting. diff --git a/src/json.c b/src/json.c index 82f670a163..29e4400fc9 100644 --- a/src/json.c +++ b/src/json.c @@ -208,6 +208,7 @@ json_has_suffix (const char *string, const char *suffix) static Lisp_Object json_make_string (const char *data, ptrdiff_t size) { + /* FIXME: Raise an error if DATA is not a UTF-8 string. */ return code_convert_string (make_specified_string (data, -1, size, false), Qutf_8_unix, Qt, false, true, true); } @@ -219,6 +220,7 @@ json_make_string (const char *data, ptrdiff_t size) static Lisp_Object json_build_string (const char *data) { + /* FIXME: Raise an error if DATA is not a UTF-8 string. */ return json_make_string (data, strlen (data)); } @@ -230,6 +232,8 @@ json_build_string (const char *data) static Lisp_Object json_encode (Lisp_Object string) { + /* FIXME: Raise an error if STRING is not a scalar value + sequence. */ return code_convert_string (string, Qutf_8_unix, Qt, true, true, true); } @@ -330,6 +334,8 @@ lisp_to_json_toplevel_1 (Lisp_Object lisp, json_t **json) int status = json_object_set_new (*json, SSDATA (key), lisp_to_json (HASH_VALUE (h, i))); if (status == -1) + /* FIXME: A failure here might also indicate that the + key is not a valid Unicode string. */ json_out_of_memory (); } clear_unwind_protect (count); @@ -376,6 +382,8 @@ lisp_to_json (Lisp_Object lisp) else if (STRINGP (lisp)) { Lisp_Object encoded = json_encode (lisp); + /* FIXME: We might throw an out-of-memory error here if the + string is not valid Unicode. */ return json_check (json_stringn (SSDATA (encoded), SBYTES (encoded))); } commit 205d02c1b54fa8e18f610cd5deb61a1a3b9bbc01 Author: Philipp Stephani Date: Tue Dec 19 00:01:54 2017 +0100 ; * src/json.c (lisp_to_json): Inline an unnecessary variable. diff --git a/src/json.c b/src/json.c index 5849705952..82f670a163 100644 --- a/src/json.c +++ b/src/json.c @@ -376,8 +376,7 @@ lisp_to_json (Lisp_Object lisp) else if (STRINGP (lisp)) { Lisp_Object encoded = json_encode (lisp); - ptrdiff_t size = SBYTES (encoded); - return json_check (json_stringn (SSDATA (encoded), size)); + return json_check (json_stringn (SSDATA (encoded), SBYTES (encoded))); } /* LISP now must be a vector or hashtable. */ commit 87bd1d914e856346c7d22bd080155362ce5ac02f Author: Philipp Stephani Date: Tue Dec 19 00:03:05 2017 +0100 ; Add comments about potential future Jansson flags * src/json.c (Fjson_serialize, Fjson_insert): Add comments about flags that we might potentially add in the future. diff --git a/src/json.c b/src/json.c index 72ca93f621..5849705952 100644 --- a/src/json.c +++ b/src/json.c @@ -415,6 +415,8 @@ each object. */) json_t *json = lisp_to_json_toplevel (object); record_unwind_protect_ptr (json_release_object, json); + /* If desired, we might want to add the following flags: + JSON_DECODE_ANY, JSON_ALLOW_NUL. */ char *string = json_dumps (json, JSON_COMPACT); if (string == NULL) json_out_of_memory (); @@ -494,6 +496,8 @@ OBJECT. */) record_unwind_protect_ptr (json_release_object, json); struct json_insert_data data; + /* If desired, we might want to add the following flags: + JSON_DECODE_ANY, JSON_ALLOW_NUL. */ int status = json_dump_callback (json, json_insert_callback, &data, JSON_COMPACT); if (status == -1) commit 994ce51b28384bb2ea7a88248a105fcdc7c53a7b Author: Philipp Stephani Date: Tue Dec 19 00:07:45 2017 +0100 JSON: Add tests for Unicode edge cases * test/src/json-tests.el (json-serialize/string): Add test for serializing the null character. (json-parse-string/null): Add test for parsing the null character. (json-serialize/invalid-unicode): Add tests for invalid Unicode strings. (json-serialize/roundtrip): Add Unicode noncharacter, non-BMP characters, and syntactic characters. diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 07eb41d093..551f8ac5fe 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -28,8 +28,10 @@ (ert-deftest json-serialize/roundtrip () (skip-unless (fboundp 'json-serialize)) - (let ((lisp [:null :false t 0 123 -456 3.75 "abcαβγ"]) - (json "[null,false,true,0,123,-456,3.75,\"abcαβγ\"]")) + ;; The noncharacter U+FFFF should be passed through, + ;; cf. https://www.unicode.org/faq/private_use.html#noncharacters. + (let ((lisp [:null :false t 0 123 -456 3.75 "abc\uFFFFαβγ𝔸𝐁𝖢\"\\"]) + (json "[null,false,true,0,123,-456,3.75,\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"]")) (should (equal (json-serialize lisp) json)) (with-temp-buffer (json-insert lisp) @@ -75,7 +77,22 @@ (should (equal (json-serialize ["foo"]) "[\"foo\"]")) (should (equal (json-serialize ["a\n\fb"]) "[\"a\\n\\fb\"]")) (should (equal (json-serialize ["\nasdфыв\u001f\u007ffgh\t"]) - "[\"\\nasdфыв\\u001F\u007ffgh\\t\"]"))) + "[\"\\nasdфыв\\u001F\u007ffgh\\t\"]")) + (should (equal (json-serialize ["a\0b"]) "[\"a\\u0000b\"]"))) + +(ert-deftest json-serialize/invalid-unicode () + (skip-unless (fboundp 'json-serialize)) + ;; FIXME: "out of memory" is the wrong error signal, but we don't + ;; currently distinguish between error types when serializing. + (should-error (json-serialize ["a\uDBBBb"]) :type 'json-out-of-memory) + (should-error (json-serialize (vector (string ?a #x110000 ?b))) + :type 'json-out-of-memory) + (should-error (json-serialize ["a\xCCb"] :type 'json-out-of-memory))) + +(ert-deftest json-parse-string/null () + (skip-unless (fboundp 'json-parse-string)) + ;; FIXME: Reconsider whether this is the right behavior. + (should-error (json-parse-string "[a\\u0000b]") :type 'json-parse-error)) (ert-deftest json-parse-string/incomplete () (skip-unless (fboundp 'json-parse-string)) commit 9685774e38dc6f5670c8e57dc9f49335f4f738b6 Author: Charles A. Roelli Date: Mon Dec 18 20:51:30 2017 +0100 Fix infinite loop in vc-dir-mark-unmark * lisp/vc/vc-dir.el (vc-dir-mark-unmark): Prevent from getting stuck on the same line in an infinite loop. (Bug#24017) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 41c44e2c24..52c7d3e658 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -554,11 +554,15 @@ If a prefix argument is given, move by that many lines." (defun vc-dir-mark-unmark (mark-unmark-function) (if (use-region-p) - (let (;; (firstl (line-number-at-pos (region-beginning))) + (let ((processed-line nil) (lastl (line-number-at-pos (region-end)))) (save-excursion (goto-char (region-beginning)) - (while (<= (line-number-at-pos) lastl) + (while (and (<= (line-number-at-pos) lastl) + ;; We make sure to not get stuck processing the + ;; same line in an infinite loop. + (not (eq processed-line (line-number-at-pos)))) + (setq processed-line (line-number-at-pos)) (condition-case nil (funcall mark-unmark-function) ;; `vc-dir-mark-file' signals an error if we try marking commit 5f17472574565ac10bfcacb7058f3684296c8e7d Author: Eric Abrahamsen Date: Sat Dec 16 14:03:18 2017 -0800 Fix Gnus registry header extraction * lisp/gnus/gnus-registry.el (gnus-registry-fetch-recipients-fast, gnus-registry-fetch-sender-fast): First, delete `gnus-registry-fetch-header-fast'. It was being called with reversed arguments, and thus always returned nil, but even if the argument order was correct it would have raised an error, as it was trying to `assq' a string in a vector. Instead, just have these two functions do their own work, as they're doing fairly different things. diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 466238d252..7345c084db 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -844,21 +844,17 @@ Addresses without a name will say \"noname\"." nil)) (defun gnus-registry-fetch-sender-fast (article) - (gnus-registry-fetch-header-fast "from" article)) + (when-let* ((data (and (numberp article) + (assoc article (gnus-data-list nil))))) + (mail-header-from (gnus-data-header data)))) (defun gnus-registry-fetch-recipients-fast (article) - (gnus-registry-sort-addresses - (or (ignore-errors (gnus-registry-fetch-header-fast "Cc" article)) "") - (or (ignore-errors (gnus-registry-fetch-header-fast "To" article)) ""))) - -(defun gnus-registry-fetch-header-fast (article header) - "Fetch the HEADER quickly, using the internal gnus-data-list function." - (if (and (numberp article) - (assoc article (gnus-data-list nil))) - (gnus-string-remove-all-properties - (cdr (assq header (gnus-data-header - (assoc article (gnus-data-list nil)))))) - nil)) + (when-let* ((data (and (numberp article) + (assoc article (gnus-data-list nil)))) + (extra (mail-header-extra (gnus-data-header data)))) + (gnus-registry-sort-addresses + (or (cdr (assq 'Cc extra)) "") + (or (cdr (assq 'To extra)) "")))) ;; registry marks glue (defun gnus-registry-do-marks (type function)