diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index e420644cd81..b4efc44b039 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1724,7 +1724,8 @@ This function parses the time-string @var{string} and returns the corresponding Lisp timestamp. The argument @var{string} should represent a date-time, and should be in one of the forms recognized by @code{parse-time-string} (see below). This function assumes Universal -Time if @var{string} lacks explicit time zone information. +Time if @var{string} lacks explicit time zone information, +and assumes earliest values if @var{string} lacks month, day, or time. The operating system limits the range of time and zone values. @end defun diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 2b0b1f7fd67..8a4b914687c 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -703,8 +703,7 @@ This function retrieves the value of @var{slot} from @var{object}. It can also be used on objects defined by @code{cl-defstruct}. This is a generalized variable that can be used with @code{setf} to -modify the value stored in @var{slot}, tho not for objects defined by -@code{cl-defstruct}. +modify the value stored in @var{slot}. @xref{Generalized Variables,,,elisp,GNU Emacs Lisp Reference Manual}. @end defun diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 1f6d4ad6269..2a8a0382807 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3389,8 +3389,8 @@ indication that the process has been interrupted, and returns a corresponding string. This remote process handling does not apply to @acronym{GVFS} -(@pxref{GVFS-based methods}) because the remote file system is mounted on -the local host and @value{tramp} accesses it by changing the +(@pxref{GVFS-based methods}) because the remote file system is mounted +on the local host and @value{tramp} accesses it by changing the @code{default-directory}. @value{tramp} starts a remote process when a command is executed in a @@ -4059,6 +4059,11 @@ CPIO archives @cindex @file{cpio} file archive suffix @cindex file archive suffix @file{cpio} +@item @samp{.crate} --- +Cargo (Rust) packages +@cindex @file{crate} file archive suffix +@cindex file archive suffix @file{crate} + @item @samp{.deb} --- Debian packages @cindex @file{deb} file archive suffix diff --git a/etc/NEWS b/etc/NEWS index ac1787d7f80..df5e6ef7904 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -423,7 +423,7 @@ representation as emojis. ** EIEIO +++ -*** 'slot-value' can now be used to read slots of 'cl-defstruct' objects. +*** 'slot-value' can now be used to access slots of 'cl-defstruct' objects. ** align @@ -1084,6 +1084,10 @@ cookies set by web pages on disk. ** New variable 'help-buffer-under-preparation'. This variable is bound to t during the preparation of a "*Help*" buffer. ++++ +** 'date-to-time' now assumes earliest values if its argument lacks +month, day, or time. For example, (date-to-time "2021-12-04") now +assumes a time of 00:00 instead of signaling an error. * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/bookmark.el b/lisp/bookmark.el index a8fa9ae7749..f35cbc1a5ec 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -510,8 +510,9 @@ If DEFAULT is nil then return empty string for empty input." (defmacro bookmark-maybe-historicize-string (string) "Put STRING into the bookmark prompt history, if caller non-interactive. -We need this because sometimes bookmark functions are invoked from -menus, so `completing-read' never gets a chance to set `bookmark-history'." +We need this because sometimes bookmark functions are invoked +from other commands that pass in the bookmark name, so +`completing-read' never gets a chance to set `bookmark-history'." `(or (called-interactively-p 'interactive) (setq bookmark-history (cons ,string bookmark-history)))) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 8a6ee0f2702..37a16d3b98c 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -153,28 +153,22 @@ it is assumed that PICO was omitted and should be treated as zero." "Parse a string DATE that represents a date-time and return a time value. DATE should be in one of the forms recognized by `parse-time-string'. If DATE lacks timezone information, GMT is assumed." - ;; Pass the result of parsing through decoded-time-set-defaults - ;; because encode-time signals if HH:MM:SS are not filled in. - (encode-time - (decoded-time-set-defaults - (condition-case err - (let ((time (parse-time-string date))) - (prog1 time - ;; Cause an error if data `parse-time-string' returns is invalid. - (setq time (encode-time time)))) - (error - (let ((overflow-error '(error "Specified time is not representable"))) - (if (or (equal err overflow-error) - ;; timezone-make-date-arpa-standard misbehaves if - ;; not given at least HH:MM as part of the date. - (not (string-match ":" date))) - (signal (car err) (cdr err)) - (condition-case err - (parse-time-string (timezone-make-date-arpa-standard date)) - (error - (if (equal err overflow-error) - (signal (car err) (cdr err)) - (error "Invalid date: %s" date))))))))))) + (condition-case err + (let ((parsed (parse-time-string date))) + (when (decoded-time-year parsed) + (decoded-time-set-defaults parsed)) + (encode-time parsed)) + (error + (let ((overflow-error '(error "Specified time is not representable"))) + (if (equal err overflow-error) + (signal (car err) (cdr err)) + (condition-case err + (encode-time (parse-time-string + (timezone-make-date-arpa-standard date))) + (error + (if (equal err overflow-error) + (signal (car err) (cdr err)) + (error "Invalid date: %s" date))))))))) ;;;###autoload (defalias 'time-to-seconds 'float-time) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 7c5babcf54c..ca47ec77f76 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -450,7 +450,7 @@ See `defclass' for more information." )) ;; Now that everything has been loaded up, all our lists are backwards! - ;; Fix that up now and then them into vectors. + ;; Fix that up now and turn them into vectors. (cl-callf (lambda (slots) (apply #'vector (nreverse slots))) (eieio--class-slots newc)) (cl-callf nreverse (eieio--class-initarg-tuples newc)) @@ -704,11 +704,15 @@ an error." nil ;; Trim off object IDX junk added in for the object index. (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots))) - (let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class) - slot-idx)))) - (if (not (eieio--perform-slot-validation st value)) - (signal 'invalid-slot-type - (list (eieio--class-name class) slot st value)))))) + (let* ((sd (aref (eieio--class-slots class) + slot-idx)) + (st (cl--slot-descriptor-type sd))) + (cond + ((not (eieio--perform-slot-validation st value)) + (signal 'invalid-slot-type + (list (eieio--class-name class) slot st value))) + ((alist-get :read-only (cl--slot-descriptor-props sd)) + (signal 'eieio-read-only (list (eieio--class-name class) slot))))))) (defun eieio--validate-class-slot-value (class slot-idx value slot) "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. @@ -813,7 +817,7 @@ Fills in CLASS's SLOT with its default value." (defun eieio-oset (obj slot value) "Do the work for the macro `oset'. Fills in OBJ's SLOT with VALUE." - (cl-check-type obj eieio-object) + (cl-check-type obj (or eieio-object cl-structure-object)) (cl-check-type slot symbol) (let* ((class (eieio--object-class obj)) (c (eieio--slot-name-index class slot))) @@ -1063,6 +1067,7 @@ method invocation orders of the involved classes." ;; (define-error 'invalid-slot-name "Invalid slot name") (define-error 'invalid-slot-type "Invalid slot type") +(define-error 'eieio-read-only "Read-only slot") (define-error 'unbound-slot "Unbound slot") (define-error 'inconsistent-class-hierarchy "Inconsistent class hierarchy") diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index bb265642bc6..c60faa13263 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1748,7 +1748,7 @@ this is a reply." (concat "\"" str "\"") str))) (when groups - (insert " "))) + (insert ","))) (insert "\n"))))))) (defun gnus-mailing-list-followup-to () diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index bce5d57c521..c77de688e66 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -105,9 +105,13 @@ (gnus-add-shutdown #'gnus-search-shutdown 'gnus) -(define-error 'gnus-search-parse-error "Gnus search parsing error") +(define-error 'gnus-search-error "Gnus search error") -(define-error 'gnus-search-config-error "Gnus search configuration error") +(define-error 'gnus-search-parse-error "Gnus search parsing error" + 'gnus-search-error) + +(define-error 'gnus-search-config-error "Gnus search configuration error" + 'gnus-search-error) ;;; User Customizable Variables: @@ -1927,7 +1931,7 @@ Assume \"size\" key is equal to \"larger\"." (apply #'nnheader-message 4 "Search engine for %s improperly configured: %s" server (cdr err)) - (signal 'gnus-search-config-error err))))) + (signal (car err) (cdr err)))))) (alist-get 'search-group-spec specs)) ;; Some search engines do their own limiting, but some don't, so ;; do it again here. This is bad because, if the user is diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index ecec705b326..252e9f66838 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -779,6 +779,10 @@ Return an article list." (args (alist-get 'nnselect-args specs))) (condition-case-unless-debug err (funcall func args) + ;; Don't swallow gnus-search errors; the user should be made + ;; aware of them. + (gnus-search-error + (signal (car err) (cdr err))) (error (gnus-error 3 "nnselect-run: %s on %s gave error %s" func args err) [])))) diff --git a/lisp/isearch.el b/lisp/isearch.el index fcb7d646c66..8815cb4f2d6 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2504,6 +2504,11 @@ If no input items have been entered yet, just beep." (if (null (cdr isearch-cmds)) (ding) (isearch-pop-state)) + ;; When going back to the hidden match, reopen it. + (when (and (eq search-invisible 'open) isearch-hide-immediately + isearch-other-end) + (isearch-range-invisible (min (point) isearch-other-end) + (max (point) isearch-other-end))) (isearch-update)) (defun isearch-del-char (&optional arg) @@ -3787,10 +3792,9 @@ Isearch, at least partially, as determined by `isearch-range-invisible'. If `search-invisible' is t, which allows Isearch matches inside invisible text, this function will always return non-nil, regardless of what `isearch-range-invisible' says." - (and (or (eq search-invisible t) - (not (isearch-range-invisible beg end))) - (not (text-property-not-all (min beg end) (max beg end) - 'inhibit-isearch nil)))) + (and (not (text-property-not-all beg end 'inhibit-isearch nil)) + (or (eq search-invisible t) + (not (isearch-range-invisible beg end))))) ;; General utilities diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index efd38e6b4b7..b0f447a3aee 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -54,6 +54,7 @@ ;; * ".ar" - UNIX archiver formats ;; * ".cab", ".CAB" - Microsoft Windows cabinets ;; * ".cpio" - CPIO archives +;; * ".crate" - Cargo (Rust) packages ;; * ".deb" - Debian packages ;; * ".depot" - HP-UX SD depots ;; * ".exe" - Self extracting Microsoft Windows EXE files @@ -141,6 +142,7 @@ "ar" ;; UNIX archiver formats. "cab" "CAB" ;; Microsoft Windows cabinets. "cpio" ;; CPIO archives. + "crate" ;; Cargo (Rust) packages. Not in libarchive testsuite. "deb" ;; Debian packages. Not in libarchive testsuite. "depot" ;; HP-UX SD depot. Not in libarchive testsuite. "exe" ;; Self extracting Microsoft Windows EXE files. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ab71c9cd13f..22e31428a76 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1521,11 +1521,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." (size (cdr (assoc "filesystem::size" attr))) (used (cdr (assoc "filesystem::used" attr))) (free (cdr (assoc "filesystem::free" attr)))) - (when (or size used free) - (list (string-to-number (or size "0")) - (string-to-number (or free "0")) - (- (string-to-number (or size "0")) - (string-to-number (or used "0")))))))) + (when (or size free) + (list (and size (string-to-number size)) + (and free (string-to-number free)) + (and size used + (- (string-to-number size) (string-to-number used)))))))) (defun tramp-gvfs-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 780c3b39413..8d106591af3 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2678,17 +2678,15 @@ The method used must be an out-of-band method." (point-min) 'noerror) (replace-match (file-relative-name filename) t)) - ;; Try to insert the amount of free space. This is moved to - ;; `dired-insert-directory' in Emacs 29.1. - (unless (boundp 'dired-free-space) - (goto-char (point-min)) - ;; First find the line to put it on. - (when (re-search-forward "^\\([[:space:]]*total\\)" nil t) - (when-let ((available (get-free-disk-space "."))) - ;; Replace "total" with "total used", to avoid confusion. - (replace-match "\\1 used in directory") - (end-of-line) - (insert " available " available))))) + ;; Try to insert the amount of free space. + (goto-char (point-min)) + ;; First find the line to put it on. + (when (re-search-forward "^\\([[:space:]]*total\\)" nil t) + (when-let ((available (get-free-disk-space "."))) + ;; Replace "total" with "total used", to avoid confusion. + (replace-match "\\1 used in directory") + (end-of-line) + (insert " available " available)))) (prog1 (goto-char end-marker) (set-marker beg-marker nil) @@ -6024,5 +6022,8 @@ function cell is returned to be applied on a buffer." ;; be to stipulate, as a directory or connection-local variable, an ;; additional rc file on the remote machine that is sourced every ;; time Tramp connects. +;; +;; * Support hostname canonicalization in ~/.ssh/config. +;; ;;; tramp-sh.el ends here diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 0a7d1efc8b8..24119539db0 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1120,14 +1120,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar x (concat (car x) "*")))))) entries)) - ;; Insert size information. This is moved to - ;; `dired-insert-directory' in Emacs 29.1. - (unless (boundp 'dired-free-space) - (when full-directory-p - (insert - (if avail - (format "total used in directory %s available %s\n" used avail) - (format "total %s\n" used))))) + ;; Insert size information. + (when full-directory-p + (insert + (if avail + (format "total used in directory %s available %s\n" used avail) + (format "total %s\n" used)))) ;; Print entries. (mapc diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index cf1d62d3695..409ff940d96 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1266,7 +1266,7 @@ Used by Speedbar." :version "22.1") (define-key gud-minor-mode-map "\C-c\C-w" 'gud-watch) -(define-key global-map (vconcat gud-key-prefix "\C-w") 'gud-watch) +(keymap-set gud-global-map "C-w" 'gud-watch) (declare-function tooltip-identifier-from-point "tooltip" (point)) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 9b884c4ff80..d5bd2655174 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -90,8 +90,10 @@ pdb (Python), and jdb." "Prefix of all GUD commands valid in C buffers." :type 'key-sequence) -(global-set-key (vconcat gud-key-prefix "\C-l") #'gud-refresh) -;; (define-key ctl-x-map " " 'gud-break); backward compatibility hack +(defvar-keymap gud-global-map + "C-l" #'gud-refresh) + +(global-set-key gud-key-prefix gud-global-map) (defvar gud-marker-filter nil) (put 'gud-marker-filter 'permanent-local t) @@ -433,7 +435,7 @@ we're in the GUD buffer)." ;; Unused lexical warning if cmd does not use "arg". cmd)))) ,(if key `(local-set-key ,(concat "\C-c" key) #',func)) - ,(if key `(global-set-key (vconcat gud-key-prefix ,key) #',func)))) + ,(if key `(define-key gud-global-map ,key #',func)))) ;; Where gud-display-frame should put the debugging arrow; a cons of ;; (filename . line-number). This is set by the marker-filter, which scans diff --git a/lisp/textmodes/pixel-fill.el b/lisp/textmodes/pixel-fill.el index f69696e1f56..0a0f0eb8b66 100644 --- a/lisp/textmodes/pixel-fill.el +++ b/lisp/textmodes/pixel-fill.el @@ -116,15 +116,13 @@ prefix on subsequent lines." (while (not (eolp)) ;; We have to do some folding. First find the first previous ;; point suitable for folding. - (if (or (not (pixel-fill-find-fill-point (line-beginning-position))) - (= (point) start)) - ;; We had unbreakable text (for this width), so just go to - ;; the first space and carry on. - (progn - (beginning-of-line) - (skip-chars-forward " ") - (search-forward " " (line-end-position) 'move))) - ;; Success; continue. + (when (or (not (pixel-fill-find-fill-point (line-beginning-position))) + (= (point) start)) + ;; We had unbreakable text (for this width), so just go to + ;; the first space and carry on. + (beginning-of-line) + (skip-chars-forward " ") + (search-forward " " (line-end-position) 'move)) (when (= (preceding-char) ?\s) (delete-char -1)) (unless (eobp) @@ -133,7 +131,8 @@ prefix on subsequent lines." (insert (propertize " " 'display (list 'space :align-to (list indentation)))))) (setq start (point)) - (pixel-fill--goto-pixel width)))) + (unless (eobp) + (pixel-fill--goto-pixel width))))) (define-inline pixel-fill--char-breakable-p (char) "Return non-nil if a line can be broken before and after CHAR." diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 4568947c0b3..d5269804ad2 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -41,6 +41,13 @@ (encode-time-value 1 2 3 4 3)) '(1 2 3 4)))) +(ert-deftest test-date-to-time () + (should (equal (format-time-string "%F %T" (date-to-time "2021-12-04")) + "2021-12-04 00:00:00"))) + +(ert-deftest test-days-between () + (should (equal (days-between "2021-10-22" "2020-09-29") 388))) + (ert-deftest test-leap-year () (should-not (date-leap-year-p 1999)) (should-not (date-leap-year-p 1900)) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 43791118f14..1c4f37bd327 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -543,10 +543,12 @@ path's data to use." ((equal "." path) default-directory) (path))) (return-size - (car (files-tests--look-up-free-data path)))) + ;; It is always defined but this silences the byte-compiler: + (when (fboundp 'files-tests--look-up-free-data) + (car (files-tests--look-up-free-data path))))) (list return-size return-size return-size)))) - (defun files-tests--insert-directory-output (dir &optional verbose) + (defun files-tests--insert-directory-output (dir &optional _verbose) "Run `insert-directory' and return its output." (with-current-buffer-window "files-tests--insert-directory" nil nil (let ((dired-free-space 'separate)) @@ -555,35 +557,46 @@ path's data to use." (ert-deftest files-tests-insert-directory-shows-files () "Verify `insert-directory' reports the files in the directory." - (let* ((test-dir (car test-files)) - (files (cdr test-files)) - (output (files-tests--insert-directory-output test-dir))) - (dolist (file files) - (should (string-match-p file output))))) + ;; It is always defined but this silences the byte-compiler: + (when (fboundp 'files-tests--insert-directory-output) + (let* ((test-dir (car test-files)) + (files (cdr test-files)) + (output (files-tests--insert-directory-output test-dir))) + (dolist (file files) + (should (string-match-p file output)))))) (defun files-tests--insert-directory-shows-given-free (dir &optional info-func) "Run `insert-directory' and verify it reports the correct available space. Stub `file-system-info' to ensure the available space is consistent, either with the given stub function or a default one using test data." - (cl-letf (((symbol-function 'file-system-info) - (or info-func - (files-tests--make-file-system-info-stub)))) - (should (string-match-p (cadr - (files-tests--look-up-free-data dir)) - (files-tests--insert-directory-output dir t))))) + ;; It is always defined but this silences the byte-compiler: + (when (and (fboundp 'files-tests--make-file-system-info-stub) + (fboundp 'files-tests--look-up-free-data) + (fboundp 'files-tests--insert-directory-output)) + (cl-letf (((symbol-function 'file-system-info) + (or info-func + (files-tests--make-file-system-info-stub)))) + (should (string-match-p (cadr + (files-tests--look-up-free-data dir)) + (files-tests--insert-directory-output dir t)))))) (ert-deftest files-tests-insert-directory-shows-free () "Test that verbose `insert-directory' shows the correct available space." - (files-tests--insert-directory-shows-given-free - test-dir - (files-tests--make-file-system-info-stub test-dir))) + ;; It is always defined but this silences the byte-compiler: + (when (and (fboundp 'files-tests--insert-directory-shows-given-free) + (fboundp 'files-tests--make-file-system-info-stub)) + (files-tests--insert-directory-shows-given-free + test-dir + (files-tests--make-file-system-info-stub test-dir)))) (ert-deftest files-tests-bug-50630 () "Verify verbose `insert-directory' shows free space of the target directory. The current directory at call time should not affect the result (Bug#50630)." - (let ((default-directory test-dir-other)) - (files-tests--insert-directory-shows-given-free test-dir)))) + ;; It is always defined but this silences the byte-compiler: + (when (fboundp 'files-tests--insert-directory-shows-given-free) + (let ((default-directory test-dir-other)) + (files-tests--insert-directory-shows-given-free test-dir))))) (provide 'dired-tests) ;;; dired-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index be2c0fa02b4..7c3afefaadd 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -668,6 +668,10 @@ collection clause." #'len)) (`(function (lambda (,_ ,_) . ,_)) t)))) +(with-suppressed-warnings ((lexical test) (lexical test1) (lexical test2)) + (defvar test) + (defvar test1) + (defvar test2)) (ert-deftest cl-macs--progv () (should (= (cl-progv '(test test) '(1 2) test) 2)) (should (equal (cl-progv '(test1 test2) '(1 2) (list test1 test2)) diff --git a/test/lisp/emacs-lisp/derived-tests.el b/test/lisp/emacs-lisp/derived-tests.el index 9c8e6c33b4c..2647b86826a 100644 --- a/test/lisp/emacs-lisp/derived-tests.el +++ b/test/lisp/emacs-lisp/derived-tests.el @@ -24,13 +24,13 @@ (define-derived-mode derived-tests--parent-mode prog-mode "P" :after-hook (let ((f (let ((x "S")) (lambda () x)))) - (insert (format "AFP=%s " (let ((x "D")) (funcall f))))) + (insert (format "AFP=%s " (let ((x "D")) x (funcall f))))) (insert "PB ")) (define-derived-mode derived-tests--child-mode derived-tests--parent-mode "C" :after-hook (let ((f (let ((x "S")) (lambda () x)))) - (insert (format "AFC=%s " (let ((x "D")) (funcall f))))) + (insert (format "AFC=%s " (let ((x "D")) x (funcall f))))) (insert "CB ")) (ert-deftest derived-tests-after-hook-lexical () diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index ba2e5f7be4a..6f6a1f4f19a 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -172,7 +172,7 @@ ;; Check that generic-p works (should (generic-p 'generic1)) - (defmethod generic1 ((c class-a)) + (defmethod generic1 ((_c class-a)) "Method on generic1." 'monkey) @@ -240,12 +240,12 @@ Argument C is the class bound to this static method." (should (make-instance 'class-a :water 'cho)) (should (make-instance 'class-b))) -(defmethod class-cn ((a class-a)) +(defmethod class-cn ((_a class-a)) "Try calling `call-next-method' when there isn't one. Argument A is object of type symbol `class-a'." (call-next-method)) -(defmethod no-next-method ((a class-a) &rest args) +(defmethod no-next-method ((_a class-a) &rest _args) "Override signal throwing for variable `class-a'. Argument A is the object of class variable `class-a'." 'moose) @@ -254,7 +254,7 @@ Argument A is the object of class variable `class-a'." ;; Play with call-next-method (should (eq (class-cn eitest-ab) 'moose))) -(defmethod no-applicable-method ((b class-b) method &rest args) +(defmethod no-applicable-method ((_b class-b) _method &rest _args) "No need. Argument B is for booger. METHOD is the method that was attempting to be called." @@ -264,38 +264,38 @@ METHOD is the method that was attempting to be called." ;; Non-existing methods. (should (eq (class-cn eitest-b) 'moose))) -(defmethod class-fun ((a class-a)) +(defmethod class-fun ((_a class-a)) "Fun with class A." 'moose) -(defmethod class-fun ((b class-b)) +(defmethod class-fun ((_b class-b)) "Fun with class B." (error "Class B fun should not be called") ) -(defmethod class-fun-foo ((b class-b)) +(defmethod class-fun-foo ((_b class-b)) "Foo Fun with class B." 'moose) -(defmethod class-fun2 ((a class-a)) +(defmethod class-fun2 ((_a class-a)) "More fun with class A." 'moose) -(defmethod class-fun2 ((b class-b)) +(defmethod class-fun2 ((_b class-b)) "More fun with class B." (error "Class B fun2 should not be called") ) -(defmethod class-fun2 ((ab class-ab)) +(defmethod class-fun2 ((_ab class-ab)) "More fun with class AB." (call-next-method)) ;; How about if B is the only slot? -(defmethod class-fun3 ((b class-b)) +(defmethod class-fun3 ((_b class-b)) "Even More fun with class B." 'moose) -(defmethod class-fun3 ((ab class-ab)) +(defmethod class-fun3 ((_ab class-ab)) "Even More fun with class AB." (call-next-method)) @@ -314,17 +314,17 @@ METHOD is the method that was attempting to be called." (defvar class-fun-value-seq '()) -(defmethod class-fun-value :BEFORE ((a class-a)) +(defmethod class-fun-value :BEFORE ((_a class-a)) "Return `before', and push `before' in `class-fun-value-seq'." (push 'before class-fun-value-seq) 'before) -(defmethod class-fun-value :PRIMARY ((a class-a)) +(defmethod class-fun-value :PRIMARY ((_a class-a)) "Return `primary', and push `primary' in `class-fun-value-seq'." (push 'primary class-fun-value-seq) 'primary) -(defmethod class-fun-value :AFTER ((a class-a)) +(defmethod class-fun-value :AFTER ((_a class-a)) "Return `after', and push `after' in `class-fun-value-seq'." (push 'after class-fun-value-seq) 'after) @@ -343,14 +343,14 @@ METHOD is the method that was attempting to be called." ;; (ert-deftest eieio-test-13-init-methods () - (defmethod initialize-instance ((a class-a) &rest slots) + (defmethod initialize-instance ((a class-a) &rest _slots) "Initialize the slots of class-a." (call-next-method) (if (/= (oref a test-tag) 1) (error "shared-initialize test failed.")) (oset a test-tag 2)) - (defmethod shared-initialize ((a class-a) &rest slots) + (defmethod shared-initialize ((a class-a) &rest _slots) "Shared initialize method for class-a." (call-next-method) (oset a test-tag 1)) @@ -369,7 +369,7 @@ METHOD is the method that was attempting to be called." (ert-deftest eieio-test-15-slot-missing () - (defmethod slot-missing ((ab class-ab) &rest foo) + (defmethod slot-missing ((_ab class-ab) &rest _foo) "If a slot in AB is unbound, return something cool. FOO." 'moose) @@ -425,7 +425,7 @@ METHOD is the method that was attempting to be called." (ert-deftest eieio-test-18-slot-unbound () - (defmethod slot-unbound ((a class-a) &rest foo) + (defmethod slot-unbound ((_a class-a) &rest _foo) "If a slot in A is unbound, ignore FOO." 'moose) @@ -448,7 +448,7 @@ METHOD is the method that was attempting to be called." (should (eq (oref (class-a) water) 'penguin)) ;; Revert the above - (defmethod slot-unbound ((a class-a) &rest foo) + (defmethod slot-unbound ((_a class-a) &rest _foo) "If a slot in A is unbound, ignore FOO." ;; Disable the old slot-unbound so we can run this test ;; more than once @@ -971,7 +971,7 @@ Subclasses to override slot attributes.") ;;;; Interaction with defstruct -(cl-defstruct eieio-test--struct a b c) +(cl-defstruct eieio-test--struct a b (c nil :read-only t)) (ert-deftest eieio-test-defstruct-slot-value () (let ((x (make-eieio-test--struct :a 'A :b 'B :c 'C))) @@ -980,7 +980,10 @@ Subclasses to override slot attributes.") (should (eq (eieio-test--struct-b x) (slot-value x 'b))) (should (eq (eieio-test--struct-c x) - (slot-value x 'c))))) + (slot-value x 'c))) + (setf (slot-value x 'a) 1) + (should (eq (eieio-test--struct-a x) 1)) + (should-error (setf (slot-value x 'c) 3) :type 'eieio-read-only))) (provide 'eieio-tests) diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el index 50b8cc53a28..492c4e40853 100644 --- a/test/lisp/emacs-lisp/generator-tests.el +++ b/test/lisp/emacs-lisp/generator-tests.el @@ -74,7 +74,7 @@ identical output." (cps-testcase cps-prog1-b (prog1 1)) (cps-testcase cps-prog1-c (prog2 1 2 3)) (cps-testcase cps-quote (progn 'hello)) -(cps-testcase cps-function (progn #'hello)) +(cps-testcase cps-function (progn #'message)) (cps-testcase cps-and-fail (and 1 nil 2)) (cps-testcase cps-and-succeed (and 1 2 3)) @@ -307,6 +307,7 @@ identical output." (1+ it))))))) -2))) +(defun generator-tests-edebug ()) ; silence byte-compiler (ert-deftest generator-tests-edebug () "Check that Bug#40434 is fixed." (with-temp-buffer diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index 8301d9906a2..7f4d50c5958 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -213,6 +213,7 @@ (should-error (forward-sexp)))) ;; FIXME: Shouldn't be an error. ;; Test some core Elisp rules. +(defvar c-e-x) (ert-deftest core-elisp-tests-1-defvar-in-let () "Test some core Elisp rules." (with-temp-buffer diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 8dc0b93b5af..8cfa3bdb862 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -172,17 +172,23 @@ Evaluate BODY for each created sequence. (should-not (seq-find #'null '(1 2 3))) (should (seq-find #'null '(1 2 3) 'sentinel))) +;; Hack to work around the ERT limitation that we can't reliably use +;; `with-suppressed-warnings' inside an `ert-deftest'. (Bug#36568) +(defun seq--contains (&rest args) + (with-suppressed-warnings ((obsolete seq-contains)) + (apply #'seq-contains args))) + (ert-deftest test-seq-contains () (with-test-sequences (seq '(3 4 5 6)) - (should (seq-contains seq 3)) - (should-not (seq-contains seq 7))) + (should (seq--contains seq 3)) + (should-not (seq--contains seq 7))) (with-test-sequences (seq '()) - (should-not (seq-contains seq 3)) - (should-not (seq-contains seq nil)))) + (should-not (seq--contains seq 3)) + (should-not (seq--contains seq nil)))) (ert-deftest test-seq-contains-should-return-the-elt () (with-test-sequences (seq '(3 4 5 6)) - (should (= 5 (seq-contains seq 5))))) + (should (= 5 (seq--contains seq 5))))) (ert-deftest test-seq-contains-p () (with-test-sequences (seq '(3 4 5 6)) @@ -404,7 +410,7 @@ Evaluate BODY for each created sequence. (let ((seq '(1 (2 (3 (4)))))) (seq-let (_ (_ (_ (a)))) seq (should (= a 4)))) - (let (seq) + (let ((seq nil)) (seq-let (a b c) seq (should (null a)) (should (null b)) @@ -428,7 +434,7 @@ Evaluate BODY for each created sequence. (seq '(1 (2 (3 (4)))))) (seq-setq (_ (_ (_ (a)))) seq) (should (= a 4))) - (let (seq a b c) + (let ((seq nil) a b c) (seq-setq (a b c) seq) (should (null a)) (should (null b)) diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 69d59e84f6d..d8369506000 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -169,13 +169,13 @@ "no") "no")) (should (equal - (let (z) + (let ((z nil)) (if-let* (z (a 1) (b 2) (c 3)) "yes" "no")) "no")) (should (equal - (let (d) + (let ((d nil)) (if-let* ((a 1) (b 2) (c 3) d) "yes" "no")) @@ -191,7 +191,7 @@ (ert-deftest subr-x-test-if-let*-and-laziness-is-preserved () "Test `if-let' respects `and' laziness." - (let (a-called b-called c-called) + (let ((a-called nil) (b-called nil) c-called) (should (equal (if-let* ((a nil) (b (setq b-called t)) @@ -199,7 +199,7 @@ "yes" (list a-called b-called c-called)) (list nil nil nil)))) - (let (a-called b-called c-called) + (let ((a-called nil) (b-called nil) c-called) (should (equal (if-let* ((a (setq a-called t)) (b nil) @@ -207,12 +207,12 @@ "yes" (list a-called b-called c-called)) (list t nil nil)))) - (let (a-called b-called c-called) + (let ((a-called nil) (b-called nil) c-called) (should (equal (if-let* ((a (setq a-called t)) - (b (setq b-called t)) - (c nil) - (d (setq c-called t))) + (b (setq b-called t)) + (c nil) + (d (setq c-called t))) "yes" (list a-called b-called c-called)) (list t t nil))))) @@ -329,12 +329,12 @@ "no") nil)) (should (equal - (let (z) + (let ((z nil)) (when-let* (z (a 1) (b 2) (c 3)) "no")) nil)) (should (equal - (let (d) + (let ((d nil)) (when-let* ((a 1) (b 2) (c 3) d) "no")) nil))) @@ -348,7 +348,7 @@ (ert-deftest subr-x-test-when-let*-and-laziness-is-preserved () "Test `when-let' respects `and' laziness." - (let (a-called b-called c-called) + (let ((a-called nil) (b-called nil) (c-called nil)) (should (equal (progn (when-let* ((a nil) @@ -357,7 +357,7 @@ "yes") (list a-called b-called c-called)) (list nil nil nil)))) - (let (a-called b-called c-called) + (let ((a-called nil) (b-called nil) (c-called nil)) (should (equal (progn (when-let* ((a (setq a-called t)) @@ -366,7 +366,7 @@ "yes") (list a-called b-called c-called)) (list t nil nil)))) - (let (a-called b-called c-called) + (let ((a-called nil) (b-called nil) (c-called nil)) (should (equal (progn (when-let* ((a (setq a-called t)) diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index 7856c217f9e..0f5b1a71868 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -37,7 +37,8 @@ (ert-deftest timer-tests-debug-timer-check () ;; This function exists only if --enable-checking. (skip-unless (fboundp 'debug-timer-check)) - (should (debug-timer-check))) + (when (fboundp 'debug-timer-check) ; silence byte-compiler + (should (debug-timer-check)))) (ert-deftest timer-test-multiple-of-time () (should (time-equal-p diff --git a/test/lisp/format-spec-tests.el b/test/lisp/format-spec-tests.el index ff2abdeaad5..3c6fa540fe8 100644 --- a/test/lisp/format-spec-tests.el +++ b/test/lisp/format-spec-tests.el @@ -56,7 +56,7 @@ (ert-deftest format-spec-do-flags-truncate () "Test `format-spec--do-flags' truncation." - (let (flags) + (let ((flags nil)) (should (equal (format-spec--do-flags "" flags nil 0) "")) (should (equal (format-spec--do-flags "" flags nil 1) "")) (should (equal (format-spec--do-flags "a" flags nil 0) "")) @@ -75,7 +75,7 @@ (ert-deftest format-spec-do-flags-pad () "Test `format-spec--do-flags' padding." - (let (flags) + (let ((flags nil)) (should (equal (format-spec--do-flags "" flags 0 nil) "")) (should (equal (format-spec--do-flags "" flags 1 nil) " ")) (should (equal (format-spec--do-flags "a" flags 0 nil) "a")) diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el index e3a75bed41d..9f2c63225b5 100644 --- a/test/lisp/ls-lisp-tests.el +++ b/test/lisp/ls-lisp-tests.el @@ -54,7 +54,8 @@ (kill-buffer buf) (setq buf (dired (nconc (list dir) files))) (should (looking-at "src")) - (next-line) ; File names must be aligned. + (with-suppressed-warnings ((interactive-only next-line)) + (next-line)) ; File names must be aligned. (should (looking-at "src"))) (when (buffer-live-p buf) (kill-buffer buf))))) diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el index 0e02e1ca1bc..0b8c1178f3a 100644 --- a/test/lisp/obsolete/cl-tests.el +++ b/test/lisp/obsolete/cl-tests.el @@ -27,10 +27,15 @@ +;; Hack to work around the ERT limitation that we can't reliably use +;; `with-suppressed-warnings' inside an `ert-deftest'. (Bug#36568) +(defun cl-tests-labels-test () + (with-suppressed-warnings ((obsolete labels)) + (funcall (labels ((foo () t)) + #'foo)))) + (ert-deftest labels-function-quoting () "Test that #'foo does the right thing in `labels'." ; Bug#31792. - (should (eq (funcall (labels ((foo () t)) - #'foo)) - t))) + (should (eq (cl-tests-labels-test) t))) ;;; cl-tests.el ends here diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 63bae79bb40..9dc5e8cadcf 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -438,7 +438,8 @@ to (xref-elisp-test-descr-to-target xref)." ;; track down the problem. (cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type) arg2) "Doc string generic no-default xref-elisp-root-type." - "non-default for no-default") + "non-default for no-default" + (list this arg2)) ; silence byte-compiler ;; defgeneric after defmethod in file to ensure the fallback search ;; method of just looking for the function name will fail. @@ -463,19 +464,23 @@ to (xref-elisp-test-descr-to-target xref)." (cl-defmethod xref-elisp-generic-separate-default (arg1 arg2) "Doc string generic separate-default default." - "separate default") + "separate default" + (list arg1 arg2)) ; silence byte-compiler (cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type) arg2) "Doc string generic separate-default xref-elisp-root-type." - "non-default for separate-default") + "non-default for separate-default" + (list this arg2)) ; silence byte-compiler (cl-defmethod xref-elisp-generic-implicit-generic (arg1 arg2) "Doc string generic implicit-generic default." - "default for implicit generic") + "default for implicit generic" + (list arg1 arg2)) ; silence byte-compiler (cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type) arg2) "Doc string generic implicit-generic xref-elisp-root-type." - "non-default for implicit generic") + "non-default for implicit generic" + (list this arg2)) ; silence byte-compiler (xref-elisp-deftest find-defs-defgeneric-no-methods @@ -845,7 +850,8 @@ to (xref-elisp-test-descr-to-target xref)." (if (stringp form) (insert form) (pp form (current-buffer))) - (font-lock-debug-fontify) + (with-suppressed-warnings ((interactive-only font-lock-debug-fontify)) + (font-lock-debug-fontify)) (goto-char (point-min)) (and (re-search-forward search nil t) (get-text-property (match-beginning 1) 'face)))) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 7f62a417a02..dcd5ebb1fe6 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -599,11 +599,12 @@ bound to HIGHLIGHT-LOCUS." (with-temp-buffer (insert before) (goto-char (point-min)) - (replace-regexp - "\\(\\(L\\)\\|\\(R\\)\\)" - '(replace-eval-replacement - replace-quote - (if (match-string 2) "R" "L"))) + (with-suppressed-warnings ((interactive-only replace-regexp)) + (replace-regexp + "\\(\\(L\\)\\|\\(R\\)\\)" + '(replace-eval-replacement + replace-quote + (if (match-string 2) "R" "L")))) (should (equal (buffer-string) after))))) (ert-deftest test-count-matches () diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index 9a7fb502d7c..932291afcc1 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el @@ -24,6 +24,10 @@ (require 'ert) (require 'ses) +;; Silence byte-compiler. +(with-suppressed-warnings ((lexical A2) (lexical A3)) + (defvar A2) + (defvar A3)) ;; PLAIN FORMULA TESTS ;; ====================================================================== diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index e02de952f2f..063c6fe6a7b 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -926,6 +926,7 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (should-not (apropos-internal "^next-line$" #'keymapp))) +(defvar test-global-boundp) (ert-deftest test-buffer-local-boundp () (let ((buf (generate-new-buffer "boundp"))) (with-current-buffer buf diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el index 6964d423185..dd430cac2fd 100644 --- a/test/lisp/tar-mode-tests.el +++ b/test/lisp/tar-mode-tests.el @@ -24,6 +24,12 @@ (defvar tar-mode-tests-data-directory (expand-file-name "test/data/decompress" source-directory)) +;; Hack to work around the ERT limitation that we can't reliably use +;; `with-suppressed-warnings' inside an `ert-deftest'. (Bug#36568) +(defun tar-mode-tests--tar-grind-file-mode (&rest args) + (with-suppressed-warnings ((obsolete tar-grind-file-mode)) + (apply #'tar-grind-file-mode args))) + (ert-deftest tar-mode-test-tar-grind-file-mode () (let ((alist (list (cons 448 "rwx------") (cons 420 "rw-r--r--") @@ -32,7 +38,7 @@ (cons 1024 "-----S---") (cons 2048 "--S------")))) (dolist (x alist) - (should (equal (cdr x) (tar-grind-file-mode (car x))))))) + (should (equal (cdr x) (tar-mode-tests--tar-grind-file-mode (car x))))))) (ert-deftest tar-mode-test-tar-extract-gz () (skip-unless (executable-find "gzip")) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index dfc12735bda..8cc271b9e1c 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -433,26 +433,27 @@ comparing the subr with a much slower Lisp implementation." ;; More specifically, test the problem seen in bug#41029 where setting ;; the default value of a variable takes time proportional to the ;; number of buffers. - (let* ((fun #'error) - (test (lambda () - (with-temp-buffer - (let ((st (car (current-cpu-time)))) - (dotimes (_ 1000) - (let ((case-fold-search 'data-test)) - ;; Use an indirection through a mutable var - ;; to try and make sure the byte-compiler - ;; doesn't optimize away the let bindings. - (funcall fun))) - ;; FIXME: Handle the wraparound, if any. - (- (car (current-cpu-time)) st))))) - (_ (setq fun #'ignore)) - (time1 (funcall test)) - (bufs (mapcar (lambda (_) (generate-new-buffer " data-test")) - (make-list 1000 nil))) - (time2 (funcall test))) - (mapc #'kill-buffer bufs) - ;; Don't divide one time by the other since they may be 0. - (should (< time2 (* time1 5))))) + (when (fboundp 'current-cpu-time) ; silence byte-compiler + (let* ((fun #'error) + (test (lambda () + (with-temp-buffer + (let ((st (car (current-cpu-time)))) + (dotimes (_ 1000) + (let ((case-fold-search 'data-test)) + ;; Use an indirection through a mutable var + ;; to try and make sure the byte-compiler + ;; doesn't optimize away the let bindings. + (funcall fun))) + ;; FIXME: Handle the wraparound, if any. + (- (car (current-cpu-time)) st))))) + (_ (setq fun #'ignore)) + (time1 (funcall test)) + (bufs (mapcar (lambda (_) (generate-new-buffer " data-test")) + (make-list 1000 nil))) + (time2 (funcall test))) + (mapc #'kill-buffer bufs) + ;; Don't divide one time by the other since they may be 0. + (should (< time2 (* time1 5)))))) ;; More tests to write - ;; kill-local-variable diff --git a/test/src/search-tests.el b/test/src/search-tests.el index b7b4ab9a8ff..b5f4730f265 100644 --- a/test/src/search-tests.el +++ b/test/src/search-tests.el @@ -28,7 +28,7 @@ (setq ov-set (make-overlay 3 5)) (overlay-put ov-set 'modification-hooks - (list (lambda (o after &rest _args) + (list (lambda (_o after &rest _args) (when after (let ((inhibit-modification-hooks t)) (save-excursion