commit 877c525f4b98bc785f1bb0b50d70f72d09c80eb2 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sat Jan 14 10:55:16 2017 +0200 Include "Date:" in mail messages filed by 'sendmail-send-it' * lisp/mail/sendmail.el (mail-do-fcc): Insert a 'Date:' header into the filed message. In the outgoing message, sendmail will add the date, but the composed message body doesn't have it. (Bug#25436) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 690825bf1e..70c8ea1f93 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -28,8 +28,8 @@ ;;; Code: (require 'mail-utils) - (require 'rfc2047) +(autoload 'message-make-date "message") (defgroup sendmail nil "Mail sending commands for Emacs." @@ -1409,6 +1409,7 @@ just append to the file, in Babyl format if necessary." (require 'mail-utils) (insert (mail-rfc822-time-zone time) " ") (goto-char (point-max)) + (insert "Date: " (message-make-date) "\n") (insert-buffer-substring mailbuf) ;; Make sure messages are separated. (goto-char (point-max)) commit 5b9f08fb867a9a3dca0bc81064202d53d1d52538 Author: Dmitry Gutov Date: Sat Jan 14 06:56:37 2017 +0300 Remove leftover references to log-view-message-face * lisp/vc/vc-bzr.el (vc-bzr-log-view-mode): Use log-view-message. * lisp/vc/vc-git.el (vc-git-root-log-format): Same. * lisp/vc/vc-hg.el (vc-hg-root-log-format): Same. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 279d5ac923..085c05bcc0 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -715,11 +715,11 @@ or a superior directory.") ;; value of log-view-message-re only since Emacs-23. (if (eq vc-log-view-type 'short) (append `((,log-view-message-re - (1 'log-view-message-face) + (1 'log-view-message) (2 'change-log-name) (3 'change-log-date) (4 'change-log-list nil lax)))) - (append `((,log-view-message-re . 'log-view-message-face)) + (append `((,log-view-message-re . 'log-view-message)) ;; log-view-font-lock-keywords '(("^ *\\(?:committer\\|author\\): \ \\([^<(]+?\\)[ ]*[(<]\\([[:alnum:]_.+-]+@[[:alnum:]_.-]+\\)[>)]" diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index c670280016..24dabb6f9f 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -152,7 +152,7 @@ the staging area." ;; revision number to be group 1. "^\\(?:[*/\\| ]+ \\)?\\(?2: ([^)]+)\\)?\\(?1:[0-9a-z]+\\)..: \ \\(?3:.*?\\)[ \t]+\\(?4:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" - ((1 'log-view-message-face) + ((1 'log-view-message) (2 'change-log-list nil lax) (3 'change-log-name) (4 'change-log-date))) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index fc07251692..2f9487ca2e 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -157,7 +157,7 @@ switches." "\\([0-9]+\\):\\([^:]*\\)" ":\\([^:]*\\):\\([^:]*\\):\\(.*?\\)" "[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)") - ((1 'log-view-message-face) + ((1 'log-view-message) (2 'change-log-file) (3 'change-log-list) (4 'change-log-conditionals) commit 72c668a9042ac6475eadedfee5c87fb1e6b2d753 Author: Phillip Lord Date: Fri Jan 13 13:57:51 2017 +0000 Record autoloads till emacs dump * admin/ldefs-clean.el (ldefs-clean-up): Record autoloads till emacs dump * lisp/ldefs-boot-auto.el (batch-byte-compile): Update Previously, autoloads were collected till loaddefs.el was generated as part of the build. However, bootstrap-emacs does not load loaddefs (rather it is dumped), hence we must record autoloads until the full emacs binary is dumped. diff --git a/admin/ldefs-clean.el b/admin/ldefs-clean.el index 6eabe57c7e..c227a16360 100644 --- a/admin/ldefs-clean.el +++ b/admin/ldefs-clean.el @@ -37,9 +37,11 @@ "Clean up output from build and turn it into ldefs-boot-auto.el." (interactive) (goto-char (point-max)) - ;; We only need the autoloads up till loaddefs.el is - ;; generated. After this, ldefs-boot.el is not needed - (search-backward " GEN loaddefs.el") + ;; We need to record autoloads till the point that emacs (as opposed + ;; to bootstrap-emacs) is dumped. After this point, we are not + ;; bootstrapping any more. + (search-backward "-l loadup dump") + (beginning-of-line) (delete-region (point) (point-max)) (keep-lines "(autoload" (point-min) (point-max)) (sort-lines nil (point-min) (point-max)) diff --git a/lisp/ldefs-boot-auto.el b/lisp/ldefs-boot-auto.el index 914fec8e1e..020c6707a0 100644 --- a/lisp/ldefs-boot-auto.el +++ b/lisp/ldefs-boot-auto.el @@ -6,6 +6,8 @@ (autoload 'add-change-log-entry "add-log" nil nil nil) (autoload 'add-log-current-defun "add-log" nil nil nil) (autoload 'batch-byte-compile "bytecomp" nil nil nil) +(autoload 'batch-update-autoloads "autoload" nil nil nil) +(autoload 'bounds-of-thing-at-point "thingatpt" nil nil nil) (autoload 'browse-url "browse-url" nil nil nil) (autoload 'buffer-face-mode "face-remap" nil nil nil) (autoload 'byte-compile "bytecomp" nil nil nil) @@ -24,11 +26,16 @@ (autoload 'compilation-mode "compile" nil nil nil) (autoload 'compilation-shell-minor-mode "compile" nil nil nil) (autoload 'compilation-start "compile" nil nil nil) +(autoload 'completing-read-multiple "crm" nil nil nil) +(autoload 'conf-mode "conf-mode" nil nil nil) +(autoload 'create-glyph "disp-table" nil nil nil) (autoload 'create-image "image" nil nil nil) +(autoload 'cursor-sensor-mode "cursor-sensor" nil nil nil) (autoload 'custom-save-all "cus-edit" nil nil nil) (autoload 'customize-face "cus-edit" nil nil nil) (autoload 'customize-group "cus-edit" nil nil nil) (autoload 'customize-option "cus-edit" nil nil nil) +(autoload 'customize-push-and-save "cus-edit" nil nil nil) (autoload 'customize-set-variable "cus-edit" nil nil nil) (autoload 'debug "debug" nil nil nil) (autoload 'define-ccl-program "ccl" nil nil t) @@ -36,6 +43,8 @@ (autoload 'define-minor-mode "easy-mmode" nil nil t) (autoload 'delete-extract-rectangle "rect" nil nil nil) (autoload 'describe-char "descr-text" nil nil nil) +(autoload 'describe-coding-system "mule-diag" nil nil nil) +(autoload 'describe-display-table "disp-table" nil nil nil) (autoload 'describe-function "help-fns" nil nil nil) (autoload 'describe-function-1 "help-fns" nil nil nil) (autoload 'describe-package "package" nil nil nil) @@ -43,11 +52,21 @@ (autoload 'desktop-save "desktop" nil nil nil) (autoload 'diff-mode "diff-mode" nil nil nil) (autoload 'dired "dired" nil nil nil) +(autoload 'dired-copy-file "dired-aux" nil nil nil) +(autoload 'dired-goto-subdir "dired-aux" nil nil nil) +(autoload 'dired-hide-subdir "dired-aux" nil nil nil) +(autoload 'dired-insert-subdir "dired-aux" nil nil nil) +(autoload 'dired-kill-subdir "dired-aux" nil nil nil) +(autoload 'dired-mark-subdir-files "dired-aux" nil nil nil) (autoload 'dired-mode "dired" nil nil nil) (autoload 'dired-noselect "dired" nil nil nil) +(autoload 'dired-query "dired-aux" nil nil nil) +(autoload 'dired-rename-file "dired-aux" nil nil nil) (autoload 'display-call-tree "bytecomp" nil nil nil) +(autoload 'display-table-slot "disp-table" nil nil nil) (autoload 'display-warning "warnings" nil nil nil) (autoload 'easy-menu-create-menu "easymenu" nil nil nil) +(autoload 'edebug-basic-spec "edebug" nil nil nil) (autoload 'ediff-patch-file "ediff" nil nil nil) (autoload 'edit-kbd-macro "edmacro" nil nil nil) (autoload 'extract-rectangle "rect" nil nil nil) @@ -67,8 +86,10 @@ (autoload 'help-with-tutorial "tutorial" nil nil nil) (autoload 'help-xref-button "help-mode" nil nil nil) (autoload 'hi-lock-face-buffer "hi-lock" nil nil nil) +(autoload 'html-mode "sgml-mode" nil nil nil) (autoload 'image-type-available-p "image" nil nil nil) (autoload 'info "info" nil nil nil) +(autoload 'info-complete-symbol "info-look" nil nil nil) (autoload 'info-emacs-manual "info" nil nil nil) (autoload 'insert-image "image" nil nil nil) (autoload 'insert-rectangle "rect" nil nil nil) @@ -83,21 +104,27 @@ (autoload 'multi-isearch-buffers-regexp "misearch" nil nil nil) (autoload 'multi-isearch-files "misearch" nil nil nil) (autoload 'multi-isearch-files-regexp "misearch" nil nil nil) +(autoload 'nxml-mode "nxml-mode" nil nil nil) (autoload 'open-network-stream "network-stream" nil nil nil) (autoload 'package-initialize "package" nil nil nil) (autoload 'parse-time-string "parse-time" nil nil nil) (autoload 'pp "pp" nil nil nil) (autoload 'pp-buffer "pp" nil nil nil) +(autoload 'print-buffer "lpr" nil nil nil) +(autoload 'quail-defrule-internal "quail" nil nil nil) (autoload 'read-kbd-macro "edmacro" nil nil nil) (autoload 'regexp-opt "regexp-opt" nil nil nil) (autoload 'rx "rx" nil nil t) (autoload 'seconds-to-string "time-date" nil nil nil) (autoload 'seconds-to-time "time-date" nil nil nil) +(autoload 'server-save-buffers-kill-terminal "server" nil nil nil) (autoload 'server-start "server" nil nil nil) (autoload 'set-nested-alist "mule-util" nil nil nil) +(autoload 'skeleton-insert "skeleton" nil nil nil) (autoload 'smerge-mode "smerge-mode" nil nil nil) (autoload 'smerge-start-session "smerge-mode" nil nil nil) (autoload 'standard-display-8bit "disp-table" nil nil nil) +(autoload 'standard-display-default "disp-table" nil nil nil) (autoload 'tags-query-replace "etags" nil nil nil) (autoload 'tags-search "etags" nil nil nil) (autoload 'text-scale-increase "face-remap" nil nil nil) @@ -106,6 +133,12 @@ (autoload 'timezone-make-date-arpa-standard "timezone" nil nil nil) (autoload 'tmm-menubar "tmm" nil nil nil) (autoload 'truncate-string-to-width "mule-util" nil nil nil) +(autoload 'ucs-normalize-HFS-NFC-region "ucs-normalize" nil nil nil) +(autoload 'ucs-normalize-HFS-NFD-region "ucs-normalize" nil nil nil) +(autoload 'ucs-normalize-NFC-region "ucs-normalize" nil nil nil) +(autoload 'ucs-normalize-NFD-region "ucs-normalize" nil nil nil) +(autoload 'ucs-normalize-NFKC-region "ucs-normalize" nil nil nil) +(autoload 'ucs-normalize-NFKD-region "ucs-normalize" nil nil nil) (autoload 'url-handler-mode "url-handlers" nil nil nil) (autoload 'variable-at-point "help-fns" nil nil nil) (autoload 'vc-register "vc" nil nil nil) @@ -114,6 +147,7 @@ (autoload 'view-buffer "view" nil nil nil) (autoload 'view-buffer-other-window "view" nil nil nil) (autoload 'view-file "view" nil nil nil) +(autoload 'view-mode "view" nil nil nil) (autoload 'view-mode-enter "view" nil nil nil) (autoload 'visit-tags-table "etags" nil nil nil) (autoload 'warn "warnings" nil nil nil) commit 502390822f9c0068898ae41285b37568bf0e4d1c Author: Tom Tromey Date: Thu Jan 12 23:15:00 2017 -0700 Add chained indentation to js-mode Bug#20896 * lisp/progmodes/js.el (js-chain-indent): New variable. (js--skip-term-backward, js--skip-terms-backward) (js--chained-expression-p): New functions. (js--proper-indentation): Call js--chained-expression-p. * test/manual/indent/js-chain.js: New file. * test/manual/indent/js.js: Add (non-)chained indentation test. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e84215d430..54df3913fc 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -552,6 +552,20 @@ don't indent the first one's initializer; otherwise, indent it. :safe 'symbolp :group 'js) +(defcustom js-chain-indent nil + "Use \"chained\" indentation. +Chained indentation applies when the current line starts with \".\". +If the previous expression also contains a \".\" at the same level, +then the \".\"s will be lined up: + + let x = svg.mumble() + .chained; +" + :version "26.1" + :type 'boolean + :safe 'booleanp + :group 'js) + ;;; KeyMap (defvar js-mode-map @@ -1808,6 +1822,63 @@ This performs fontification according to `js--class-styles'." (and (progn (backward-char) (not (looking-at "+\\+\\|--\\|/[/*]")))))))))) +(defun js--skip-term-backward () + "Skip a term before point; return t if a term was skipped." + (let ((term-skipped nil)) + ;; Skip backward over balanced parens. + (let ((progress t)) + (while progress + (setq progress nil) + ;; First skip whitespace. + (skip-syntax-backward " ") + ;; Now if we're looking at closing paren, skip to the opener. + ;; This doesn't strictly follow JS syntax, in that we might + ;; skip something nonsensical like "()[]{}", but it is enough + ;; if it works ok for valid input. + (when (memq (char-before) '(?\] ?\) ?\})) + (setq progress t term-skipped t) + (backward-list)))) + ;; Maybe skip over a symbol. + (let ((save-point (point))) + (if (and (< (skip-syntax-backward "w_") 0) + (looking-at js--name-re)) + ;; Skipped. + (progn + (setq term-skipped t) + (skip-syntax-backward " ")) + ;; Did not skip, so restore point. + (goto-char save-point))) + (when (and term-skipped (> (point) (point-min))) + (backward-char) + (eq (char-after) ?.)))) + +(defun js--skip-terms-backward () + "Skip any number of terms backward. +Move point to the earliest \".\" without changing paren levels. +Returns t if successful, nil if no term was found." + (when (js--skip-term-backward) + ;; Found at least one. + (let ((last-point (point))) + (while (js--skip-term-backward) + (setq last-point (point))) + (goto-char last-point) + t))) + +(defun js--chained-expression-p () + "A helper for js--proper-indentation that handles chained expressions. +A chained expression is when the current line starts with '.' and the +previous line also has a '.' expression. +This function returns the indentation for the current line if it is +a chained expression line; otherwise nil. +This should only be called while point is at the start of the line's content, +as determined by `back-to-indentation'." + (when js-chain-indent + (save-excursion + (when (and (eq (char-after) ?.) + (js--continued-expression-p) + (js--find-newline-backward) + (js--skip-terms-backward)) + (current-column))))) (defun js--end-of-do-while-loop-p () "Return non-nil if point is on the \"while\" of a do-while statement. @@ -1984,6 +2055,7 @@ indentation is aligned to that column." ;; At or after the first loop? (>= (point) beg) (js--array-comp-indentation bracket beg)))) + ((js--chained-expression-p)) ((js--ctrl-statement-indentation)) ((js--multi-line-declaration-indentation)) ((nth 1 parse-status) diff --git a/test/manual/indent/js-chain.js b/test/manual/indent/js-chain.js new file mode 100644 index 0000000000..2a29029402 --- /dev/null +++ b/test/manual/indent/js-chain.js @@ -0,0 +1,29 @@ +// Normal chaining. +let x = svg.mumble() + .zzz; + +// Chaining with an intervening line comment. +let x = svg.mumble() // line comment + .zzz; + +// Chaining with multiple dots. +let x = svg.selectAll().something() + .zzz; + +// Nested chaining. +let x = svg.selectAll(d3.svg.something() + .zzz); + +// Nothing to chain to. +let x = svg() + .zzz; + +// Nothing to chain to. +let x = svg().mumble.x() + 73 + .zzz; + +// Local Variables: +// indent-tabs-mode: nil +// js-chain-indent: t +// js-indent-level: 2 +// End: diff --git a/test/manual/indent/js.js b/test/manual/indent/js.js index d004b82f8b..846c3a1a5c 100644 --- a/test/manual/indent/js.js +++ b/test/manual/indent/js.js @@ -124,6 +124,10 @@ if (x > 72 && do_something(); } +// Test that chaining doesn't happen when js-chain-indent is nil. +let x = svg.mumble() + .zzz; + // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 commit b47f97218efb8d9966e084bdfd8a86e8c47cf81d Author: Tom Tromey Date: Mon Jan 9 22:15:57 2017 -0700 Fix js-mode indentation bug Bug#15582: * lisp/progmodes/js.el (js--find-newline-backward): New function. (js--continued-expression-p): Use it. * test/manual/indent/js.js: Add new test. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 1484b79739..e84215d430 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1771,6 +1771,24 @@ This performs fontification according to `js--class-styles'." ;; return NaN anyway. Shouldn't be a problem. (memq (char-before) '(?, ?} ?{)))))))) +(defun js--find-newline-backward () + "Move backward to the nearest newline that is not in a block comment." + (let ((continue t) + (result t)) + (while continue + (setq continue nil) + (if (search-backward "\n" nil t) + (let ((parse (syntax-ppss))) + ;; We match the end of a // comment but not a newline in a + ;; block comment. + (when (nth 4 parse) + (goto-char (nth 8 parse)) + ;; If we saw a block comment, keep trying. + (unless (nth 7 parse) + (setq continue t)))) + (setq result nil))) + result)) + (defun js--continued-expression-p () "Return non-nil if the current line continues an expression." (save-excursion @@ -1780,7 +1798,7 @@ This performs fontification according to `js--class-styles'." (progn (forward-comment (- (point))) (not (memq (char-before) '(?, ?\[ ?\())))) - (and (js--re-search-backward "\n" nil t) + (and (js--find-newline-backward) (progn (skip-chars-backward " \t") (or (bobp) (backward-char)) diff --git a/test/manual/indent/js.js b/test/manual/indent/js.js index 806e9497ad..d004b82f8b 100644 --- a/test/manual/indent/js.js +++ b/test/manual/indent/js.js @@ -118,6 +118,12 @@ var arr = [ -5 ]; +// Regression test for bug#15582. +if (x > 72 && + y < 85) { // found + do_something(); +} + // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 commit cab7a385881b29df45338acd07dbc39ec703fa80 Author: Tom Tromey Date: Thu Jan 12 23:20:02 2017 -0700 Fix definition of EMACS in test/manual/indent/Makefile * test/manual/indent/Makefile (EMACS): Add one more "..". diff --git a/test/manual/indent/Makefile b/test/manual/indent/Makefile index 83162681d7..09cf4a2b77 100644 --- a/test/manual/indent/Makefile +++ b/test/manual/indent/Makefile @@ -1,5 +1,5 @@ RM=rm -EMACS=../../src/emacs +EMACS=../../../src/emacs all: clean $(addsuffix .test,$(wildcard *.*)) commit 765920f727f8be8c436abc67a91790d1f33f6706 Author: Tom Tromey Date: Mon Jan 9 20:44:19 2017 -0700 Add .jsx to auto-mode-alist Bug#25389: * lisp/files.el (auto-mode-alist): Add entry for .jsx. diff --git a/lisp/files.el b/lisp/files.el index fbd00af479..b57e35b9a0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2543,6 +2543,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) ("\\.jsm?\\'" . javascript-mode) ("\\.json\\'" . javascript-mode) + ("\\.jsx\\'" . js-jsx-mode) ("\\.[ds]?vh?\\'" . verilog-mode) ("\\.by\\'" . bovine-grammar-mode) ("\\.wy\\'" . wisent-grammar-mode) commit 05fe74bec239bebea84cb6803120321c367d67d3 Author: Tom Tromey Date: Mon Jan 9 20:42:43 2017 -0700 Fix two js-mode filling bugs Bug#19399 and Bug#22431: * lisp/progmodes/js.el (js-mode): Set comment-line-break-function and c-block-comment-start-regexp. * test/lisp/progmodes/js-tests.el: New file. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e3f64a8f32..1484b79739 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3760,6 +3760,8 @@ If one hasn't been set, or if it's stale, prompt for a new one." c-line-comment-starter "//" c-comment-start-regexp "/[*/]\\|\\s!" comment-start-skip "\\(//+\\|/\\*+\\)\\s *") + (setq-local comment-line-break-function #'c-indent-new-comment-line) + (setq-local c-block-comment-start-regexp "/\\*") (setq-local electric-indent-chars (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el new file mode 100644 index 0000000000..9bf7258eeb --- /dev/null +++ b/test/lisp/progmodes/js-tests.el @@ -0,0 +1,64 @@ +;;; js-tests.el --- Test suite for js-mode + +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'js) + +(ert-deftest js-mode-fill-bug-19399 () + (with-temp-buffer + (insert "/") + (save-excursion (insert "/ comment")) + (js-mode) + (fill-paragraph) + (should (equal (buffer-substring (point-min) (point-max)) + "// comment")))) + +(ert-deftest js-mode-fill-bug-22431 () + (with-temp-buffer + (insert "/**\n") + (insert " * Load the inspector's shared head.js for use by tests that ") + (insert "need to open the something or other") + (js-mode) + ;; This fails with auto-fill but not fill-paragraph. + (do-auto-fill) + (should (equal (buffer-substring (point-min) (point-max)) + "/** + * Load the inspector's shared head.js for use by tests that need to + * open the something or other")))) + +(ert-deftest js-mode-fill-bug-22431-fill-paragraph-at-start () + (with-temp-buffer + (insert "/**\n") + (insert " * Load the inspector's shared head.js for use by tests that ") + (insert "need to open the something or other") + (js-mode) + (goto-char (point-min)) + (fill-paragraph) + (should (equal (buffer-substring (point-min) (point-max)) + "/** + * Load the inspector's shared head.js for use by tests that need to + * open the something or other")))) + +(provide 'js-tests) + +;;; js-tests.el ends here commit d018843e0e8065b1c9de9474521db069e1aa0025 Author: Eli Zaretskii Date: Fri Jan 13 18:17:12 2017 +0200 Fix last change * test/src/thread-tests.el (threads-condvar-wait): Revert previous change. Make sure no other threads from previous tests are running, to avoid interfering with our thread counts. diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 22ea90727c..df8222a21a 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -257,14 +257,17 @@ (ert-deftest threads-condvar-wait () "test waiting on conditional variable" (let ((cv-mutex (make-mutex)) - (nthreads (length (all-threads))) new-thread) + ;; We could have spurious threads from the previous tests still + ;; running; wait for them to die. + (while (> (length (all-threads)) 1) + (thread-yield)) (setq threads-condvar (make-condition-variable cv-mutex)) (setq new-thread (make-thread #'threads-test-condvar-wait)) ;; Make sure new-thread is alive. (should (thread-alive-p new-thread)) - (should (= (length (all-threads)) (1+ nthreads))) + (should (= (length (all-threads)) 2)) ;; Wait for new-thread to become blocked on the condvar. (while (not (eq (thread--blocker new-thread) threads-condvar)) (thread-yield)) @@ -272,21 +275,18 @@ ;; Notify the waiting thread. (with-mutex cv-mutex (condition-notify threads-condvar t)) - ;; Allow new-thread to process the notification. Sleeping for too - ;; short time here will fail the length test below. - (sleep-for 1) + ;; Allow new-thread to process the notification. + (sleep-for 0.1) ;; Make sure the thread is still there. This used to fail due to ;; a bug in thread.c:condition_wait_callback. (should (thread-alive-p new-thread)) - (should (= (length (all-threads)) (1+ nthreads))) - (should (memq new-thread (all-threads))) - ;; Make sure the other thread waits at the condition variable again. + (should (= (length (all-threads)) 2)) (should (eq (thread--blocker new-thread) threads-condvar)) ;; Signal the thread. (thread-signal new-thread 'error '("Die, die, die!")) (sleep-for 0.1) ;; Make sure the thread died. - (should (= (length (all-threads)) nthreads)))) + (should (= (length (all-threads)) 1)))) ;;; threads.el ends here commit 26b5426de8a51b88556e1dc4c2c328875f2dfb01 Author: Eli Zaretskii Date: Fri Jan 13 18:05:38 2017 +0200 Fix the new condvar test * test/src/thread-tests.el (threads-condvar-wait): Enlarge the time we sleep in the main thread to let the other thread process notifications. diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 61809e1681..22ea90727c 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -272,8 +272,9 @@ ;; Notify the waiting thread. (with-mutex cv-mutex (condition-notify threads-condvar t)) - ;; Allow new-thread to process the notification. - (sleep-for 0.1) + ;; Allow new-thread to process the notification. Sleeping for too + ;; short time here will fail the length test below. + (sleep-for 1) ;; Make sure the thread is still there. This used to fail due to ;; a bug in thread.c:condition_wait_callback. (should (thread-alive-p new-thread)) commit 9c4d2afaa5786107aa79728b4703296b9289bf0b Author: Eli Zaretskii Date: Fri Jan 13 16:13:30 2017 +0200 Minor improvements in the new condvar test * test/src/thread-tests.el (threads-test-condvar-wait): Use with-mutex instead of emulating it inline. (threads-condvar-wait): Improve comments. Check that the new thread is alive before waiting for it to become blocked on the conditional variable. diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 71b20185d7..61809e1681 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -245,34 +245,37 @@ (should-not (thread-alive-p thread)))) (defvar threads-condvar nil) + (defun threads-test-condvar-wait () - ;; Wait for condvar to be notified - (mutex-lock (condition-mutex threads-condvar)) - (condition-wait threads-condvar) - (mutex-unlock (condition-mutex threads-condvar)) + ;; Wait for condvar to be notified. + (with-mutex (condition-mutex threads-condvar) + (condition-wait threads-condvar)) ;; Wait again, it will be signaled. (with-mutex (condition-mutex threads-condvar) (condition-wait threads-condvar))) (ert-deftest threads-condvar-wait () "test waiting on conditional variable" - (let* ((cv-mutex (make-mutex)) - (nthreads (length (all-threads))) - new-thread) + (let ((cv-mutex (make-mutex)) + (nthreads (length (all-threads))) + new-thread) (setq threads-condvar (make-condition-variable cv-mutex)) (setq new-thread (make-thread #'threads-test-condvar-wait)) - (while (not (eq (thread--blocker new-thread) threads-condvar)) - (thread-yield)) + + ;; Make sure new-thread is alive. (should (thread-alive-p new-thread)) (should (= (length (all-threads)) (1+ nthreads))) + ;; Wait for new-thread to become blocked on the condvar. + (while (not (eq (thread--blocker new-thread) threads-condvar)) + (thread-yield)) + ;; Notify the waiting thread. (with-mutex cv-mutex (condition-notify threads-condvar t)) - ;; Allow new-thread to process the notification. (sleep-for 0.1) ;; Make sure the thread is still there. This used to fail due to - ;; a bug in condition_wait_callback. + ;; a bug in thread.c:condition_wait_callback. (should (thread-alive-p new-thread)) (should (= (length (all-threads)) (1+ nthreads))) (should (memq new-thread (all-threads))) commit 03e4ab0d586069be65e4a17fbf4cd965a9984726 Author: Eli Zaretskii Date: Fri Jan 13 11:48:51 2017 +0200 Fix a bug in waiting for condition variable * src/thread.c (lisp_mutex_lock, lisp_mutex_unlock) (lisp_mutex_unlock_for_wait, condition_wait_callback) (condition_notify_callback): Improve commentary. (condition_wait_callback): Call post_acquire_global_lock before attempting to lock the mutex, to make sure the lock's owner is recorded correctly. * test/src/thread-tests.el (threads-condvar-wait): New test. diff --git a/src/thread.c b/src/thread.c index 01e8aa736c..5498fe5efc 100644 --- a/src/thread.c +++ b/src/thread.c @@ -128,6 +128,20 @@ lisp_mutex_init (lisp_mutex_t *mutex) sys_cond_init (&mutex->condition); } +/* Lock MUTEX setting its count to COUNT, if non-zero, or to 1 + otherwise. + + If MUTEX is locked by the current thread, COUNT must be zero, and + the MUTEX's lock count will be incremented. + + If MUTEX is locked by another thread, this function will release + the global lock, giving other threads a chance to run, and will + wait for the MUTEX to become unlocked; when MUTEX becomes unlocked, + and will then re-acquire the global lock. + + Return value is 1 if the function waited for the MUTEX to become + unlocked (meaning other threads could have run during the wait), + zero otherwise. */ static int lisp_mutex_lock (lisp_mutex_t *mutex, int new_count) { @@ -162,6 +176,12 @@ lisp_mutex_lock (lisp_mutex_t *mutex, int new_count) return 1; } +/* Decrement MUTEX's lock count. If the lock count becomes zero after + decrementing it, meaning the mutex is now unlocked, broadcast that + to all the threads that might be waiting to lock the mutex. This + function signals an error if MUTEX is locked by a thread other than + the current one. Return value is 1 if the mutex becomes unlocked, + zero otherwise. */ static int lisp_mutex_unlock (lisp_mutex_t *mutex) { @@ -177,6 +197,8 @@ lisp_mutex_unlock (lisp_mutex_t *mutex) return 1; } +/* Like lisp_mutex_unlock, but sets MUTEX's lock count to zero + regardless of its value. Return the previous lock count. */ static unsigned int lisp_mutex_unlock_for_wait (lisp_mutex_t *mutex) { @@ -241,6 +263,10 @@ mutex_lock_callback (void *arg) struct Lisp_Mutex *mutex = arg; struct thread_state *self = current_thread; + /* Calling lisp_mutex_lock might yield to other threads while this + one waits for the mutex to become unlocked, so we need to + announce us as the current thread by calling + post_acquire_global_lock. */ if (lisp_mutex_lock (&mutex->mutex, 0)) post_acquire_global_lock (self); } @@ -280,7 +306,7 @@ mutex_unlock_callback (void *arg) struct thread_state *self = current_thread; if (lisp_mutex_unlock (&mutex->mutex)) - post_acquire_global_lock (self); + post_acquire_global_lock (self); /* FIXME: is this call needed? */ } DEFUN ("mutex-unlock", Fmutex_unlock, Smutex_unlock, 1, 1, 0, @@ -367,12 +393,21 @@ condition_wait_callback (void *arg) if (NILP (self->error_symbol)) { self->wait_condvar = &cvar->cond; + /* This call could switch to another thread. */ sys_cond_wait (&cvar->cond, &global_lock); self->wait_condvar = NULL; } - lisp_mutex_lock (&mutex->mutex, saved_count); self->event_object = Qnil; + /* Since sys_cond_wait could switch threads, we need to re-establish + ourselves as the current thread, otherwise lisp_mutex_lock will + record the wrong thread as the owner of the mutex lock. */ post_acquire_global_lock (self); + /* Calling lisp_mutex_lock might yield to other threads while this + one waits for the mutex to become unlocked, so we need to + announce us as the current thread by calling + post_acquire_global_lock. */ + if (lisp_mutex_lock (&mutex->mutex, saved_count)) + post_acquire_global_lock (self); } DEFUN ("condition-wait", Fcondition_wait, Scondition_wait, 1, 1, 0, @@ -425,6 +460,10 @@ condition_notify_callback (void *arg) sys_cond_broadcast (&na->cvar->cond); else sys_cond_signal (&na->cvar->cond); + /* Calling lisp_mutex_lock might yield to other threads while this + one waits for the mutex to become unlocked, so we need to + announce us as the current thread by calling + post_acquire_global_lock. */ lisp_mutex_lock (&mutex->mutex, saved_count); post_acquire_global_lock (self); } diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 2e5a3bcc1f..71b20185d7 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -244,4 +244,45 @@ (sit-for 1) (should-not (thread-alive-p thread)))) +(defvar threads-condvar nil) +(defun threads-test-condvar-wait () + ;; Wait for condvar to be notified + (mutex-lock (condition-mutex threads-condvar)) + (condition-wait threads-condvar) + (mutex-unlock (condition-mutex threads-condvar)) + ;; Wait again, it will be signaled. + (with-mutex (condition-mutex threads-condvar) + (condition-wait threads-condvar))) + +(ert-deftest threads-condvar-wait () + "test waiting on conditional variable" + (let* ((cv-mutex (make-mutex)) + (nthreads (length (all-threads))) + new-thread) + (setq threads-condvar (make-condition-variable cv-mutex)) + (setq new-thread (make-thread #'threads-test-condvar-wait)) + (while (not (eq (thread--blocker new-thread) threads-condvar)) + (thread-yield)) + (should (thread-alive-p new-thread)) + (should (= (length (all-threads)) (1+ nthreads))) + ;; Notify the waiting thread. + (with-mutex cv-mutex + (condition-notify threads-condvar t)) + + ;; Allow new-thread to process the notification. + (sleep-for 0.1) + ;; Make sure the thread is still there. This used to fail due to + ;; a bug in condition_wait_callback. + (should (thread-alive-p new-thread)) + (should (= (length (all-threads)) (1+ nthreads))) + (should (memq new-thread (all-threads))) + ;; Make sure the other thread waits at the condition variable again. + (should (eq (thread--blocker new-thread) threads-condvar)) + + ;; Signal the thread. + (thread-signal new-thread 'error '("Die, die, die!")) + (sleep-for 0.1) + ;; Make sure the thread died. + (should (= (length (all-threads)) nthreads)))) + ;;; threads.el ends here