commit 6f94c2405f4c82b63da19de89549aff1fad7e594 (HEAD, refs/remotes/origin/master) Author: Lars Ingebrigtsen Date: Sun Aug 2 09:43:41 2020 +0200 Fix erc bug when there's two channels with the same name * lisp/erc/erc.el (erc-generate-new-buffer-name): Fix logic when there's two channels with the same name from two different servers (bug#40121). diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bfe8a2b42e..8830dd4c45 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1622,10 +1622,12 @@ symbol, it may have these values: (if (and (not buffer-name) erc-reuse-buffers (or (not (get-buffer candidate)) - (or target - (with-current-buffer (get-buffer candidate) - (and (erc-server-buffer-p) - (not (erc-server-process-alive))))) + ;; Looking for a server buffer, so there's no target. + (and (not target) + (with-current-buffer (get-buffer candidate) + (and (erc-server-buffer-p) + (not (erc-server-process-alive))))) + ;; Channel buffer; check that it's from the right server. (with-current-buffer (get-buffer candidate) (and (string= erc-session-server server) (erc-port-equal erc-session-port port))))) commit eab636c7eb25c4e1cbfeb0fc48cc1274e1c55222 Author: Lars Ingebrigtsen Date: Sun Aug 2 09:04:31 2020 +0200 Try to fix mailcap parsing again to respect Emacs defaults * lisp/net/mailcap.el (mailcap--computed-mime-data): New variable. (mailcap-parse-mailcaps): Don't delete Emacs-distributed fallback values (bug#40247). (mailcap-add-mailcap-entry): Extend to allow working on different variables. (mailcap-add): Store data in mailcap-user-mime-data, since it should be heeded first. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 5fe5b4d3a5..86f9d2bf07 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -29,6 +29,7 @@ ;;; Code: +(require 'cl-lib) (autoload 'mail-header-parse-content-type "mail-parse") (defgroup mailcap nil @@ -337,6 +338,10 @@ is a string or list of strings, it represents a shell command to run to return a true or false shell value for the validity.") (put 'mailcap-mime-data 'risky-local-variable t) +(defvar mailcap--computed-mime-data nil + "Computed version of the mailcap data incorporating all sources. +Same format as `mailcap-mime-data'.") + (defcustom mailcap-download-directory nil "Directory to which `mailcap-save-binary-file' downloads files by default. nil means your home directory." @@ -422,7 +427,13 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (when (or (not mailcap-parsed-p) force) ;; Clear out all old data. - (setq mailcap-mime-data nil) + (setq mailcap--computed-mime-data nil) + ;; Add the Emacs-distributed defaults (which will be used as + ;; fallbacks). Do it this way instead of just copying the list, + ;; since entries are destructively modified. + (cl-loop for (major . minors) in mailcap-mime-data + do (cl-loop for (minor . entry) in minors + do (mailcap-add-mailcap-entry major minor entry))) (cond (path nil) ((getenv "MAILCAPS") @@ -709,10 +720,13 @@ to supply to the test." (push (list otest result) mailcap-viewer-test-cache) result)))) -(defun mailcap-add-mailcap-entry (major minor info) - (let ((old-major (assoc major mailcap-mime-data))) +(defun mailcap-add-mailcap-entry (major minor info &optional storage) + (let* ((storage (or storage 'mailcap--computed-mime-data)) + (old-major (assoc major (symbol-value storage)))) (if (null old-major) ; New major area - (push (cons major (list (cons minor info))) mailcap-mime-data) + (set storage + (cons (cons major (list (cons minor info))) + (symbol-value storage))) (let ((cur-minor (assoc minor old-major))) (cond ((or (null cur-minor) ; New minor area, or @@ -736,11 +750,15 @@ If TEST is not given, it defaults to t." (when (or (not (car tl)) (not (cadr tl))) (error "%s is not a valid MIME type" type)) - (mailcap-add-mailcap-entry - (car tl) (cadr tl) - `((viewer . ,viewer) - (test . ,(if test test t)) - (type . ,type))))) + (let ((entry + `((viewer . ,viewer) + (test . ,(if test test t)) + (type . ,type)))) + ;; Store it. + (mailcap-add-mailcap-entry (car tl) (cadr tl) entry + 'mailcap-user-mime-data) + ;; Make it available for usage. + (mailcap-add-mailcap-entry (car tl) (cadr tl) entry)))) ;;; ;;; The main whabbo @@ -791,13 +809,13 @@ If NO-DECODE is non-nil, don't decode STRING." ;; NO-DECODE avoids calling `mail-header-parse-content-type' from ;; `mail-parse.el' (let ( - major ; Major encoding (text, etc) - minor ; Minor encoding (html, etc) - info ; Other info - major-info ; (assoc major mailcap-mime-data) - viewers ; Possible viewers - passed ; Viewers that passed the test - viewer ; The one and only viewer + major ; Major encoding (text, etc) + minor ; Minor encoding (html, etc) + info ; Other info + major-info ; (assoc major mailcap--computed-mime-data) + viewers ; Possible viewers + passed ; Viewers that passed the test + viewer ; The one and only viewer ctl) (save-excursion (setq ctl @@ -809,12 +827,12 @@ If NO-DECODE is non-nil, don't decode STRING." (if viewer (setq passed (list viewer)) ;; None found, so heuristically select some applicable viewer - ;; from `mailcap-mime-data'. + ;; from `mailcap--computed-mime-data'. (mailcap-parse-mailcaps nil t) (setq major (split-string (car ctl) "/")) (setq minor (cadr major) major (car major)) - (when (setq major-info (cdr (assoc major mailcap-mime-data))) + (when (setq major-info (cdr (assoc major mailcap--computed-mime-data))) (when (setq viewers (mailcap-possible-viewers major-info minor)) (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) (cdr a))) @@ -847,7 +865,7 @@ If NO-DECODE is non-nil, don't decode STRING." ((eq request 'all) passed) (t - ;; MUST make a copy *sigh*, else we modify mailcap-mime-data + ;; MUST make a copy *sigh*, else we modify mailcap--computed-mime-data (setq viewer (copy-sequence viewer)) (let ((view (assq 'viewer viewer)) (test (assq 'test viewer))) @@ -1057,7 +1075,7 @@ For instance, \"foo.png\" will result in \"image/png\"." (nconc (mapcar 'cdr mailcap-mime-extensions) (let (res type) - (dolist (data mailcap-mime-data) + (dolist (data mailcap--computed-mime-data) (dolist (info (cdr data)) (setq type (cdr (assq 'type (cdr info)))) (unless (string-match-p "\\*" type) @@ -1117,7 +1135,7 @@ For instance, \"foo.png\" will result in \"image/png\"." (defun mailcap-view-mime (type) "View the data in the current buffer that has MIME type TYPE. -`mailcap-mime-data' determines the method to use." +`mailcap--computed-mime-data' determines the method to use." (let ((method (mailcap-mime-info type))) (if (stringp method) (shell-command-on-region (point-min) (point-max) commit 8f181124dfc84b9a7fcadb895af6ce2978d8a40e Author: Lars Ingebrigtsen Date: Sun Aug 2 07:55:02 2020 +0200 Make some erc function aliases obsolete * lisp/erc/erc-networks.el (erc-current-network): * lisp/erc/erc-join.el (erc-autojoin-channels-delayed): * lisp/erc/erc-backend.el (erc-server-setup-periodical-ping) (erc-server-send-ping, erc-server-send-queue): * lisp/erc/erc-autoaway.el (erc-autoaway-reestablish-idletimer) (autoaway): Adjust callers. * lisp/erc/erc-compat.el (erc-with-selected-window) (erc-cancel-timer, erc-make-obsolete) (erc-make-obsolete-variable): Make these aliases obsolete. diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el index 0950cec4f7..0923ed6e73 100644 --- a/lisp/erc/erc-autoaway.el +++ b/lisp/erc/erc-autoaway.el @@ -54,7 +54,7 @@ If `erc-autoaway-idle-method' is `emacs', you must call this function each time you change `erc-autoaway-idle-seconds'." (interactive) (when erc-autoaway-idletimer - (erc-cancel-timer erc-autoaway-idletimer)) + (cancel-timer erc-autoaway-idletimer)) (setq erc-autoaway-idletimer (run-with-idle-timer erc-autoaway-idle-seconds t @@ -133,7 +133,7 @@ Related variables: `erc-public-away-p' and `erc-away-nickname'." (remove-hook 'erc-after-connect 'erc-autoaway-insinuate-maybe) (remove-hook 'erc-disconnected-hook 'erc-autoaway-remove-maybe)) ((eq erc-autoaway-idle-method 'emacs) - (erc-cancel-timer erc-autoaway-idletimer) + (cancel-timer erc-autoaway-idletimer) (setq erc-autoaway-idletimer nil))) (remove-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away) (remove-hook 'erc-server-305-functions 'erc-autoaway-reset-indicators)))) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 654fc23ae7..4f3d85ba3c 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -520,7 +520,8 @@ If no subword-mode is active, then this is "Set up a timer to periodically ping the current server. The current buffer is given by BUFFER." (with-current-buffer buffer - (and erc-server-ping-handler (erc-cancel-timer erc-server-ping-handler)) + (when erc-server-ping-handler + (cancel-timer erc-server-ping-handler)) (when erc-server-send-ping-interval (setq erc-server-ping-handler (run-with-timer 4 erc-server-send-ping-interval @@ -533,7 +534,7 @@ The current buffer is given by BUFFER." (if timer-tuple ;; this buffer already has a timer. Cancel it and set the new one (progn - (erc-cancel-timer (cdr timer-tuple)) + (cancel-timer (cdr timer-tuple)) (setf (cdr (assq buffer erc-server-ping-timer-alist)) erc-server-ping-handler)) ;; no existing timer for this buffer. Add new one @@ -731,7 +732,7 @@ Conditionally try to reconnect and take appropriate action." (erc-with-all-buffers-of-server cproc nil (setq erc-server-connected nil)) (when erc-server-ping-handler - (progn (erc-cancel-timer erc-server-ping-handler) + (progn (cancel-timer erc-server-ping-handler) (setq erc-server-ping-handler nil))) (run-hook-with-args 'erc-disconnected-hook (erc-current-nick) (system-name) "") @@ -856,7 +857,7 @@ Additionally, detect whether the IRC process has hung." ;; remove timer if the server buffer has been killed (let ((timer (assq buf erc-server-ping-timer-alist))) (when timer - (erc-cancel-timer (cdr timer)) + (cancel-timer (cdr timer)) (setcdr timer nil))))) ;; From Circe @@ -868,7 +869,7 @@ protection algorithm." (with-current-buffer buffer (let ((now (current-time))) (when erc-server-flood-timer - (erc-cancel-timer erc-server-flood-timer) + (cancel-timer erc-server-flood-timer) (setq erc-server-flood-timer nil)) (when (time-less-p erc-server-flood-last-message now) (setq erc-server-flood-last-message (erc-emacs-time-to-erc-time now))) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index c77d5abf2e..388728b04a 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -79,10 +79,12 @@ START is the beginning position of the last match (see `match-beginning'). See `replace-match' for explanations of FIXEDCASE and LITERAL." (replace-match newtext fixedcase literal string subexp)) -(defalias 'erc-with-selected-window 'with-selected-window) -(defalias 'erc-cancel-timer 'cancel-timer) -(defalias 'erc-make-obsolete 'make-obsolete) -(defalias 'erc-make-obsolete-variable 'make-obsolete-variable) +(define-obsolete-function-alias 'erc-with-selected-window + #'with-selected-window "28.1") +(define-obsolete-function-alias 'erc-cancel-timer #'cancel-timer "28.1") +(define-obsolete-function-alias 'erc-make-obsolete #'make-obsolete "28.1") +(define-obsolete-function-alias 'erc-make-obsolete-variable + #'make-obsolete-variable "28.1") ;; Provide a simpler replacement for `member-if' (defun erc-member-if (predicate list) diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 280d6bfe0f..e4faf6bd79 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -113,7 +113,7 @@ servers, presumably in the same domain." This is called from a timer set up by `erc-autojoin-channels'." (if erc--autojoin-timer (setq erc--autojoin-timer - (erc-cancel-timer erc--autojoin-timer))) + (cancel-timer erc--autojoin-timer))) (with-current-buffer buffer ;; Don't kick of another delayed autojoin or try to wait for ;; another ident response: @@ -127,7 +127,7 @@ This is called from a timer set up by `erc-autojoin-channels'." This function is run from `erc-nickserv-identified-hook'." (if erc--autojoin-timer (setq erc--autojoin-timer - (erc-cancel-timer erc--autojoin-timer))) + (cancel-timer erc--autojoin-timer))) (when (eq erc-autojoin-timing 'ident) (let ((server (or erc-session-server erc-server-announced-name)) (joined (mapcar (lambda (buf) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 1234962c51..415fb53fee 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -756,8 +756,8 @@ Return the name of this server's network as a symbol." (erc-with-server-buffer (intern (downcase (symbol-name erc-network))))) -(erc-make-obsolete 'erc-current-network 'erc-network - "Obsolete since erc-networks 1.5") +(make-obsolete 'erc-current-network 'erc-network + "Obsolete since erc-networks 1.5") (defun erc-network-name () "Return the name of the current network as a string." commit 882448746778f3d63e7e793f1d5866014ad2f005 Author: Lars Ingebrigtsen Date: Sun Aug 2 07:48:30 2020 +0200 Fix race condition in erc-server-send-queue vs quitting erc * lisp/erc/erc-backend.el (erc-server-send-queue): Check that the buffer is live before using it (bug#40418). This fixes a rare problem when the queue is non-empty when `erc-quit-server' is run. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 1e2526f35c..654fc23ae7 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -864,41 +864,42 @@ Additionally, detect whether the IRC process has hung." "Send messages in `erc-server-flood-queue'. See `erc-server-flood-margin' for an explanation of the flood protection algorithm." - (with-current-buffer buffer - (let ((now (current-time))) - (when erc-server-flood-timer - (erc-cancel-timer erc-server-flood-timer) - (setq erc-server-flood-timer nil)) - (when (time-less-p erc-server-flood-last-message now) - (setq erc-server-flood-last-message (erc-emacs-time-to-erc-time now))) - (while (and erc-server-flood-queue - (time-less-p erc-server-flood-last-message - (time-add now erc-server-flood-margin))) - (let ((msg (caar erc-server-flood-queue)) - (encoding (cdar erc-server-flood-queue))) - (setq erc-server-flood-queue (cdr erc-server-flood-queue) - erc-server-flood-last-message - (+ erc-server-flood-last-message - erc-server-flood-penalty)) - (erc-log-irc-protocol msg 'outbound) - (erc-log (concat "erc-server-send-queue: " - msg "(" (buffer-name buffer) ")")) - (when (erc-server-process-alive) - (condition-case nil - ;; Set encoding just before sending the string - (progn - (when (fboundp 'set-process-coding-system) - (set-process-coding-system erc-server-process - 'raw-text encoding)) - (process-send-string erc-server-process msg)) - ;; Sometimes the send can occur while the process is - ;; being killed, which results in a weird SIGPIPE error. - ;; Catch this and ignore it. - (error nil))))) - (when erc-server-flood-queue - (setq erc-server-flood-timer - (run-at-time (+ 0.2 erc-server-flood-penalty) - nil #'erc-server-send-queue buffer)))))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (let ((now (current-time))) + (when erc-server-flood-timer + (erc-cancel-timer erc-server-flood-timer) + (setq erc-server-flood-timer nil)) + (when (time-less-p erc-server-flood-last-message now) + (setq erc-server-flood-last-message (erc-emacs-time-to-erc-time now))) + (while (and erc-server-flood-queue + (time-less-p erc-server-flood-last-message + (time-add now erc-server-flood-margin))) + (let ((msg (caar erc-server-flood-queue)) + (encoding (cdar erc-server-flood-queue))) + (setq erc-server-flood-queue (cdr erc-server-flood-queue) + erc-server-flood-last-message + (+ erc-server-flood-last-message + erc-server-flood-penalty)) + (erc-log-irc-protocol msg 'outbound) + (erc-log (concat "erc-server-send-queue: " + msg "(" (buffer-name buffer) ")")) + (when (erc-server-process-alive) + (condition-case nil + ;; Set encoding just before sending the string + (progn + (when (fboundp 'set-process-coding-system) + (set-process-coding-system erc-server-process + 'raw-text encoding)) + (process-send-string erc-server-process msg)) + ;; Sometimes the send can occur while the process is + ;; being killed, which results in a weird SIGPIPE error. + ;; Catch this and ignore it. + (error nil))))) + (when erc-server-flood-queue + (setq erc-server-flood-timer + (run-at-time (+ 0.2 erc-server-flood-penalty) + nil #'erc-server-send-queue buffer))))))) (defun erc-message (message-command line &optional force) "Send LINE to the server as a privmsg or a notice. commit 6ec71e829a272e562c541ef5c93213d2fac3d3d7 Author: Philipp Stephani Date: Sat Aug 1 21:34:46 2020 +0200 * src/alloc.c (mark_maybe_object): Make overflow check conditional. diff --git a/src/alloc.c b/src/alloc.c index e556fc86a3..e139d8cf26 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4643,7 +4643,13 @@ mark_maybe_object (Lisp_Object obj) bool overflow = INT_SUBTRACT_WRAPV (offset, LISP_WORD_TAG (type_tag), &offset); +#if !defined WIDE_EMACS_INT || USE_LSB_TAG + /* If we don't use wide integers, then `intptr_t' should always be + large enough to not overflow. Furthermore, when using the least + significant bits as tag bits, the tag is small enough to not + overflow either. */ eassert (!overflow); +#endif void *po = (char *) ((intptr_t) (char *) XLP (obj) + offset); /* If the pointer is in the dump image and the dump has a record commit fce47c93252fe0be14e8c169f6bab8b0fd512cab Author: Philipp Stephani Date: Sat Aug 1 21:01:24 2020 +0200 Improve offset calculation in wide int builds * src/alloc.c (mark_maybe_object): Make sure that OFFSET isn’t widened during subtraction. diff --git a/src/alloc.c b/src/alloc.c index f203061161..e556fc86a3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4641,8 +4641,10 @@ mark_maybe_object (Lisp_Object obj) break; } - void *po = (char *) ((intptr_t) (char *) XLP (obj) - + (offset - LISP_WORD_TAG (type_tag))); + bool overflow + = INT_SUBTRACT_WRAPV (offset, LISP_WORD_TAG (type_tag), &offset); + eassert (!overflow); + void *po = (char *) ((intptr_t) (char *) XLP (obj) + offset); /* If the pointer is in the dump image and the dump has a record of the object starting at the place where the pointer points, we commit 1d70fbe4c83d6439716a054f6c074202c534a425 Author: Philipp Stephani Date: Sat Aug 1 20:59:09 2020 +0200 * src/alloc.c (resize_string_data): Adjust string bytes (Bug#42540) diff --git a/src/alloc.c b/src/alloc.c index 5b9c6e4eb1..f203061161 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1947,6 +1947,9 @@ resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte, /* No need to reallocate, as the size change falls within the alignment slop. */ XSTRING (string)->u.s.size_byte = new_nbytes; +#ifdef GC_CHECK_STRING_BYTES + SDATA_NBYTES (old_sdata) = new_nbytes; +#endif new_charaddr = data + cidx_byte; memmove (new_charaddr + new_clen, new_charaddr + clen, nbytes - (cidx_byte + (clen - 1))); commit a8f99d113c0556fd2860304ac7d7ff1c8f7c3ad4 Author: Alan Third Date: Wed May 20 21:28:25 2020 +0100 Recreate macOS color list if it is corrupt * src/nsterm.m (ns_term_init): Generate the color list if there are less colors in the existing file than in rgb.txt. diff --git a/src/nsterm.m b/src/nsterm.m index 0e405fc017..df7f716f51 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5476,7 +5476,8 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. { NSColorList *cl = [NSColorList colorListNamed: @"Emacs"]; - if ( cl == nil ) + /* There are 752 colors defined in rgb.txt. */ + if ( cl == nil || [[cl allKeys] count] < 752) { Lisp_Object color_file, color_map, color; unsigned long c; commit b04d391d796281faf0f824ed398b26a9a1758f8d Author: Michael Albinus Date: Sat Aug 1 20:08:44 2020 +0200 Implement alternative for Tramp's signal return string * lisp/net/tramp-adb.el (process-file-return-signal-string): Declare. (tramp-adb-get-signal-strings): New defun. (tramp-adb-handle-process-file): Use it. * lisp/net/tramp-sh.el (process-file-return-signal-string): Declare. (tramp-sh-get-signal-strings): New defun. (tramp-sh-handle-process-file): Use it. * lisp/net/tramp.el (tramp-get-signal-strings): Remove function. * test/lisp/net/tramp-tests.el (tramp-test28-process-file): Accept alternative signal return string. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c1eb36e340..7e5af6910b 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -35,6 +35,8 @@ (require 'tramp) +(defvar process-file-return-signal-string) + ;;;###tramp-autoload (defcustom tramp-adb-program "adb" "Name of the Android Debug Bridge program." @@ -741,6 +743,33 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid) (delete-file filename))))))) +(defun tramp-adb-get-signal-strings (vec) + "Strings to return by `process-file' in case of signals." + (with-tramp-connection-property vec "signal-strings" + (let ((default-directory (tramp-make-tramp-file-name vec 'localname)) + ;; `shell-file-name' and `shell-command-switch' are needed + ;; for Emacs < 27.1, which doesn't support connection-local + ;; variables in `shell-command'. + (shell-file-name "/system/bin/sh") + (shell-command-switch "-c") + process-file-return-signal-string signals result) + (dotimes (i 128) (push (format "Signal %d" i) result)) + (setq result (reverse result) + signals (split-string + (shell-command-to-string "COLUMNS=40 kill -l") "\n" 'omit)) + (setcar result 0) + (dolist (line signals) + (when (string-match + (concat + "^[[:space:]]*\\([[:digit:]]+\\)" + "[[:space:]]+\\S-+[[:space:]]+" + "\\([[:alpha:]].*\\)$") + line) + (setcar + (nthcdr (string-to-number (match-string 1 line)) result) + (match-string 2 line)))) + result))) + (defun tramp-adb-handle-process-file (program &optional infile destination display &rest args) "Like `process-file' for Tramp files." @@ -833,7 +862,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; since Emacs 28.1. (when (and (bound-and-true-p process-file-return-signal-string) (natnump ret) (> ret 128)) - (setq ret (nth (- ret 128) (tramp-get-signal-strings)))) + (setq ret (nth (- ret 128) (tramp-adb-get-signal-strings v)))) ;; Provide error file. (when tmpstderr (rename-file tmpstderr (cadr destination) t)) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1a867c30fe..9f37207def 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -36,6 +36,7 @@ (declare-function dired-remove-file "dired-aux") (defvar dired-compress-file-suffixes) +(defvar process-file-return-signal-string) (defvar vc-handled-backends) (defvar vc-bzr-program) (defvar vc-git-program) @@ -3009,6 +3010,61 @@ STDERR can also be a file name." (tramp-flush-connection-property v "process-name") (tramp-flush-connection-property v "process-buffer")))))))) +(defun tramp-sh-get-signal-strings (vec) + "Strings to return by `process-file' in case of signals." + (with-tramp-connection-property + vec + (concat + "signal-strings-" (tramp-get-method-parameter vec 'tramp-remote-shell)) + (let ((default-directory (tramp-make-tramp-file-name vec 'localname)) + process-file-return-signal-string signals res result) + (setq signals + (append + '(0) (split-string (shell-command-to-string "kill -l") nil 'omit))) + ;; Sanity check. "kill -l" shall have returned just the signal + ;; names. Some shells don't, like the one in "docker alpine". + (let (signal-hook-function) + (condition-case nil + (dolist (sig (cdr signals)) + (unless (string-match-p "^[[:alnum:]+-]+$" sig) + (error nil))) + (error (setq signals '(0))))) + (dotimes (i 128) + (push + (cond + ;; Some predefined values, which aren't reported sometimes, + ;; or would raise problems (all Stopped signals). + ((= i 0) 0) + ((string-equal (nth i signals) "HUP") "Hangup") + ((string-equal (nth i signals) "INT") "Interrupt") + ((string-equal (nth i signals) "QUIT") "Quit") + ((string-equal (nth i signals) "STOP") "Stopped (signal)") + ((string-equal (nth i signals) "TSTP") "Stopped") + ((string-equal (nth i signals) "TTIN") "Stopped (tty input)") + ((string-equal (nth i signals) "TTOU") "Stopped (tty output)") + (t (setq res + (if (null (nth i signals)) + "" + (tramp-send-command + vec + (format + "%s %s %s" + (tramp-get-method-parameter vec 'tramp-remote-shell) + (mapconcat + #'identity + (tramp-get-method-parameter vec 'tramp-remote-shell-args) + " ") + (tramp-shell-quote-argument (format "kill -%d $$" i)))) + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (buffer-substring (point-at-bol) (point-at-eol))))) + (if (string-equal res "") + (format "Signal %d" i) + res))) + result)) + ;; Due to Bug#41287, we cannot add this to the `dotimes' clause. + (reverse result)))) + (defun tramp-sh-handle-process-file (program &optional infile destination display &rest args) "Like `process-file' for Tramp files." @@ -3126,7 +3182,7 @@ STDERR can also be a file name." ;; since Emacs 28.1. (when (and (bound-and-true-p process-file-return-signal-string) (natnump ret) (>= ret 128)) - (setq ret (nth (- ret 128) (tramp-get-signal-strings)))) + (setq ret (nth (- ret 128) (tramp-sh-get-signal-strings v)))) ;; Provide error file. (when tmpstderr (rename-file tmpstderr (cadr destination) t)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 19cf333450..c169a86f91 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5108,23 +5108,6 @@ name of a process or buffer, or nil to default to the current buffer." (lambda () (remove-hook 'interrupt-process-functions #'tramp-interrupt-process)))) -(defun tramp-get-signal-strings () - "Strings to return by `process-file' in case of signals." - ;; We use key nil for local connection properties. - (with-tramp-connection-property nil "signal-strings" - (let (result) - (if (and (stringp shell-file-name) (executable-find shell-file-name)) - (dotimes (i 128) - (push - (if (= i 19) 1 ;; SIGSTOP - (call-process - shell-file-name nil nil nil "-c" (format "kill -%d $$" i))) - result)) - (dotimes (i 128) - (push (format "Signal %d" i) result))) - ;; Due to Bug#41287, we cannot add this to the `dotimes' clause. - (reverse result)))) - ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 34782e7f15..19da15acaf 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4256,8 +4256,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; there's an indication for a signal describing string. (let ((process-file-return-signal-string t)) (should - (string-equal - "Interrupt" + (string-match + "Interrupt\\|Signal 2" (process-file (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh") nil nil nil "-c" "kill -2 $$")))) commit f1097d7af89c530327b92af2269fc1818559cb0f Author: Glenn Morris Date: Sat Aug 1 09:42:44 2020 -0700 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index dd363b690f..ae58bfc566 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -7126,8 +7126,10 @@ Otherwise return a description formatted by of `eldoc-echo-area-use-multiline-p' variable and width of minibuffer window for width limit. -This function is meant to be used as a value of -`eldoc-documentation-function' variable." nil nil) +This function can be used as a value of +`eldoc-documentation-functions' variable. + +\(fn CALLBACK &rest _)" nil nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "descr-text" '("describe-"))) @@ -9949,7 +9951,7 @@ It creates an autoload function for CNAME's constructor. ;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/eldoc.el -(push (purecopy '(eldoc 1 0 0)) package--builtin-versions) +(push (purecopy '(eldoc 1 8 0)) package--builtin-versions) ;;;*** @@ -10256,6 +10258,10 @@ some major modes from being locked under some circumstances. Report a bug in GNU Emacs. Prompts for bug subject. Leaves you in a mail buffer. +Already submitted bugs can be found in the Emacs bug tracker: + + https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1 + \(fn TOPIC &optional UNUSED)" t nil) (set-advertised-calling-convention 'report-emacs-bug '(topic) '"24.5") @@ -11860,6 +11866,14 @@ Edit the hotlist of directory servers in a specialized buffer." t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-mab" '("eudc-"))) +;;;*** + +;;;### (autoloads nil "eudcb-macos-contacts" "net/eudcb-macos-contacts.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from net/eudcb-macos-contacts.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eudcb-macos-contacts" '("eudc-macos-contacts-"))) + ;;;*** ;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (0 0 0 0)) @@ -11909,7 +11923,11 @@ word(s) will be searched for via `eww-search-prefix'. If called with a prefix ARG, use a new buffer instead of reusing the default EWW buffer. -\(fn URL &optional ARG)" t nil) +If BUFFER, the data to be rendered is in that buffer. In that +case, this function doesn't actually fetch URL. BUFFER will be +killed after rendering. + +\(fn URL &optional ARG BUFFER)" t nil) (defalias 'browse-web 'eww) (autoload 'eww-open-file "eww" "\ @@ -11949,7 +11967,7 @@ instead of `browse-url-new-window-flag'. (autoload 'eww-list-bookmarks "eww" "\ Display the bookmarks." t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eww" '("eww-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "eww" '("erc--download-directory" "eww-"))) ;;;*** @@ -13100,7 +13118,7 @@ lines. ;;;### (autoloads nil "flymake" "progmodes/flymake.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/flymake.el -(push (purecopy '(flymake 1 0 8)) package--builtin-versions) +(push (purecopy '(flymake 1 0 9)) package--builtin-versions) (autoload 'flymake-log "flymake" "\ Log, at level LEVEL, the message MSG formatted with ARGS. @@ -14140,8 +14158,13 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. (when (fboundp 'custom-autoload) (custom-autoload 'gnus-select-method "gnus")) +(autoload 'gnus-child-no-server "gnus" "\ +Read network news as a child, without connecting to the local server. + +\(fn &optional ARG)" t nil) + (autoload 'gnus-slave-no-server "gnus" "\ -Read network news as a slave, without connecting to the local server. +Read network news as a child, without connecting to the local server. \(fn &optional ARG)" t nil) @@ -14154,10 +14177,15 @@ an NNTP server to use. As opposed to `gnus', this command will not connect to the local server. -\(fn &optional ARG SLAVE)" t nil) +\(fn &optional ARG CHILD)" t nil) + +(autoload 'gnus-child "gnus" "\ +Read news as a child. + +\(fn &optional ARG)" t nil) (autoload 'gnus-slave "gnus" "\ -Read news as a slave. +Read news as a child. \(fn &optional ARG)" t nil) @@ -14180,7 +14208,7 @@ If ARG is non-nil and a positive number, Gnus will use that as the startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. -\(fn &optional ARG DONT-CONNECT SLAVE)" t nil) +\(fn &optional ARG DONT-CONNECT CHILD)" t nil) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnus" '("gnus-"))) @@ -14195,8 +14223,13 @@ Start Gnus unplugged." t nil) (autoload 'gnus-plugged "gnus-agent" "\ Start Gnus plugged." t nil) +(autoload 'gnus-child-unplugged "gnus-agent" "\ +Read news as a child unplugged. + +\(fn &optional ARG)" t nil) + (autoload 'gnus-slave-unplugged "gnus-agent" "\ -Read news as a slave unplugged. +Read news as a child unplugged. \(fn &optional ARG)" t nil) @@ -19868,7 +19901,7 @@ done. Otherwise, it uses the current buffer. \(fn CALLBACK &optional SETUP PARAMS BUFFER MODE &rest IGNORE)" nil nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "log-edit" '("log-edit-" "vc-log-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "log-edit" '("log-edit-"))) ;;;*** @@ -20543,7 +20576,7 @@ Previous contents of that buffer are killed first." t nil) ;;;### (autoloads nil "man" "man.el" (0 0 0 0)) ;;; Generated autoloads from man.el -(defalias 'manual-entry 'man) +(define-obsolete-function-alias 'manual-entry 'man "28.1") (autoload 'man "man" "\ Get a Un*x manual page and put it in a buffer. @@ -20582,6 +20615,10 @@ names or descriptions. The pattern argument is usually an -k pattern +Note that in some cases you will need to use \\[quoted-insert] to quote the +SPC character in the above examples, because this command attempts +to auto-complete your input based on the installed manual pages. + \(fn MAN-ARGS)" t nil) (autoload 'man-follow "man" "\ @@ -22313,7 +22350,10 @@ writes. See `make-network-process' for details. :capability-command specifies a command used to query the HOST for its capabilities. For instance, for IMAP this should be - \"1 CAPABILITY\\r\\n\". + \"1 CAPABILITY\\r\\n\". This can either be a string (which will + then be sent verbatim to the server), or a function (called with + a single parameter; the \"greeting\" from the server when connecting), + and should return a string to send to the server. :starttls-function specifies a function for handling STARTTLS. This function should take one parameter, the response to the @@ -26254,19 +26294,57 @@ Open profile FILENAME. ;;;### (autoloads nil "project" "progmodes/project.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 4 0)) package--builtin-versions) +(push (purecopy '(project 0 5 0)) package--builtin-versions) (autoload 'project-current "project" "\ -Return the project instance in DIR or `default-directory'. -When no project found in DIR, and MAYBE-PROMPT is non-nil, ask -the user for a different project to look in. +Return the project instance in DIRECTORY, defaulting to `default-directory'. + +When no project is found in that directory, the result depends on +the value of MAYBE-PROMPT: if it is nil or omitted, return nil, +else ask the user for a directory in which to look for the +project, and if no project is found there, return a \"transient\" +project instance. -\(fn &optional MAYBE-PROMPT DIR)" nil nil) +The \"transient\" project instance is a special kind of value +which denotes a project rooted in that directory and includes all +the files under the directory except for those that should be +ignored (per `project-ignores'). -(defvar project-prefix-map (let ((map (make-sparse-keymap))) (define-key map "f" 'project-find-file) (define-key map "b" 'project-switch-to-buffer) (define-key map "s" 'project-shell) (define-key map "d" 'project-dired) (define-key map "v" 'project-vc-dir) (define-key map "c" 'project-compile) (define-key map "e" 'project-eshell) (define-key map "k" 'project-kill-buffers) (define-key map "p" 'project-switch-project) (define-key map "g" 'project-find-regexp) (define-key map "r" 'project-query-replace-regexp) map) "\ +See the doc string of `project-find-functions' for the general form +of the project instance object. + +\(fn &optional MAYBE-PROMPT DIRECTORY)" nil nil) + +(defvar project-prefix-map (let ((map (make-sparse-keymap))) (define-key map "f" 'project-find-file) (define-key map "F" 'project-or-external-find-file) (define-key map "b" 'project-switch-to-buffer) (define-key map "s" 'project-shell) (define-key map "d" 'project-dired) (define-key map "v" 'project-vc-dir) (define-key map "c" 'project-compile) (define-key map "e" 'project-eshell) (define-key map "k" 'project-kill-buffers) (define-key map "p" 'project-switch-project) (define-key map "g" 'project-find-regexp) (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) map) "\ Keymap for project commands.") (define-key ctl-x-map "p" project-prefix-map) +(autoload 'project-other-window-command "project" "\ +Run project command, displaying resultant buffer in another window. + +The following commands are available: + +\\{project-prefix-map} +\\{project-other-window-map}" t nil) + (define-key ctl-x-4-map "p" #'project-other-window-command) + +(autoload 'project-other-frame-command "project" "\ +Run project command, displaying resultant buffer in another frame. + +The following commands are available: + +\\{project-prefix-map} +\\{project-other-frame-map}" t nil) + (define-key ctl-x-5-map "p" #'project-other-frame-command) + +(autoload 'project-other-tab-command "project" "\ +Run project command, displaying resultant buffer in a new tab. + +The following commands are available: + +\\{project-prefix-map}" t nil) + (define-key tab-prefix-map "p" #'project-other-tab-command) + (autoload 'project-find-regexp "project" "\ Find all matches for REGEXP in the current project's roots. With \\[universal-argument] prefix, you can specify the directory @@ -26338,13 +26416,56 @@ Arguments the same as in `compile'. \(fn COMMAND &optional COMINT)" t nil) (autoload 'project-switch-to-buffer "project" "\ -Switch to another buffer that is related to the current project. -A buffer is related to a project if its `default-directory' -is inside the directory hierarchy of the project's root." t nil) +Display buffer BUFFER-OR-NAME in the selected window. +When called interactively, prompts for a buffer belonging to the +current project. Two buffers belong to the same project if their +project instances, as reported by `project-current' in each +buffer, are identical. + +\(fn BUFFER-OR-NAME)" t nil) + +(autoload 'project-display-buffer "project" "\ +Display BUFFER-OR-NAME in some window, without selecting it. +When called interactively, prompts for a buffer belonging to the +current project. Two buffers belong to the same project if their +project instances, as reported by `project-current' in each +buffer, are identical. + +This function uses `display-buffer' as a subroutine, which see +for how it is determined where the buffer will be displayed. + +\(fn BUFFER-OR-NAME)" t nil) + +(autoload 'project-display-buffer-other-frame "project" "\ +Display BUFFER-OR-NAME preferably in another frame. +When called interactively, prompts for a buffer belonging to the +current project. Two buffers belong to the same project if their +project instances, as reported by `project-current' in each +buffer, are identical. + +This function uses `display-buffer-other-frame' as a subroutine, +which see for how it is determined where the buffer will be +displayed. + +\(fn BUFFER-OR-NAME)" t nil) (autoload 'project-kill-buffers "project" "\ -Kill all live buffers belonging to the current project. -Certain buffers may be \"spared\", see `project-kill-buffers-ignores'." t nil) +Kill the buffers belonging to the current project. +Two buffers belong to the same project if their project +instances, as reported by `project-current' in each buffer, are +identical. Only the buffers that match a condition in +`project-kill-buffer-conditions' will be killed. If NO-CONFIRM +is non-nil, the command will not ask the user for confirmation. +NO-CONFIRM is always nil when the command is invoked +interactivly. + +\(fn &optional NO-CONFIRM)" t nil) + +(autoload 'project-remember-project "project" "\ +Add project PR to the front of the project list. +Save the result in `project-list-file' if the list of projects has changed. + +\(fn PR)" nil nil) (autoload 'project-known-project-roots "project" "\ Return the list of root directories of all known projects." nil nil) @@ -36792,7 +36913,7 @@ Key bindings: ;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from progmodes/verilog-mode.el -(push (purecopy '(verilog-mode 2020 2 23 232634261)) package--builtin-versions) +(push (purecopy '(verilog-mode 2020 6 27 14326051)) package--builtin-versions) (autoload 'verilog-mode "verilog-mode" "\ Major mode for editing Verilog code. commit 06310cf9122500faa96ad200888cfbb1dda56563 Author: Philipp Stephani Date: Sat Aug 1 17:12:30 2020 +0200 Use a more precise check for '__lsan_ignore_object' * configure.ac: Add check for __lsan_ignore_object. * src/buffer.c (enlarge_buffer_text): * src/data.c (make_blv): * src/emacs-module.c (Fmodule_load, initialize_environment): * src/regex-emacs.c (regex_compile): * src/search.c (newline_cache_on_off): Use new configuration macro. diff --git a/configure.ac b/configure.ac index b4674e3204..93463e344a 100644 --- a/configure.ac +++ b/configure.ac @@ -4516,7 +4516,7 @@ AC_CHECK_FUNCS_ONCE([sbrk]) AC_FUNC_FORK -AC_CHECK_FUNCS(snprintf) +AC_CHECK_FUNCS(snprintf __lsan_ignore_object) dnl Check for glib. This differs from other library checks in that dnl Emacs need not link to glib unless some other library is already diff --git a/src/buffer.c b/src/buffer.c index 3456a46be3..e441499aeb 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5087,7 +5087,7 @@ enlarge_buffer_text (struct buffer *b, ptrdiff_t delta) #else p = xrealloc (b->text->beg, new_nbytes); #endif -#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#ifdef HAVE___LSAN_IGNORE_OBJECT __lsan_ignore_object (p); #endif diff --git a/src/data.c b/src/data.c index c261e8e90d..5fff52d24c 100644 --- a/src/data.c +++ b/src/data.c @@ -1788,7 +1788,7 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded, set_blv_defcell (blv, tem); set_blv_valcell (blv, tem); set_blv_found (blv, false); -#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#ifdef HAVE___LSAN_IGNORE_OBJECT __lsan_ignore_object (blv); #endif return blv; diff --git a/src/emacs-module.c b/src/emacs-module.c index 4374bf4b1c..f57101946b 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1103,7 +1103,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, if (module_assertions) { rt = xmalloc (sizeof *rt); -#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#ifdef HAVE___LSAN_IGNORE_OBJECT __lsan_ignore_object (rt); #endif } @@ -1426,7 +1426,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) if (module_assertions) { env = xmalloc (sizeof *env); -#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#ifdef HAVE___LSAN_IGNORE_OBJECT __lsan_ignore_object (env); #endif } diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 5c08c81c0b..1ecbc74b96 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -1761,7 +1761,7 @@ regex_compile (re_char *pattern, ptrdiff_t size, /* Initialize the compile stack. */ compile_stack.stack = xmalloc (INIT_COMPILE_STACK_SIZE * sizeof *compile_stack.stack); -#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#ifdef HAVE___LSAN_IGNORE_OBJECT __lsan_ignore_object (compile_stack.stack); #endif compile_stack.size = INIT_COMPILE_STACK_SIZE; diff --git a/src/search.c b/src/search.c index ad5d030293..7b74ff9148 100644 --- a/src/search.c +++ b/src/search.c @@ -619,7 +619,7 @@ newline_cache_on_off (struct buffer *buf) if (base_buf->newline_cache == 0) { base_buf->newline_cache = new_region_cache (); -#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#ifdef HAVE___LSAN_IGNORE_OBJECT __lsan_ignore_object (base_buf->newline_cache); #endif } commit a2323c7ccb0eab1b6395d5d1d7e18db617354e13 Author: Philipp Stephani Date: Sat Aug 1 16:58:06 2020 +0200 Suppress sanitizer errors about pointer arithmetic in a few places We perform weird pointer arithmetic due to the layout of Lisp_Objects holding symbols. ASan/UBSan warns about that (Bug#42530). Suppress the warnings by performing the arithmetic on integer types and casting back to pointers. * src/alloc.c (mark_maybe_object, mark_memory): Temporarily cast pointer to 'intptr_t'. diff --git a/src/alloc.c b/src/alloc.c index 76bb20876b..5b9c6e4eb1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -4638,7 +4638,8 @@ mark_maybe_object (Lisp_Object obj) break; } - void *po = (char *) XLP (obj) + (offset - LISP_WORD_TAG (type_tag)); + void *po = (char *) ((intptr_t) (char *) XLP (obj) + + (offset - LISP_WORD_TAG (type_tag))); /* If the pointer is in the dump image and the dump has a record of the object starting at the place where the pointer points, we @@ -4849,7 +4850,7 @@ mark_memory (void const *start, void const *end) On a host with 32-bit pointers and 64-bit Lisp_Objects, a Lisp_Object might be split into registers saved into non-adjacent words and P might be the low-order word's value. */ - p += (intptr_t) lispsym; + p = (char *) ((intptr_t) p + (intptr_t) lispsym); mark_maybe_pointer (p); verify (alignof (Lisp_Object) % GC_POINTER_ALIGNMENT == 0); commit 91d539b0772d4b2a6bdc3fbccf92dc1fcc7f747a Author: Philipp Stephani Date: Sat Aug 1 16:55:45 2020 +0200 Suppress leak sanitizer in a few more places * src/regex-emacs.c (regex_compile): src/search.c (newline_cache_on_off): Suppress leak sanitizer. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index ba7f3cef64..5c08c81c0b 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -29,6 +29,10 @@ #include +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#include +#endif + #include "character.h" #include "buffer.h" #include "syntax.h" @@ -1757,6 +1761,9 @@ regex_compile (re_char *pattern, ptrdiff_t size, /* Initialize the compile stack. */ compile_stack.stack = xmalloc (INIT_COMPILE_STACK_SIZE * sizeof *compile_stack.stack); +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H + __lsan_ignore_object (compile_stack.stack); +#endif compile_stack.size = INIT_COMPILE_STACK_SIZE; compile_stack.avail = 0; diff --git a/src/search.c b/src/search.c index ec076c1803..ad5d030293 100644 --- a/src/search.c +++ b/src/search.c @@ -21,6 +21,10 @@ along with GNU Emacs. If not, see . */ #include +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#include +#endif + #include "lisp.h" #include "character.h" #include "buffer.h" @@ -613,7 +617,12 @@ newline_cache_on_off (struct buffer *buf) { /* It should be on. */ if (base_buf->newline_cache == 0) - base_buf->newline_cache = new_region_cache (); + { + base_buf->newline_cache = new_region_cache (); +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H + __lsan_ignore_object (base_buf->newline_cache); +#endif + } } return base_buf->newline_cache; } commit 4ea90a711d11b14be728241a4454f8c5ee7b6478 Author: Eli Zaretskii Date: Sat Aug 1 15:55:01 2020 +0300 Fix last change * src/emacs-module.c (initialize_environment): Call __lsan_ignore_object only if HAVE_SANITIZER_LSAN_INTERFACE_H is undefined. This fixes compilation on systems that don't have __lsan_* functions. diff --git a/src/emacs-module.c b/src/emacs-module.c index 8d06a24210..4374bf4b1c 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1426,7 +1426,9 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) if (module_assertions) { env = xmalloc (sizeof *env); +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H __lsan_ignore_object (env); +#endif } priv->pending_non_local_exit = emacs_funcall_exit_return; commit c3b53559965a4c6f48274c3cbcb43eb6ef23ae14 Author: Philipp Stephani Date: Sat Aug 1 14:13:55 2020 +0200 Suppress leak detector in some cases We intentionally leak some objects. Prevent the ASan leak detector from raising false alarms in these cases. * configure.ac: Search for lsan_interface.h header. * src/data.c (make_blv): Allow leaking of buffer-local values. * src/buffer.c (enlarge_buffer_text): Allow leaking of buffer text. * src/emacs-module.c (Fmodule_load, initialize_environment): Allow intentional leak of runtime and environment objects if module assertions are enabled. diff --git a/configure.ac b/configure.ac index 148c50e0b3..b4674e3204 100644 --- a/configure.ac +++ b/configure.ac @@ -1740,7 +1740,8 @@ AC_CHECK_HEADERS_ONCE( sys/sysinfo.h coff.h pty.h sys/resource.h - sys/utsname.h pwd.h utmp.h util.h) + sys/utsname.h pwd.h utmp.h util.h + sanitizer/lsan_interface.h) AC_CACHE_CHECK([for ADDR_NO_RANDOMIZE], [emacs_cv_personality_addr_no_randomize], diff --git a/src/buffer.c b/src/buffer.c index f1cb4d5041..3456a46be3 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -28,6 +28,10 @@ along with GNU Emacs. If not, see . */ #include #include +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#include +#endif + #include #include "lisp.h" @@ -5083,6 +5087,9 @@ enlarge_buffer_text (struct buffer *b, ptrdiff_t delta) #else p = xrealloc (b->text->beg, new_nbytes); #endif +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H + __lsan_ignore_object (p); +#endif if (p == NULL) { diff --git a/src/data.c b/src/data.c index 1db0a983b4..c261e8e90d 100644 --- a/src/data.c +++ b/src/data.c @@ -23,6 +23,10 @@ along with GNU Emacs. If not, see . */ #include #include +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#include +#endif + #include #include #include @@ -1784,6 +1788,9 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded, set_blv_defcell (blv, tem); set_blv_valcell (blv, tem); set_blv_found (blv, false); +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H + __lsan_ignore_object (blv); +#endif return blv; } diff --git a/src/emacs-module.c b/src/emacs-module.c index ac9ac824b7..8d06a24210 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -84,6 +84,10 @@ To add a new module function, proceed as follows: #include #include +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H +#include +#endif + #include "lisp.h" #include "bignum.h" #include "dynlib.h" @@ -1095,7 +1099,16 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, for two different runtime objects are guaranteed to be distinct, which we can use for checking the liveness of runtime pointers. */ - struct emacs_runtime *rt = module_assertions ? xmalloc (sizeof *rt) : &rt_pub; + struct emacs_runtime *rt; + if (module_assertions) + { + rt = xmalloc (sizeof *rt); +#ifdef HAVE_SANITIZER_LSAN_INTERFACE_H + __lsan_ignore_object (rt); +#endif + } + else + rt = &rt_pub; rt->size = sizeof *rt; rt->private_members = &rt_priv; rt->get_environment = module_get_environment; @@ -1411,7 +1424,10 @@ static emacs_env * initialize_environment (emacs_env *env, struct emacs_env_private *priv) { if (module_assertions) + { env = xmalloc (sizeof *env); + __lsan_ignore_object (env); + } priv->pending_non_local_exit = emacs_funcall_exit_return; initialize_storage (&priv->storage); commit 89127266c93083521d71d8f2314ac88905163fd8 Author: Philipp Stephani Date: Sat Aug 1 14:10:33 2020 +0200 * test/data/emacs-module/mod-test.c (Fmod_test_string_a_to_b): Fix leak diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index f72b85a5d8..37186fcc4d 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -262,7 +262,9 @@ Fmod_test_string_a_to_b (emacs_env *env, ptrdiff_t nargs, emacs_value args[], if (buf[i] == 'a') buf[i] = 'b'; - return env->make_string (env, buf, size - 1); + emacs_value ret = env->make_string (env, buf, size - 1); + free (buf); + return ret; }