From dd1220b96972d77e5bbe1094586514bae63fe1eb Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 18 Sep 2021 13:12:41 +0200 Subject: ; More stylistic docfixes in emacs-lisp/*.el found by checkdoc --- lisp/emacs-lisp/ert.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 92acfe7246f..d4d8510064a 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1958,9 +1958,9 @@ non-nil, returns the face for expected results.." nil) (defun ert--results-font-lock-function (enabledp) - "Redraw the ERT results buffer after font-lock-mode was switched on or off. + "Redraw the ERT results buffer after `font-lock-mode' was switched on or off. -ENABLEDP is true if font-lock-mode is switched on, false +ENABLEDP is true if `font-lock-mode' is switched on, false otherwise." (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) (ewoc-refresh ert--results-ewoc) -- cgit v1.2.3 From 0b099e34dc726c3ed0e7b63028f42c2a2720ba7c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 23 Sep 2021 14:02:21 +0200 Subject: Use ambient lexical-binding value in ert-deftest body (bug#50738) * lisp/emacs-lisp/ert.el (ert-deftest): Evaluate the body of `ert-deftest` with the `lexical-binding` value of the source file (or more precisely the value in force when the definition is evaluated), which is what everyone expected, instead of always using dynamic binding which is what they got until now. * test/lisp/emacs-lisp/ert-tests.el (ert-test-deftest-lexical-binding-t): New test. --- lisp/emacs-lisp/ert.el | 6 +++++- test/lisp/emacs-lisp/ert-tests.el | 4 ++++ 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d4d8510064a..6d867abd7a2 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -218,7 +218,11 @@ it has to be wrapped in `(eval (quote ...))'. `(:expected-result-type ,expected-result)) ,@(when tags-supplied-p `(:tags ,tags)) - :body (lambda () ,@body))) + :body (lambda () + ;; Use the value of `lexical-binding' in + ;; the source file when evaluating the body. + (let ((lexical-binding ,lexical-binding)) + ,@body)))) ',name)))) (defvar ert--find-test-regexp diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 5c9696105e9..a18664bba3b 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -816,6 +816,10 @@ This macro is used to test if macroexpansion in `should' works." (should (equal (ert-test-failed-condition result) '(ert-test-failed "Boo"))))) +(ert-deftest ert-test-deftest-lexical-binding-t () + "Check that `lexical-binding' in `ert-deftest' has the file value." + (should (equal lexical-binding t))) + (provide 'ert-tests) -- cgit v1.2.3 From f4ea15907aeb020b80d021a8d6bf212bcde08ab9 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 26 Sep 2021 13:18:29 +0200 Subject: ert: Add basic explainer for string-equal * lisp/emacs-lisp/ert.el (ert--explain-string-equal): Add basic explainer for 'string-equal' based on 'ert--explain-equal'. --- lisp/emacs-lisp/ert.el | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 6d867abd7a2..e72321f90ff 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -540,6 +540,14 @@ Returns nil if they are." (ert--explain-equal-rec a b))) (put 'equal 'ert-explainer 'ert--explain-equal) +(defun ert--explain-string-equal (a b) + "Explainer function for `string-equal'." + ;; Convert if they are symbols. + (let ((as (if (symbolp a) (symbol-name a) a)) + (bs (if (symbolp b) (symbol-name b) b))) + (ert--explain-equal-rec as bs))) +(put 'string-equal 'ert-explainer 'ert--explain-string-equal) + (defun ert--significant-plist-keys (plist) "Return the keys of PLIST that have non-null values, in order." (cl-assert (zerop (mod (length plist) 2)) t) -- cgit v1.2.3 From b8b1d8dee7e30415b057b7a45f288fda3601274f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 26 Sep 2021 15:29:20 +0200 Subject: Add fast-path to ert--explain-string-equal MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/emacs-lisp/ert.el (ert--explain-string-equal): Add fast-path to avoid doing extra work. Problem reported by Mattias Engdegård . --- lisp/emacs-lisp/ert.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index e72321f90ff..72fe19461f7 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -543,9 +543,11 @@ Returns nil if they are." (defun ert--explain-string-equal (a b) "Explainer function for `string-equal'." ;; Convert if they are symbols. - (let ((as (if (symbolp a) (symbol-name a) a)) - (bs (if (symbolp b) (symbol-name b) b))) - (ert--explain-equal-rec as bs))) + (if (string-equal a b) + nil + (let ((as (if (symbolp a) (symbol-name a) a)) + (bs (if (symbolp b) (symbol-name b) b))) + (ert--explain-equal-rec as bs)))) (put 'string-equal 'ert-explainer 'ert--explain-string-equal) (defun ert--significant-plist-keys (plist) -- cgit v1.2.3 From 1a653209030279aa03898f647376f768f5d1e9f2 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 1 Oct 2021 12:17:47 +0200 Subject: Add new functionality to write buffer-based tests * doc/misc/ert.texi (erts files): New node. * lisp/files.el (auto-mode-alist): Map .erts to erts-mode. * lisp/emacs-lisp/ert.el (ert-test-erts-file): New function. * lisp/emacs-lisp/ert.el (ert--erts-specifications) (ert--erts-unquote): Helper functions. * lisp/progmodes/erts-mode.el: New mode and file. --- doc/misc/ert.texi | 110 ++++++++++++++++++++++++++++++++++++++++ etc/NEWS | 6 +++ lisp/emacs-lisp/ert.el | 104 ++++++++++++++++++++++++++++++++++++++ lisp/files.el | 1 + lisp/progmodes/erts-mode.el | 119 ++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 340 insertions(+) create mode 100644 lisp/progmodes/erts-mode.el (limited to 'lisp/emacs-lisp/ert.el') diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 19f2d7d609c..6604829b2b3 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -486,6 +486,7 @@ to find where a test was defined if the test was loaded from a file. * Expected Failures:: Tests for known bugs. * Tests and Their Environment:: Don't depend on customizations; no side effects. * Useful Techniques:: Some examples. +* erts files:: Files containing many buffer tests. @end menu @node The @code{should} Macro @@ -767,6 +768,115 @@ code is to restructure the code slightly to provide better interfaces for testing. Usually, this makes the interfaces easier to use as well. +@node erts files +@section erts files + +@findex ert-test-erts-file +Many relevant Emacs tests depend on comparing the contents of a buffer +before and after executing a particular function. These tests can be +written the normal way---making a temporary buffer, inserting the +``before'' text, running the function, and then comparing with the +expected ``after'' text. However, this often leads to test code +that's pretty difficult to read and write, especially when the text in +question is multi-line. + +So ert provides a function called @code{ert-test-erts-file} that takes +two parameters: The name of a specially-formatted @dfn{erts} file, and +(optionally) a function that performs the transform. + +@findex erts-mode +These erts files can be edited with the @code{erts-mode} major mode. + +An erts file is divided into sections by the (@samp{=-=}) separator. + +Here's an example file containing two tests: + +@example +Name: flet + +=-= +(cl-flet ((bla (x) +(* x x))) +(bla 42)) +=-= +(cl-flet ((bla (x) + (* x x))) + (bla 42)) +=-=-= + +Name: defun + +=-= +(defun x () + (print (quote ( thingy great + stuff)))) +=-=-= +@end example + +A test starts with a line containing just @samp{=-=} and ends with a +line containing just just @samp{=-=-=}. The test may be preceded by +freeform text (for instance, comments), and also name/value pairs (see +below for a list of them). + +If there is a line with @samp{=-=} inside the test, that designates +the start of the ``after'' text. Otherwise, the ``before'' and +``after'' texts are assumed to be identical, which you typically see +when writing indentation tests. + +@code{ert-test-erts-file} puts the ``before'' section into a temporary +buffer, calls the transform function, and then compares with the +``after'' section. + +Here's an example usage: + +@lisp +(ert-test-erts-file "elisp.erts" + (lambda () + (emacs-lisp-mode) + (indent-region (point-min) (point-max)))) +@end lisp + +A list of the name/value specifications that can appear before a test +follows. The general syntax is @samp{Name: Value}, but continuation +lines can be used (along the same lines as in mail -- subsequent lines +that start with a space are part of the value). + +@example +Name: foo +Code: (indent-region + (point-min) (point-max)) +@end example + +@table @samp +@item Name +All tests should have a name. This name will appear in the output +from ert if the test fails, and helps identifying the failing test. + +@item Code +This is the code that will be run to do the transform. This can also +be passed in via the @code{ert-test-erts-file} call, but @samp{Code} +overrides that. It's used not only in the following test, but in all +subsequent tests in the file (until overridden by another @samp{Code} +specification). + +@item No-Before-Newline +@itemx No-After-Newline +These specifications say whether the ``before'' or ``after'' portions +have a newline at the end. (This would otherwise be impossible to +specify.) + +@item Point-Char +Sometimes it's useful to be able to put point at a specific place +before executing the transform character. @samp{Point-Char: |} will +make @code{ert-test-erts-file} place point where @samp{|} is in the +``before'' form (and remove that character), and will check that it's +where the @samp{|} character is in the ``after'' form (and issue a +test failure if that isn't the case). (This is used in all subsequent +tests, unless overridden by a new @samp{Point-Char} spec.) +@end table + +If you need to use the literal line single line @samp{=-=} in a test +section, you can quote it with a @samp{\} character. @node How to Debug Tests @chapter How to Debug Tests diff --git a/etc/NEWS b/etc/NEWS index 04b690806d9..cf3c8b6eb0b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -46,6 +46,12 @@ buffer is already open. Now, the old point is pushed to mark ring. * New Modes and Packages in Emacs 29.1 ++++ +** New mode 'erts-mode' +This mode is used to edit files geared towards testing actions in +Emacs buffers, like indentation and the like. The new ert function +'ert-test-erts-file' is used to parse these files. + * Incompatible Lisp Changes in Emacs 29.1 diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 72fe19461f7..204ccf5858a 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -63,6 +63,7 @@ (require 'ewoc) (require 'find-func) (require 'pp) +(require 'map) ;;; UI customization options. @@ -2661,6 +2662,109 @@ To be used in the ERT results buffer." 'ert--activate-font-lock-keywords) nil) +(defun ert-test-erts-file (file &optional transform) + "Parse FILE as a file containing before/after parts. +TRANSFORM will be called to get from before to after." + (with-temp-buffer + (insert-file-contents file) + (let ((gen-specs (list (cons 'dummy t) + (cons 'code transform)))) + ;; The start of the "before" part starts with a form feed and then + ;; the name of the test. + (while (re-search-forward "^=-=\n" nil t) + (let* ((file-buffer (current-buffer)) + (specs (ert--erts-specifications (match-beginning 0))) + (name (cdr (assq 'name specs))) + (start-before (point)) + (end-after (if (re-search-forward "^=-=-=\n" nil t) + (match-beginning 0) + (point-max))) + end-before start-after + after after-point) + (goto-char end-after) + ;; We have a separate after section. + (if (re-search-backward "^=-=\n" start-before t) + (setq end-before (match-beginning 0) + start-after (match-end 0)) + (setq end-before end-after + start-after start-before)) + ;; Update persistent specs. + (when-let ((point-char (assq 'point-char specs))) + (setq gen-specs + (map-insert gen-specs 'point-char (cdr point-char)))) + (when-let ((code (cdr (assq 'code specs)))) + (setq gen-specs + (map-insert gen-specs 'code (car (read-from-string code))))) + ;; Get the "after" strings. + (with-temp-buffer + (insert-buffer-substring file-buffer start-after end-after) + (ert--erts-unquote) + ;; Remove the newline at the end of the buffer. + (when-let ((no-newline (cdr (assq 'no-after-newline specs)))) + (goto-char (point-min)) + (when (re-search-forward "\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + ;; Get the expected "after" point. + (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (goto-char (point-min)) + (when (search-forward point-char nil t) + (delete-region (match-beginning 0) (match-end 0)) + (setq after-point (point)))) + (setq after (buffer-string))) + ;; Do the test. + (with-temp-buffer + (insert-buffer-substring file-buffer start-before end-before) + (ert--erts-unquote) + ;; Remove the newline at the end of the buffer. + (when-let ((no-newline (cdr (assq 'no-before-newline specs)))) + (goto-char (point-min)) + (when (re-search-forward "\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (goto-char (point-min)) + ;; Place point in the specified place. + (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (when (search-forward point-char nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (funcall (cdr (assq 'code gen-specs))) + (unless (equal (buffer-string) after) + (ert-fail (list (format "Mismatch in test \"%s\", file %s" + name file) + (buffer-string) + after))) + (when (and after-point + (not (= after-point (point)))) + (ert-fail (list (format "Point wrong in test \"%s\", expected point %d, actual %d, file %s" + name + after-point (point) + file) + (buffer-string)))))))))) + +(defun ert--erts-unquote () + (goto-char (point-min)) + (while (re-search-forward "^\\=-=\\(-=\\)$" nil t) + (delete-region (match-beginning 0) (1+ (match-beginning 0))))) + +(defun ert--erts-specifications (end) + "Find specifications before point (back to the previous test)." + (save-excursion + (goto-char end) + (goto-char + (if (re-search-backward "^=-=-=\n" nil t) + (match-end 0) + (point-min))) + (let ((specs nil)) + (while (< (point) end) + (if (looking-at "\\([^ \n\t:]+\\):\\([ \t]+\\)?\\(.*\\)") + (let ((name (intern (downcase (match-string 1)))) + (value (match-string 3))) + (forward-line 1) + (while (looking-at "[ \t]+\\(.*\\)") + (setq value (concat value (match-string 1))) + (forward-line 1)) + (push (cons name value) specs)) + (forward-line 1))) + (nreverse specs)))) + (defvar ert-unload-hook ()) (add-hook 'ert-unload-hook #'ert--unload-function) diff --git a/lisp/files.el b/lisp/files.el index 05875b48e39..50ca49409f1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2883,6 +2883,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . ("\\.[ds]?va?h?\\'" . verilog-mode) ("\\.by\\'" . bovine-grammar-mode) ("\\.wy\\'" . wisent-grammar-mode) + ("\\.erts\\'" . erts-mode) ;; .emacs or .gnus or .viper following a directory delimiter in ;; Unix or MS-DOS syntax. ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el new file mode 100644 index 00000000000..cf7eca50c5d --- /dev/null +++ b/lisp/progmodes/erts-mode.el @@ -0,0 +1,119 @@ +;;; erts-mode.el --- major mode to edit erts files -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(defgroup erts-mode nil + "Major mode for editing Emacs test files." + :group 'lisp) + +(defface erts-mode-specification-name + '((((class color) + (background dark)) + :foreground "green") + (((class color) + (background light)) + :foreground "cornflower blue") + (t + :bold t)) + "Face used for displaying specification names." + :group 'erts-mode) + +(defface erts-mode-specification-value + '((((class color) + (background dark)) + :foreground "DeepSkyBlue1") + (((class color) + (background light)) + :foreground "blue") + (t + :bold t)) + "Face used for displaying specificaton values." + :group 'erts-mode) + +(defface erts-mode-start-test + '((t :inherit font-lock-keyword-face)) + "Face used for displaying specificaton test start markers." + :group 'erts-mode) + +(defface erts-mode-end-test + '((t :inherit font-lock-comment-face)) + "Face used for displaying specificaton test start markers." + :group 'erts-mode) + +(defvar erts-mode-map + (let ((map (make-keymap))) + (set-keymap-parent map prog-mode-map) + map)) + +(defvar erts-mode-font-lock-keywords + ;; Specifications. + `((erts-mode--match-not-in-test + ("^\\([^ \t\n:]+:\\)[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?" + (progn (goto-char (match-beginning 0)) (match-end 0)) nil + (1 'erts-mode-specification-name) + (2 'erts-mode-specification-value))) + ("^=-=$" 0 'erts-mode-start-test) + ("^=-=-=$" 0 'erts-mode-end-test))) + +(defun erts-mode--match-not-in-test (_limit) + (when (erts-mode--in-test-p (point)) + (erts-mode--end-of-test)) + (let ((start (point))) + (goto-char + (if (re-search-forward "^=-=$" nil t) + (match-beginning 0) + (point-max))) + (if (< (point) start) + nil + ;; Here we disregard LIMIT so that we may extend the area again. + (set-match-data (list start (point))) + (point)))) + +(defun erts-mode--end-of-test () + (search-forward "^=-=-=\n" nil t)) + +(defun erts-mode--in-test-p (point) + "Say whether POINT is in a test." + (save-excursion + (goto-char point) + (beginning-of-line) + (if (looking-at "=-=\\(-=\\)?$") + t + (let ((test-start (re-search-backward "^=-=\n" nil t))) + ;; Before the first test. + (and test-start + (let ((test-end (re-search-backward "^=-=-=\n" nil t))) + (or (null test-end) + ;; Between tests. + (> test-start test-end)))))))) + +;;;###autoload +(define-derived-mode erts-mode prog-mode "erts" + "Major mode for editing erts (Emacs testing) files. +This mode mainly provides some font locking." + (setq-local font-lock-defaults '(erts-mode-font-lock-keywords t))) + +(provide 'erts-mode) + +;;; erts-mode.el ends here -- cgit v1.2.3 From 295d552e4ea3b88e1a75f21aa050abd3074fb557 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 1 Oct 2021 13:20:20 +0200 Subject: Allow skipping erts tests * doc/misc/ert.texi (erts files): Document it. * lisp/emacs-lisp/ert.el (ert-test-erts-file): Allow skipping tests. --- doc/misc/ert.texi | 4 ++ lisp/emacs-lisp/ert.el | 123 +++++++++++++++++++++++++++---------------------- 2 files changed, 71 insertions(+), 56 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi index 6604829b2b3..0eb9cdf09f6 100644 --- a/doc/misc/ert.texi +++ b/doc/misc/ert.texi @@ -873,6 +873,10 @@ make @code{ert-test-erts-file} place point where @samp{|} is in the where the @samp{|} character is in the ``after'' form (and issue a test failure if that isn't the case). (This is used in all subsequent tests, unless overridden by a new @samp{Point-Char} spec.) + +@item Skip +If this is present and value is a form that evaluates to a +non-@code{nil} value, the test will be skipped. @end table If you need to use the literal line single line @samp{=-=} in a test diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 204ccf5858a..ca3e4c3765a 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2679,65 +2679,76 @@ TRANSFORM will be called to get from before to after." (end-after (if (re-search-forward "^=-=-=\n" nil t) (match-beginning 0) (point-max))) + (skip (cdr (assq 'skip specs))) end-before start-after after after-point) - (goto-char end-after) - ;; We have a separate after section. - (if (re-search-backward "^=-=\n" start-before t) - (setq end-before (match-beginning 0) - start-after (match-end 0)) - (setq end-before end-after - start-after start-before)) - ;; Update persistent specs. - (when-let ((point-char (assq 'point-char specs))) - (setq gen-specs - (map-insert gen-specs 'point-char (cdr point-char)))) - (when-let ((code (cdr (assq 'code specs)))) - (setq gen-specs - (map-insert gen-specs 'code (car (read-from-string code))))) - ;; Get the "after" strings. - (with-temp-buffer - (insert-buffer-substring file-buffer start-after end-after) - (ert--erts-unquote) - ;; Remove the newline at the end of the buffer. - (when-let ((no-newline (cdr (assq 'no-after-newline specs)))) - (goto-char (point-min)) - (when (re-search-forward "\n\\'" nil t) - (delete-region (match-beginning 0) (match-end 0)))) - ;; Get the expected "after" point. - (when-let ((point-char (cdr (assq 'point-char gen-specs)))) - (goto-char (point-min)) - (when (search-forward point-char nil t) - (delete-region (match-beginning 0) (match-end 0)) - (setq after-point (point)))) - (setq after (buffer-string))) - ;; Do the test. - (with-temp-buffer - (insert-buffer-substring file-buffer start-before end-before) - (ert--erts-unquote) - ;; Remove the newline at the end of the buffer. - (when-let ((no-newline (cdr (assq 'no-before-newline specs)))) + (unless name + (error "No name for test case")) + (if (and skip + (eval (car (read-from-string skip)))) + ;; Skipping this test. + () + ;; Do the test. + (goto-char end-after) + ;; We have a separate after section. + (if (re-search-backward "^=-=\n" start-before t) + (setq end-before (match-beginning 0) + start-after (match-end 0)) + (setq end-before end-after + start-after start-before)) + ;; Update persistent specs. + (when-let ((point-char (assq 'point-char specs))) + (setq gen-specs + (map-insert gen-specs 'point-char (cdr point-char)))) + (when-let ((code (cdr (assq 'code specs)))) + (setq gen-specs + (map-insert gen-specs 'code (car (read-from-string code))))) + ;; Get the "after" strings. + (with-temp-buffer + (insert-buffer-substring file-buffer start-after end-after) + (ert--erts-unquote) + ;; Remove the newline at the end of the buffer. + (when-let ((no-newline (cdr (assq 'no-after-newline specs)))) + (goto-char (point-min)) + (when (re-search-forward "\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + ;; Get the expected "after" point. + (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (goto-char (point-min)) + (when (search-forward point-char nil t) + (delete-region (match-beginning 0) (match-end 0)) + (setq after-point (point)))) + (setq after (buffer-string))) + ;; Do the test. + (with-temp-buffer + (insert-buffer-substring file-buffer start-before end-before) + (ert--erts-unquote) + ;; Remove the newline at the end of the buffer. + (when-let ((no-newline (cdr (assq 'no-before-newline specs)))) + (goto-char (point-min)) + (when (re-search-forward "\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0)))) (goto-char (point-min)) - (when (re-search-forward "\n\\'" nil t) - (delete-region (match-beginning 0) (match-end 0)))) - (goto-char (point-min)) - ;; Place point in the specified place. - (when-let ((point-char (cdr (assq 'point-char gen-specs)))) - (when (search-forward point-char nil t) - (delete-region (match-beginning 0) (match-end 0)))) - (funcall (cdr (assq 'code gen-specs))) - (unless (equal (buffer-string) after) - (ert-fail (list (format "Mismatch in test \"%s\", file %s" - name file) - (buffer-string) - after))) - (when (and after-point - (not (= after-point (point)))) - (ert-fail (list (format "Point wrong in test \"%s\", expected point %d, actual %d, file %s" - name - after-point (point) - file) - (buffer-string)))))))))) + ;; Place point in the specified place. + (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (when (search-forward point-char nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (let ((code (cdr (assq 'code gen-specs)))) + (unless code + (error "No code to run the transform")) + (funcall code)) + (unless (equal (buffer-string) after) + (ert-fail (list (format "Mismatch in test \"%s\", file %s" + name file) + (buffer-string) + after))) + (when (and after-point + (not (= after-point (point)))) + (ert-fail (list (format "Point wrong in test \"%s\", expected point %d, actual %d, file %s" + name + after-point (point) + file) + (buffer-string))))))))))) (defun ert--erts-unquote () (goto-char (point-min)) -- cgit v1.2.3 From 4b90aacf796bd5e750f85ff9bf0400be4fcb2885 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 1 Oct 2021 15:23:32 +0200 Subject: Refactor out ert-test--erts-test * lisp/emacs-lisp/ert.el (ert-test--erts-test): Refactor out the bulk of the function for easier reuse. --- lisp/emacs-lisp/ert.el | 159 +++++++++++++++++++++++++------------------------ 1 file changed, 82 insertions(+), 77 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index ca3e4c3765a..f2b20fd74e5 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2672,83 +2672,88 @@ TRANSFORM will be called to get from before to after." ;; The start of the "before" part starts with a form feed and then ;; the name of the test. (while (re-search-forward "^=-=\n" nil t) - (let* ((file-buffer (current-buffer)) - (specs (ert--erts-specifications (match-beginning 0))) - (name (cdr (assq 'name specs))) - (start-before (point)) - (end-after (if (re-search-forward "^=-=-=\n" nil t) - (match-beginning 0) - (point-max))) - (skip (cdr (assq 'skip specs))) - end-before start-after - after after-point) - (unless name - (error "No name for test case")) - (if (and skip - (eval (car (read-from-string skip)))) - ;; Skipping this test. - () - ;; Do the test. - (goto-char end-after) - ;; We have a separate after section. - (if (re-search-backward "^=-=\n" start-before t) - (setq end-before (match-beginning 0) - start-after (match-end 0)) - (setq end-before end-after - start-after start-before)) - ;; Update persistent specs. - (when-let ((point-char (assq 'point-char specs))) - (setq gen-specs - (map-insert gen-specs 'point-char (cdr point-char)))) - (when-let ((code (cdr (assq 'code specs)))) - (setq gen-specs - (map-insert gen-specs 'code (car (read-from-string code))))) - ;; Get the "after" strings. - (with-temp-buffer - (insert-buffer-substring file-buffer start-after end-after) - (ert--erts-unquote) - ;; Remove the newline at the end of the buffer. - (when-let ((no-newline (cdr (assq 'no-after-newline specs)))) - (goto-char (point-min)) - (when (re-search-forward "\n\\'" nil t) - (delete-region (match-beginning 0) (match-end 0)))) - ;; Get the expected "after" point. - (when-let ((point-char (cdr (assq 'point-char gen-specs)))) - (goto-char (point-min)) - (when (search-forward point-char nil t) - (delete-region (match-beginning 0) (match-end 0)) - (setq after-point (point)))) - (setq after (buffer-string))) - ;; Do the test. - (with-temp-buffer - (insert-buffer-substring file-buffer start-before end-before) - (ert--erts-unquote) - ;; Remove the newline at the end of the buffer. - (when-let ((no-newline (cdr (assq 'no-before-newline specs)))) - (goto-char (point-min)) - (when (re-search-forward "\n\\'" nil t) - (delete-region (match-beginning 0) (match-end 0)))) - (goto-char (point-min)) - ;; Place point in the specified place. - (when-let ((point-char (cdr (assq 'point-char gen-specs)))) - (when (search-forward point-char nil t) - (delete-region (match-beginning 0) (match-end 0)))) - (let ((code (cdr (assq 'code gen-specs)))) - (unless code - (error "No code to run the transform")) - (funcall code)) - (unless (equal (buffer-string) after) - (ert-fail (list (format "Mismatch in test \"%s\", file %s" - name file) - (buffer-string) - after))) - (when (and after-point - (not (= after-point (point)))) - (ert-fail (list (format "Point wrong in test \"%s\", expected point %d, actual %d, file %s" - name - after-point (point) - file) - (buffer-string))))))))))) + (setq gen-specs (ert-test--erts-test gen-specs file)))))) + +(defun ert-test--erts-test (gen-specs file) + (let* ((file-buffer (current-buffer)) + (specs (ert--erts-specifications (match-beginning 0))) + (name (cdr (assq 'name specs))) + (start-before (point)) + (end-after (if (re-search-forward "^=-=-=\n" nil t) + (match-beginning 0) + (point-max))) + (skip (cdr (assq 'skip specs))) + end-before start-after + after after-point) + (unless name + (error "No name for test case")) + (if (and skip + (eval (car (read-from-string skip)))) + ;; Skipping this test. + () + ;; Do the test. + (goto-char end-after) + ;; We have a separate after section. + (if (re-search-backward "^=-=\n" start-before t) + (setq end-before (match-beginning 0) + start-after (match-end 0)) + (setq end-before end-after + start-after start-before)) + ;; Update persistent specs. + (when-let ((point-char (assq 'point-char specs))) + (setq gen-specs + (map-insert gen-specs 'point-char (cdr point-char)))) + (when-let ((code (cdr (assq 'code specs)))) + (setq gen-specs + (map-insert gen-specs 'code (car (read-from-string code))))) + ;; Get the "after" strings. + (with-temp-buffer + (insert-buffer-substring file-buffer start-after end-after) + (ert--erts-unquote) + ;; Remove the newline at the end of the buffer. + (when-let ((no-newline (cdr (assq 'no-after-newline specs)))) + (goto-char (point-min)) + (when (re-search-forward "\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + ;; Get the expected "after" point. + (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (goto-char (point-min)) + (when (search-forward point-char nil t) + (delete-region (match-beginning 0) (match-end 0)) + (setq after-point (point)))) + (setq after (buffer-string))) + ;; Do the test. + (with-temp-buffer + (insert-buffer-substring file-buffer start-before end-before) + (ert--erts-unquote) + ;; Remove the newline at the end of the buffer. + (when-let ((no-newline (cdr (assq 'no-before-newline specs)))) + (goto-char (point-min)) + (when (re-search-forward "\n\\'" nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (goto-char (point-min)) + ;; Place point in the specified place. + (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (when (search-forward point-char nil t) + (delete-region (match-beginning 0) (match-end 0)))) + (let ((code (cdr (assq 'code gen-specs)))) + (unless code + (error "No code to run the transform")) + (funcall code)) + (unless (equal (buffer-string) after) + (ert-fail (list (format "Mismatch in test \"%s\", file %s" + name file) + (buffer-string) + after))) + (when (and after-point + (not (= after-point (point)))) + (ert-fail (list (format "Point wrong in test \"%s\", expected point %d, actual %d, file %s" + name + after-point (point) + file) + (buffer-string))))))) + ;; Return the new value of the general specifications. + gen-specs) (defun ert--erts-unquote () (goto-char (point-min)) -- cgit v1.2.3 From 0f2df365592636aaa6bcd72fc662774eb35c69d1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 4 Oct 2021 18:11:40 +0200 Subject: Run ERT tests with `lexical-binding` bound to `t` * lisp/emacs-lisp/ert.el (ert-deftest, ert--run-test-internal): Use t rather than the ambient file value for `lexical-binding` to avoid bad lexbind coverage by mistake. --- lisp/emacs-lisp/ert.el | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index f2b20fd74e5..607f15d254f 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -219,11 +219,7 @@ it has to be wrapped in `(eval (quote ...))'. `(:expected-result-type ,expected-result)) ,@(when tags-supplied-p `(:tags ,tags)) - :body (lambda () - ;; Use the value of `lexical-binding' in - ;; the source file when evaluating the body. - (let ((lexical-binding ,lexical-binding)) - ,@body)))) + :body (lambda () ,@body))) ',name)))) (defvar ert--find-test-regexp @@ -780,7 +776,8 @@ This mainly sets up debugger-related bindings." ;; handle ert errors. Once that's done, remove ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for ;; details. - (let ((debugger (lambda (&rest args) + (let ((lexical-binding t) + (debugger (lambda (&rest args) (ert--run-test-debugger test-execution-info args))) (debug-on-error t) -- cgit v1.2.3 From 0a7bab689c4a113dd295c9db55d8e76a34d5f9e1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 27 Sep 2021 23:56:55 +0200 Subject: ; Minor stylistic fixes found by checkdoc --- lisp/allout-widgets.el | 2 +- lisp/allout.el | 10 +++++----- lisp/calc/calc-prog.el | 2 +- lisp/cedet/semantic/wisent/python.el | 6 +++--- lisp/cedet/srecode/dictionary.el | 2 +- lisp/dired-aux.el | 2 +- lisp/emacs-lisp/autoload.el | 10 +++++----- lisp/emacs-lisp/avl-tree.el | 3 +-- lisp/emacs-lisp/byte-run.el | 3 ++- lisp/emacs-lisp/bytecomp.el | 6 +++--- lisp/emacs-lisp/cl-extra.el | 2 +- lisp/emacs-lisp/ert.el | 2 +- lisp/emacs-lisp/ewoc.el | 4 ++-- lisp/emacs-lisp/lisp-mode.el | 4 ++-- lisp/emacs-lisp/smie.el | 2 +- lisp/emacs-lisp/tabulated-list.el | 2 +- lisp/emacs-lisp/timer.el | 19 +++++++++++++------ lisp/emulation/viper-cmd.el | 2 +- lisp/files.el | 6 +++--- lisp/format.el | 2 +- lisp/gnus/gnus-srvr.el | 4 ++-- lisp/gnus/gnus-start.el | 2 +- lisp/gnus/mml-sec.el | 6 +++--- lisp/gnus/nnrss.el | 2 +- lisp/hilit-chg.el | 2 +- lisp/ibuf-ext.el | 2 +- lisp/international/ccl.el | 6 +++--- lisp/mail/feedmail.el | 2 +- lisp/net/ange-ftp.el | 2 +- lisp/net/soap-client.el | 4 ++-- lisp/net/soap-inspect.el | 2 +- lisp/obsolete/cust-print.el | 10 +++++----- lisp/obsolete/landmark.el | 12 ++++++------ lisp/obsolete/tls.el | 4 ++-- lisp/obsolete/vip.el | 14 +++++++------- lisp/printing.el | 2 +- lisp/progmodes/cc-cmds.el | 13 ++++++------- lisp/progmodes/cc-mode.el | 2 +- lisp/progmodes/cc-vars.el | 2 +- lisp/progmodes/cperl-mode.el | 6 +++--- lisp/progmodes/ebnf-dtd.el | 2 +- lisp/progmodes/idlw-shell.el | 5 +++-- lisp/progmodes/idlwave.el | 5 ++--- lisp/progmodes/opascal.el | 6 +++--- lisp/progmodes/prolog.el | 4 ++-- lisp/progmodes/sh-script.el | 2 +- lisp/progmodes/sql.el | 4 ++-- lisp/progmodes/verilog-mode.el | 4 ++-- lisp/progmodes/vhdl-mode.el | 19 +++++++++---------- lisp/progmodes/xscheme.el | 2 +- lisp/ps-print.el | 2 +- lisp/textmodes/reftex-global.el | 2 +- lisp/textmodes/reftex-ref.el | 2 +- lisp/textmodes/texnfo-upd.el | 4 ++-- lisp/vc/ediff-mult.el | 2 +- lisp/vc/ediff-util.el | 2 +- lisp/vc/log-edit.el | 2 +- 57 files changed, 132 insertions(+), 127 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 668e7b91e86..f18d4888543 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -880,7 +880,7 @@ encompassing condition-case." ;; reraise the error, or one concerning this function if unexpected: (if (equal mode 'error) (apply #'signal args) - (error "%s: unexpected mode, %s %s" this mode args)))) + (error "%s: Unexpected mode, %s %s" this mode args)))) ;;;_ > allout-widgets-changes-exceed-threshold-p () (defun allout-widgets-adjusting-message (message) "Post MESSAGE when pending are likely to make a big enough delay. diff --git a/lisp/allout.el b/lisp/allout.el index c123e8ded4c..5102ee73412 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -823,12 +823,12 @@ such topics are encrypted.)" :group 'allout-encryption) (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) (defvar allout-auto-save-temporarily-disabled nil - "True while topic encryption is pending and auto-saving was active. + "Non-nil while topic encryption is pending and auto-saving was active. The value of `buffer-saved-size' at the time of decryption is used, for restoring when all encryptions are established.") (defvar-local allout-just-did-undo nil - "True just after undo commands, until allout-post-command-business.") + "Non-nil just after undo commands, until allout-post-command-business.") ;;;_ + Developer ;;;_ = allout-developer group @@ -3190,7 +3190,7 @@ Set by `allout-pre-command-business', to support allout addons in coordinating with allout activity.") ;;;_ = allout-this-command-hid-text (defvar-local allout-this-command-hid-text nil - "True if the most recent allout-mode command hid any text.") + "Non-nil if the most recent `allout-mode' command hid any text.") ;;;_ > allout-post-command-business () (defun allout-post-command-business () "Outline `post-command-hook' function. @@ -4787,7 +4787,7 @@ Useful for coherently exposing to a random point in a hidden region." (setq bag-it (1+ bag-it)) (if (> bag-it 1) (error "allout-show-to-offshoot: %s" - "Stumped by aberrant nesting."))) + "Stumped by aberrant nesting"))) (if (> bag-it 0) (setq bag-it 0)) (allout-show-children) (goto-char orig-pref))) @@ -5402,7 +5402,7 @@ Defaults: ;; Specified but not a buffer -- get it: (let ((got (get-buffer frombuf))) (if (not got) - (error "allout-process-exposed: source buffer %s not found." + (error "allout-process-exposed: Source buffer %s not found" frombuf) (setq frombuf got)))) ;; not specified -- default it: diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index f9dd9eb98a9..3492b6d831b 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -124,7 +124,7 @@ (or (memq (car-safe (car-safe place)) '(error xxxerror)) (setq place (aref (nth 2 (nth 2 (symbol-function 'calc-do))) 27))) (or (memq (car (car place)) '(error xxxerror)) - (error "foo")) + (error "Foo")) (setcar (car place) 'xxxerror)) (error (error "The calc-do function has been modified; unable to patch")))) diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el index fb878dde712..2eeade66467 100644 --- a/lisp/cedet/semantic/wisent/python.el +++ b/lisp/cedet/semantic/wisent/python.el @@ -118,9 +118,9 @@ curly braces." ;; look-ahead assertions.) (when (and (= (- end start) 2) (looking-at "\"\\{3\\}\\|'\\{3\\}")) - (error "unterminated syntax")) + (error "Unterminated syntax")) (goto-char end)) - (error "unterminated syntax"))) + (error "Unterminated syntax"))) (defun wisent-python-forward-balanced-expression () "Move point to the end of the balanced expression at point. @@ -145,7 +145,7 @@ triple-quoted string syntax." ;; delimiter (backquote) characters, line continuation, and end ;; of comment characters (AKA newline characters in Python). ((zerop (skip-syntax-forward "-w_.$\\>")) - (error "can't figure out how to go forward from here")))) + (error "Can't figure out how to go forward from here")))) ;; Skip closing character. As a last resort this should raise an ;; error if we hit EOB before we find our closing character.. (forward-char 1))) diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el index d6dfc58411e..e47a09fd846 100644 --- a/lisp/cedet/srecode/dictionary.el +++ b/lisp/cedet/srecode/dictionary.el @@ -364,7 +364,7 @@ values but STATE is nil." ;; Value is some other object; create a compound value. (t (unless state - (error "Cannot insert compound values without state.")) + (error "Cannot insert compound values without state")) (srecode-dictionary-set-value dict name diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 4b8d2710715..32375ac5253 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2736,7 +2736,7 @@ This function takes some pains to conform to `ls -lR' output." ;; Check that it is valid to insert DIRNAME with SWITCHES. ;; Signal an error if invalid (e.g. user typed `i' on `..'). (or (file-in-directory-p dirname (expand-file-name default-directory)) - (error "%s: not in this directory tree" dirname)) + (error "%s: Not in this directory tree" dirname)) (let ((real-switches (or switches dired-subdir-switches))) (when real-switches (let (case-fold-search) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index f620cdbb335..aaacba2c8e5 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -462,7 +462,7 @@ if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." (insert "\n" generate-autoload-section-continuation)))))) (defun autoload-find-file (file) - "Fetch file and put it in a temp buffer. Return the buffer." + "Fetch FILE and put it in a temp buffer. Return the buffer." ;; It is faster to avoid visiting the file. (setq file (expand-file-name file)) (with-current-buffer (get-buffer-create " *autoload-file*") @@ -482,10 +482,10 @@ if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)." "File local variable to prevent scanning this file for autoload cookies.") (defun autoload-file-load-name (file outfile) - "Compute the name that will be used to load FILE." - ;; OUTFILE should be the name of the global loaddefs.el file, which - ;; is expected to be at the root directory of the files we're - ;; scanning for autoloads and will be in the `load-path'. + "Compute the name that will be used to load FILE. +OUTFILE should be the name of the global loaddefs.el file, which +is expected to be at the root directory of the files we are +scanning for autoloads and will be in the `load-path'." (let* ((name (file-relative-name file (file-name-directory outfile))) (names '()) (dir (file-name-directory outfile))) diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 4382985eb85..3f803107a17 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -330,8 +330,7 @@ inserted data." data))) (if (or (funcall cmpfun newdata data) (funcall cmpfun data newdata)) - (error "avl-tree-enter:\ - updated data does not match existing data")) + (error "avl-tree-enter: Updated data does not match existing data")) (setf (avl-tree--node-data br) newdata) (cons nil newdata)) ; return value )))) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 35c80e524cf..da86fa5cecf 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -422,7 +422,8 @@ was first made obsolete, for example a date or a release number." &optional docstring) "Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete. -\(define-obsolete-function-alias \\='old-fun \\='new-fun \"28.1\" \"old-fun's doc.\") +\(define-obsolete-function-alias \\='old-fun \\='new-fun \"28.1\" \ +\"old-fun's doc.\") is equivalent to the following two lines of code: diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0856626b7bb..3f050d1b799 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1082,7 +1082,7 @@ If STR is something like \"Buffer foo.el\", return # (defconst emacs-lisp-compilation-parse-errors-filename-function #'emacs-lisp-compilation-file-name-or-buffer "The value for `compilation-parse-errors-filename-function' for when -we go into emacs-lisp-compilation-mode.") +we go into `emacs-lisp-compilation-mode'.") (defcustom emacs-lisp-compilation-search-path '(nil) "Directories to search for files named in byte-compile error messages. @@ -2810,8 +2810,8 @@ not to take responsibility for the actual compilation of the code." t))))) (defun byte-compile-output-as-comment (exp quoted) - "Print Lisp object EXP in the output file, inside a comment, -and return the file (byte) position it will have. + "Print Lisp object EXP in the output file, inside a comment. +Return the file (byte) position it will have. If QUOTED is non-nil, print with quoting; otherwise, print without quoting." (with-current-buffer byte-compile--outbuffer (let ((position (point))) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 0ed75475097..499d26b737b 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -336,7 +336,7 @@ non-nil value. ;;;###autoload (defun cl-isqrt (x) - "Return the integer square root of the (integer) argument." + "Return the integer square root of the (integer) argument X." (if (and (integerp x) (> x 0)) (let ((g (ash 2 (/ (logb x) 2))) g2) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 72fe19461f7..98cb1fd1cf6 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -262,7 +262,7 @@ DATA is displayed to the user and should state the reason for skipping." ;; See Bug#24402 for why this exists (defun ert--should-signal-hook (error-symbol data) "Stupid hack to stop `condition-case' from catching ert signals. -It should only be stopped when ran from inside ert--run-test-internal." +It should only be stopped when ran from inside `ert--run-test-internal'." (when (and (not (symbolp debugger)) ; only run on anonymous debugger (memq error-symbol '(ert-test-failed ert-test-skipped))) (funcall debugger 'error (cons error-symbol data)))) diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index 68f94edafd9..8636dc92a1c 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -49,7 +49,7 @@ ;; ;; Ewoc is a package that implements a connection between an ;; dll (a doubly linked list) and the contents of a buffer. -;; Possible uses are dired (have all files in a list, and show them), +;; Possible uses are Dired (have all files in a list, and show them), ;; buffer-list, kom-prioritize (in the LysKOM elisp client) and ;; others. pcl-cvs.el and vc.el use ewoc.el. ;; @@ -381,7 +381,7 @@ arguments will be passed to MAP-FUNCTION." (defun ewoc-filter (ewoc predicate &rest args) "Remove all elements in EWOC for which PREDICATE returns nil. -Note that the buffer for EWOC will be current-buffer when PREDICATE +Note that the buffer for EWOC will be the current buffer when PREDICATE is called. PREDICATE must restore the current buffer before it returns if it changes it. The PREDICATE is called with the element as its first argument. If any diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index eac3c03cd1e..fc7a7362cd7 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -556,7 +556,7 @@ This will generate compile-time constants from BINDINGS." "Gaudy highlighting from Emacs Lisp mode used in Backtrace mode.") (defun lisp-string-in-doc-position-p (listbeg startpos) - "Return true if a doc string may occur at STARTPOS inside a list. + "Return non-nil if a doc string may occur at STARTPOS inside a list. LISTBEG is the position of the start of the innermost list containing STARTPOS." (let* ((firstsym (and listbeg @@ -589,7 +589,7 @@ containing STARTPOS." (= (point) startpos)))))) (defun lisp-string-after-doc-keyword-p (listbeg startpos) - "Return true if `:documentation' symbol ends at STARTPOS inside a list. + "Return non-nil if `:documentation' symbol ends at STARTPOS inside a list. LISTBEG is the position of the start of the innermost list containing STARTPOS." (and listbeg ; We are inside a Lisp form. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index d775f152b36..8e14faea3a4 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1302,7 +1302,7 @@ Only meaningful when called from within `smie-rules-function'." (let ((tok (funcall smie-forward-token-function))) (unless tok (with-demoted-errors - (error "smie-rule-separator: can't skip token %s" + (error "smie-rule-separator: Can't skip token %s" smie--token)))) (skip-chars-forward " ") (unless (eolp) (point))))) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 5210b2be5e0..0ae355e5917 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -256,7 +256,7 @@ Populated by `tabulated-list-init-header'.") (defvar tabulated-list--header-overlay nil) (defun tabulated-list-line-number-width () - "Return the width taken by display-line-numbers in the current buffer." + "Return the width taken by `display-line-numbers' in the current buffer." ;; line-number-display-width returns the value for the selected ;; window, which might not be the window in which the current buffer ;; is displayed. diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 382f6bb1fa3..1ef4931b7be 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -125,9 +125,12 @@ of SECS seconds since the epoch. SECS may be a fraction." (time-convert (cons (- more-ticks (% more-ticks trunc-s-ticks)) hz))))) (defun timer-relative-time (time secs &optional usecs psecs) - "Advance TIME by SECS seconds and optionally USECS microseconds -and PSECS picoseconds. SECS may be either an integer or a -floating point number." + "Advance TIME by SECS seconds. + +Optionally also advance it by USECS microseconds and PSECS +picoseconds. + +SECS may be either an integer or a floating point number." (let ((delta secs)) (if (or usecs psecs) (setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0))))) @@ -138,9 +141,13 @@ floating point number." (time-less-p (timer--time t1) (timer--time t2))) (defun timer-inc-time (timer secs &optional usecs psecs) - "Increment the time set in TIMER by SECS seconds, USECS microseconds, -and PSECS picoseconds. SECS may be a fraction. If USECS or PSECS are -omitted, they are treated as zero." + "Increment the time set in TIMER by SECS seconds. + +Optionally also increment it by USECS microseconds, and PSECS +picoseconds. If USECS or PSECS are omitted, they are treated as +zero. + +SECS may be a fraction." (setf (timer--time timer) (timer-relative-time (timer--time timer) secs usecs psecs))) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 3fcc14c99d7..9f3d515bc6d 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -3767,7 +3767,7 @@ Null string will repeat previous search." (define-key viper-vi-basic-map (cond ((characterp viper-buffer-search-char) (char-to-string viper-buffer-search-char)) - (t (error "viper-buffer-search-char: wrong value type, %S" + (t (error "viper-buffer-search-char: Wrong value type, %S" viper-buffer-search-char))) #'viper-command-argument) (aset viper-exec-array viper-buffer-search-char #'viper-exec-buffer-search) diff --git a/lisp/files.el b/lisp/files.el index 19b88e6621d..64c69e685c8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5597,7 +5597,7 @@ Before and after saving the buffer, this function runs (if (not (file-directory-p dir)) (if (file-exists-p dir) (error "%s is not a directory" dir) - (error "%s: no such directory" dir)) + (error "%s: No such directory" dir)) (if (not (file-exists-p buffer-file-name)) (error "Directory %s write-protected" dir) (if (yes-or-no-p @@ -7948,7 +7948,7 @@ for the specified category of users." ((= char ?g) #o2070) ((= char ?o) #o1007) ((= char ?a) #o7777) - (t (error "%c: bad `who' character" char)))) + (t (error "%c: Bad `who' character" char)))) (defun file-modes-char-to-right (char &optional from) "Convert CHAR to a numeric value of mode bits. @@ -7971,7 +7971,7 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)." (+ gright (/ gright #o10) (* gright #o10)))) ((= char ?o) (let ((oright (logand #o1007 from))) (+ oright (* oright #o10) (* oright #o100)))) - (t (error "%c: bad right character" char)))) + (t (error "%c: Bad right character" char)))) (defun file-modes-rights-to-number (rights who-mask &optional from) "Convert a symbolic mode string specification to an equivalent number. diff --git a/lisp/format.el b/lisp/format.el index 71cf885d417..6c0ba11641e 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -519,7 +519,7 @@ the value of `foo'." (cdr list) (let ((p list)) (while (not (eq (cdr p) cons)) - (if (null p) (error "format-delq-cons: not an element")) + (if (null p) (error "format-delq-cons: Not an element")) (setq p (cdr p))) ;; Now (cdr p) is the cons to delete (setcdr p (cdr cons)) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 115efa9805e..5f2fc463330 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -570,7 +570,7 @@ The following commands are available: (when (assoc to gnus-server-alist) (error "%s already exists" to)) (unless (gnus-server-to-method from) - (error "%s: no such server" from)) + (error "%s: No such server" from)) (let ((to-entry (cons from (copy-tree (gnus-server-to-method from))))) (setcar to-entry to) @@ -1128,7 +1128,7 @@ Requesting compaction of %s... (this may take a long time)" (customize-set-variable 'gnus-cloud-method server) ;; Note we can't use `Custom-save' here. (when (gnus-yes-or-no-p - (format "The new cloud host server is %S now. Save it? " server)) + (format "The new cloud host server is `%S' now. Save it?" server)) (customize-save-variable 'gnus-cloud-method server))) (when (gnus-yes-or-no-p (format "Upload Cloud data to %S now? " server)) (gnus-message 1 "Uploading all data to Emacs Cloud server %S" server) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index e32cfc0d61a..c7be958edd1 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2934,7 +2934,7 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (nreverse olist))) (defun gnus-gnus-to-newsrc-format (&optional foreign-ok) - (interactive (list (gnus-y-or-n-p "write foreign groups too? "))) + (interactive (list (gnus-y-or-n-p "Write foreign groups too?"))) ;; Generate and save the .newsrc file. (with-current-buffer (create-file-buffer gnus-current-startup-file) (let ((standard-output (current-buffer)) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index b49793509fc..f72d76ac02b 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -238,7 +238,7 @@ You can also customize or set `mml-signencrypt-style-alist' instead." (goto-char (match-end 0)) (apply #'mml-insert-tag 'part (cons (if sign 'sign 'encrypt) (cons method tags)))) - (t (error "The message is corrupted. No mail header separator")))))) + (t (error "The message is corrupted. No mail header separator")))))) (defvar mml-secure-method (if (equal mml-default-encrypt-method mml-default-sign-method) @@ -328,7 +328,7 @@ either an error is raised or not." (unless (yes-or-no-p "Message for encryption contains Bcc header.\ This may give away all Bcc'ed identities to all recipients.\ Are you sure that this is safe?\ - (Customize `mml-secure-safe-bcc-list' to avoid this warning.) ") + (Customize `mml-secure-safe-bcc-list' to avoid this warning.)") (error "Aborted")))))))) ;; defuns that add the proper <#secure ...> tag to the top of the message body @@ -352,7 +352,7 @@ either an error is raised or not." (apply #'mml-insert-tag 'secure 'method method 'mode mode tags))) (t (error - "The message is corrupted. No mail header separator")))) + "The message is corrupted. No mail header separator")))) (when (eql insert-loc (point)) (forward-line 1)))) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 97c9f18a602..0ac57e9e171 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -715,7 +715,7 @@ Read the file and attempt to subscribe to each Feed in the file." (when (and xmlurl (not (string-match "\\`[\t ]*\\'" xmlurl)) (prog1 - (y-or-n-p (format "Subscribe to %s " xmlurl)) + (y-or-n-p (format "Subscribe to %s?" xmlurl)) (message ""))) (condition-case err (progn diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 8919e982383..d9fab6b8753 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -444,7 +444,7 @@ This is the opposite of `hilit-chg-hide-changes'." ;; We set the change property so we can tell this is one ;; of our overlays (so we don't delete someone else's). (overlay-put ov 'hilit-chg t)) - (error "hilit-chg-make-ov: no face for prop: %s" prop)))) + (error "hilit-chg-make-ov: No face for prop: %s" prop)))) (defun hilit-chg-hide-changes (&optional beg end) "Remove face information for Highlight Changes mode. diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 7c95baf8cd9..5b69a878e21 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -1210,7 +1210,7 @@ Interactively, prompt for NAME, and use the current filters." (_ (let ((type (assq (car qualifier) ibuffer-filtering-alist))) (unless qualifier - (error "Ibuffer: bad qualifier %s" qualifier)) + (error "Ibuffer: Bad qualifier %s" qualifier)) (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier))))))) (defun ibuffer-list-buffer-modes (&optional include-parents) diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 9be4d1ee955..629cd4c2879 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -510,7 +510,7 @@ If READ-FLAG is non-nil, this statement has the form (arg (nth 2 condition))) (ccl-check-register rrr cmd) (or (integerp op) - (error "CCL: invalid operator: %s" (nth 1 condition))) + (error "CCL: Invalid operator: %s" (nth 1 condition))) (if (integerp arg) (progn (ccl-embed-code (if read-flag 'read-jump-cond-expr-const @@ -862,7 +862,7 @@ is a list of CCL-BLOCKs." rrr RRR 0) (ccl-embed-symbol Rrr 'translation-hash-table-id)) (t - (error "CCL: non-constant table: %s" cmd) + (error "CCL: Non-constant table: %s" cmd) ;; not implemented: (ccl-check-register Rrr cmd) (ccl-embed-extended-command 'lookup-int rrr RRR 0)))) @@ -882,7 +882,7 @@ is a list of CCL-BLOCKs." rrr RRR 0) (ccl-embed-symbol Rrr 'translation-hash-table-id)) (t - (error "CCL: non-constant table: %s" cmd) + (error "CCL: Non-constant table: %s" cmd) ;; not implemented: (ccl-check-register Rrr cmd) (ccl-embed-extended-command 'lookup-char rrr RRR 0)))) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 608062fba4e..fe686cb6f86 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -2020,7 +2020,7 @@ backup file names and the like)." ;; if can't find EOH, this is no message! (unless (feedmail-find-eoh t) (feedmail-say-chatter "Skipping %s; no mail-header-separator" maybe-file) - (error "FQM: you should never see this message")) + (error "FQM: You should never see this message")) (feedmail-say-debug "Prepping %s" maybe-file) ;; the catch is a way out for users to voluntarily skip sending a message (catch 'skip-me-q (funcall feedmail-queue-runner-message-sender arg)) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 56a1d76d71a..2585833e1d4 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4723,7 +4723,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") ;; by using the ftp chmod command. (defun ange-ftp-call-chmod (args) (if (< (length args) 2) - (error "ange-ftp-call-chmod: missing mode and/or filename: %s" args)) + (error "ange-ftp-call-chmod: Missing mode and/or filename: %s" args)) (let ((mode (car args)) (rest (cdr args))) (if (equal "--" (car rest)) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 6e10b5c4e30..b4aed279819 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -860,7 +860,7 @@ contains a reference, retrieve the type of the reference." (if complex-type (setq type (soap-xs-parse-complex-type (car complex-type))) ;; else - (error "Soap-xs-parse-element: missing type or ref")))))) + (error "soap-xs-parse-element: Missing type or ref")))))) (make-soap-xs-element :name name ;; Use the full namespace name for now, we will @@ -2874,7 +2874,7 @@ decode function to perform the actual decoding." (unless wtype ;; The node has type info encoded in it, but we don't know how to ;; decode it... - (error "Soap-decode-array: node has unknown type: %s" type))) + (error "soap-decode-array: Node has unknown type: %s" type))) (dolist (e contents) (when (consp e) (push (if wtype diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index 5207ca8ff19..eca338eb22d 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -220,7 +220,7 @@ to its sub elements. If ELEMENT is the WSDL document itself, the entire WSDL can be inspected." (let ((inspect (get (soap-type-of element) 'soap-inspect))) (unless inspect - (error "Soap-inspect: no inspector for element")) + (error "soap-inspect: No inspector for element")) (with-current-buffer (get-buffer-create "*soap-inspect*") (setq buffer-read-only t) diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el index 01fcd38199c..897b4015889 100644 --- a/lisp/obsolete/cust-print.el +++ b/lisp/obsolete/cust-print.el @@ -643,11 +643,11 @@ See `custom-format' for the details." (let ((print-circle t)) (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)") - (error "circular object with array printing"))) + (error "Circular object with array printing"))) (let ((print-circle t)) (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)") - (error "circular object with array printing"))) + (error "Circular object with array printing"))) (let* ((print-circle t) (x (list 'p 'q)) @@ -655,16 +655,16 @@ See `custom-format' for the details." (setcdr (cdr (cdr (cdr y))) (cdr y)) (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))" ) - (error "circular list example from CL manual"))) + (error "Circular list example from CL manual"))) (let ((print-circle nil)) ;; cl-packages.el is required to print uninterned symbols like #:FOO. ;; (require 'cl-packages) (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)") - (error "uninterned symbols in list"))) + (error "Uninterned symbols in list"))) (let ((print-circle t)) (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)") - (error "circular uninterned symbols in list"))) + (error "Circular uninterned symbols in list"))) (uninstall-custom-print) ) diff --git a/lisp/obsolete/landmark.el b/lisp/obsolete/landmark.el index 83e7649a69c..16c41c76ad2 100644 --- a/lisp/obsolete/landmark.el +++ b/lisp/obsolete/landmark.el @@ -757,9 +757,9 @@ If the game is finished, this command requests for another game." (let ((square (landmark-point-square)) score) (cond ((null square) - (error "Your point is not on a square. Retry!")) + (error "Your point is not on a square. Retry!")) ((not (zerop (aref landmark-board square))) - (error "Your point is not on a free square. Retry!")) + (error "Your point is not on a free square. Retry!")) (t (setq score (aref landmark-score-table square)) (landmark-play-move square 1) @@ -823,14 +823,14 @@ If the game is finished, this command requests for another game." (defun landmark-prompt-for-other-game () "Ask for another game, and start it." (if (y-or-n-p "Another game? ") - (if (y-or-n-p "Retain learned weights ") + (if (y-or-n-p "Retain learned weights?") (landmark 2) (landmark 1)) (message "Chicken!"))) (defun landmark-offer-a-draw () "Offer a draw and return t if Human accepted it." - (or (y-or-n-p "I offer you a draw. Do you accept it? ") + (or (y-or-n-p "I offer you a draw. Do you accept it?") (not (setq landmark-human-refused-draw t)))) @@ -1512,9 +1512,9 @@ If the game is finished, this command requests for another game." (t (let ((square (landmark-point-square))) (cond ((null square) - (error "Your point is not on a square. Retry!")) + (error "Your point is not on a square. Retry!")) ((not (zerop (aref landmark-board square))) - (error "Your point is not on a free square. Retry!")) + (error "Your point is not on a free square. Retry!")) (t (progn (landmark-plot-square square 1) diff --git a/lisp/obsolete/tls.el b/lisp/obsolete/tls.el index 5cba18d7897..ff01008613b 100644 --- a/lisp/obsolete/tls.el +++ b/lisp/obsolete/tls.el @@ -260,14 +260,14 @@ Fourth arg PORT is an integer specifying a port to connect to." NOT trusted." host)) (not (yes-or-no-p (format-message "\ -The certificate presented by `%s' is NOT trusted. Accept anyway? " host))))) +The certificate presented by `%s' is NOT trusted. Accept anyway?" host))))) (and tls-hostmismatch (save-excursion (goto-char (point-min)) (re-search-forward tls-hostmismatch nil t)) (not (yes-or-no-p (format "Host name in certificate doesn't \ -match `%s'. Connect anyway? " host)))))) +match `%s'. Connect anyway?" host)))))) (setq done nil) (delete-process process)) ;; Delete all the informational messages that could confuse diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el index 16906b68a67..2fa8c951531 100644 --- a/lisp/obsolete/vip.el +++ b/lisp/obsolete/vip.el @@ -615,11 +615,11 @@ obtained so far, and COM is the command part obtained so far." (cond ((null arg) nil) ((consp arg) (car arg)) ((numberp arg) arg) - (t (error "strange arg"))) + (t (error "Strange arg"))) (cond ((null arg) nil) ((consp arg) (cdr arg)) ((numberp arg) nil) - (t (error "strange arg")))) + (t (error "Strange arg")))) (quit (setq vip-use-register nil) (signal 'quit nil)))) @@ -2248,7 +2248,7 @@ a token has type \(command, address, end-mark) and value." (setq ex-token-type "end-mark") (setq ex-token "goto")) (t - (error "invalid token"))))) + (error "Invalid token"))))) (defun vip-ex (&optional string) "ex commands within VIP." @@ -2333,7 +2333,7 @@ a token has type \(command, address, end-mark) and value." (cond ((looking-at "[a-z]") (vip-get-ex-com-subr) (if (string= ex-token-type "non-command") - (error "%s: not an editor command" ex-token))) + (error "%s: Not an editor command" ex-token))) ((looking-at "[!=><&~]") (setq ex-token (char-to-string (following-char))) (forward-char 1)) @@ -2378,7 +2378,7 @@ a token has type \(command, address, end-mark) and value." (progn (setq ex-flag t) (setq cont nil)) - (error "address expected"))) + (error "Address expected"))) ((string= ex-token-type "end-mark") (setq cont nil)) ((string= ex-token-type "whole") @@ -2568,7 +2568,7 @@ a token has type \(command, address, end-mark) and value." (string= ex-token "insert") (string= ex-token "open") ) - (error "%s: no such command from VIP" ex-token)) + (error "%s: No such command from VIP" ex-token)) ((or (string= ex-token "abbreviate") (string= ex-token "list") (string= ex-token "next") @@ -2581,7 +2581,7 @@ a token has type \(command, address, end-mark) and value." (string= ex-token "xit") (string= ex-token "z") ) - (error "%s: not implemented in VIP" ex-token)) + (error "%s: Not implemented in VIP" ex-token)) (t (error "%s: Not an editor command" ex-token)))) (defun ex-goto () diff --git a/lisp/printing.el b/lisp/printing.el index fb718f9aa62..dfa5a6ef761 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -5133,7 +5133,7 @@ If menu binding was not done, calls `pr-menu-bind'." (and (eq (symbol-value infile-sym) t) (set infile-sym (pr-ps-infile-preprint prompt))) (or (symbol-value infile-sym) - (error "%s: input PostScript file name is missing" prompt)) + (error "%s: Input PostScript file name is missing" prompt)) ;; output file (and (eq (symbol-value outfile-sym) t) (set outfile-sym (and current-prefix-arg diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index d40433a9b0d..a9a52636b78 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -64,7 +64,6 @@ point is used to decide where the old indentation is on a lines that is otherwise empty (ignoring any line continuation backslash), but that's not done if IGNORE-POINT-POS is non-nil. Returns the amount of indentation change \(in columns)." - (let ((line-cont-backslash (save-excursion (end-of-line) (eq (char-before) ?\\))) @@ -2058,9 +2057,9 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." (= arg 0)))) (defun c-defun-name-1 () - "Return the name of the current defun, at the current narrowing, -or nil if there isn't one. \"Defun\" here means a function, or -other top level construct with a brace block." + "Return name of current defun, at current narrowing, or nil if there isn't one. +\"Defun\" here means a function, or other top level construct +with a brace block." (c-save-buffer-state (beginning-of-defun-function end-of-defun-function where pos decl0 decl type-pos tag-pos case-fold-search) @@ -3655,9 +3654,9 @@ continuation backslashes, unless `c-auto-align-backslashes' is nil." (set-marker here nil)))) (defun c-indent-region (start end &optional quiet) - "Indent syntactically every line whose first char is between START -and END inclusive. If the optional argument QUIET is non-nil then no -syntactic errors are reported, even if `c-report-syntactic-errors' is + "Indent syntactically lines whose first char is between START and END inclusive. +If the optional argument QUIET is non-nil then no syntactic +errors are reported, even if `c-report-syntactic-errors' is non-nil." (save-excursion (goto-char end) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 8b302414496..c9b7a95df60 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1402,7 +1402,7 @@ Note that the style variables are always made local to the buffer." (memq (char-after) c-string-delims)) (c-clear-syn-tab (point))))) (c-clear-syn-tab (point))) - (t (c-benign-error "c-remove-string-fences: wrong position"))))) + (t (c-benign-error "c-remove-string-fences: Wrong position"))))) (defun c-before-change-check-unbalanced-strings (beg end) ;; If BEG or END is inside an unbalanced string, remove the syntax-table diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 8869c565737..d843c783ed0 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1770,7 +1770,7 @@ variables.") ; all XEmacsen. ((null c-macro-names-with-semicolon) nil) - (t (error "c-make-macro-with-semi-re: invalid \ + (t (error "c-make-macro-with-semi-re: Invalid \ c-macro-names-with-semicolon: %s" c-macro-names-with-semicolon)))))) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c371a84b9d2..1afeb60ac5f 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -507,9 +507,9 @@ Currently used with `cperl-check-syntax' only." :group 'cperl-help-system) (defcustom cperl-indent-region-fix-constructs 1 - "Amount of space to insert between `}' and `else' or `elsif' -in `cperl-indent-region'. Set to nil to leave as is. Values other -than 1 and nil will probably not work." + "Amount of space to insert between `}' and `else' or `elsif'. +Used by `cperl-indent-region'. Set to nil to leave as is. +Values other than 1 and nil will probably not work." :type '(choice (const nil) (const 1)) :group 'cperl-indentation-details) diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index 9185711848c..d4bfdaa9957 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -62,7 +62,7 @@ ;; ;; Document authors are encouraged to avoid "compatibility characters", as ;; defined in section 6.8 of [Unicode] (see also D21 in section 3.6 of -;; [Unicode3]). The characters defined in the following ranges are also +;; [Unicode3]). The characters defined in the following ranges are also ;; discouraged. They are either control characters or permanently undefined ;; Unicode characters: ;; diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index fc3d603f066..5a31ad35087 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -105,8 +105,9 @@ process buffer." :type 'regexp) (defcustom idlwave-shell-process-name "idl" - "Name to be associated with the IDL process. The buffer for the -process output is made by surrounding this name with `*'s." + "Name to be associated with the IDL process. +The buffer for the process output is made by surrounding this +name with `*'s." :group 'idlwave-shell-general-setup :type 'string) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 4224e47d16d..9aaabd8a0e1 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -245,7 +245,7 @@ would yield: :type 'boolean) (defcustom idlwave-indent-parens-nested nil - "Non-nil means, indent continuation lines with parens by nesting + "Non-nil means indent continuation lines with parens by nesting lines at consecutively deeper levels." :group 'idlwave-code-formatting :type 'boolean) @@ -7286,8 +7286,7 @@ The list is cached in `idlwave-class-info' for faster access." inherits)) (if (> (cdr cl) 999) (error - "Class scan: inheritance depth exceeded. Circular inheritance?") - )) + "Class scan: inheritance depth exceeded. Circular inheritance?"))) (setq all-inherits (nreverse rtn)) (nconc info (list (cons 'all-inherits all-inherits))) all-inherits)))))) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index e55b09d8fcf..495c77bbd90 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -1540,7 +1540,7 @@ If no extension is specified, .pas is assumed. Creates a buffer for the unit." (defun opascal-find-current-def () "Find the definition of the identifier under the current point." (interactive) - (error "opascal-find-current-def: not implemented yet")) + (error "opascal-find-current-def: Not implemented yet")) (defun opascal-find-current-xdef () "Find the definition of the identifier under the current point, searching @@ -1548,13 +1548,13 @@ in external units if necessary (as listed in the current unit's use clause). The set of directories to search for a unit is specified by the global variable `opascal-search-path'." (interactive) - (error "opascal-find-current-xdef: not implemented yet")) + (error "opascal-find-current-xdef: Not implemented yet")) (defun opascal-find-current-body () "Find the body of the identifier under the current point, assuming it is a routine." (interactive) - (error "opascal-find-current-body: not implemented yet")) + (error "opascal-find-current-body: Not implemented yet")) (defun opascal-fill-comment () "Fill the text of the current comment, according to `fill-column'. diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 74a023775f8..59004e413eb 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -512,7 +512,7 @@ to automatically indent if-then-else constructs." :type 'boolean) (defcustom prolog-electric-colon-flag nil - "Makes `:' electric (inserts `:-' on a new line). + "Non-nil means make `:' electric (inserts `:-' on a new line). If non-nil, pressing `:' at the end of a line that starts in the first column (i.e., clause heads) inserts ` :-' and newline." :version "24.1" @@ -520,7 +520,7 @@ the first column (i.e., clause heads) inserts ` :-' and newline." :type 'boolean) (defcustom prolog-electric-dash-flag nil - "Makes `-' electric (inserts a `-->' on a new line). + "Non-nil means make `-' electric (inserts a `-->' on a new line). If non-nil, pressing `-' at the end of a line that starts in the first column (i.e., DCG heads) inserts ` -->' and newline." :version "24.1" diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 3b6774aa14c..0dd9f2b4fa2 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2522,7 +2522,7 @@ overwritten if sh-styles-alist nil t))) (let ((sl (assoc name sh-styles-alist))) (if (null sl) - (error "sh-load-style - style %s not known" name) + (error "sh-load-style: Style %s not known" name) (dolist (var (cdr sl)) (set (car var) (cdr var)))))) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 02eccb33012..5dfbf87e452 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3976,13 +3976,13 @@ for each match." (cond ((numberp c) (match-string c)) ((stringp c) (match-substitute-replacement c)) - (t (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" c)))) + (t (error "sql-redirect-value: Unknown REGEXP-GROUPS value - %s" c)))) regexp-groups)) ;; String is specified; return replacement string ((stringp regexp-groups) (match-substitute-replacement regexp-groups)) (t - (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" + (error "sql-redirect-value: Unknown REGEXP-GROUPS value - %s" regexp-groups))) results))) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index d98230d9a0e..52c34d9fbc6 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -87,7 +87,7 @@ ;; ;; If you want to customize Verilog mode to fit your needs better, ;; you may add the below lines (the values of the variables presented -;; here are the defaults). Note also that if you use an Emacs that +;; here are the defaults). Note also that if you use an Emacs that ;; supports custom, it's probably better to use the custom menu to ;; edit these. If working as a member of a large team these settings ;; should be common across all users (in a site-start file), or set @@ -4827,7 +4827,7 @@ Limit search to point LIM." ((match-end 1) ; [ (setq colon (1+ colon)) (if (>= colon 0) - (error "%s: unbalanced [" (verilog-point-text)))) + (error "%s: Unbalanced [" (verilog-point-text)))) ((match-end 2) ; ] (setq colon (1- colon))) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index fc0d406f73c..3a9185b334f 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -5917,16 +5917,16 @@ Skip backwards if DIRECTION is negative, skip forward otherwise." ;; Functions to help finding the correct indentation column: (defun vhdl-first-word (point) - "If the keyword at POINT is at boi, then return (current-column) at -that point, else nil." + "If the keyword at POINT is at boi, return (current-column) at that point. +Otherwise return nil." (save-excursion (and (goto-char point) (eq (point) (vhdl-point 'boi)) (current-column)))) (defun vhdl-last-word (point) - "If the keyword at POINT is at eoi, then return (current-column) at -that point, else nil." + "If keyword at POINT is at eoi, then return (current-column) at that point. +Otherwise, return nil." (save-excursion (and (goto-char point) (save-excursion (or (eq (progn (forward-sexp) (point)) @@ -6266,13 +6266,11 @@ of an identifier that just happens to contain an \"end\" keyword." (defconst vhdl-statement-fwd-re "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)" - "A regular expression for searching forward that matches all known -\"statement\" keywords.") + "Regexp for searching forward that matches all known \"statement\" keywords.") (defconst vhdl-statement-bwd-re "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]" - "A regular expression for searching backward that matches all known -\"statement\" keywords.") + "Regexp for searching backward that matches all known \"statement\" keywords.") (defun vhdl-statement-p (&optional _lim) "Return t if we are looking at a real \"statement\" keyword. @@ -6723,8 +6721,9 @@ search, and an argument indicating an interactive call." vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re)) (defun vhdl-beginning-of-statement-1 (&optional lim) - "Move to the start of the current statement, or the previous -statement if already at the beginning of one." + "Move to the start of the current statement. +If already at the beginning of a statement, move to the start of +the previous statement instead." (let ((lim (or lim (point-min))) (here (point)) (pos (point)) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index 1874f2698ae..26ffe33b83e 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -562,7 +562,7 @@ The strings are concatenated and terminated by a newline." (defun xscheme-yank (&optional arg) "Insert the most recent expression at point. -With just C-U as argument, same but put point in front (and mark at end). +With just \\[universal-argument] as argument, same but put point in front (and mark at end). With argument n, reinsert the nth most recently sent expression. See also the commands \\[xscheme-yank-pop] and \\[xscheme-yank-push]." (interactive "*P") diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 1f4ed4e44d7..b1d03fda1d4 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -3878,7 +3878,7 @@ Note: No major/minor-mode is activated and no local variables are evaluated for (with-temp-buffer (insert-file-contents filename) (buffer-string)) - (error "ps-print PostScript prologue `%s' file was not found" + (error "ps-print: PostScript prologue `%s' file was not found" filename)))) diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index cc8b3244b99..b90c21339cc 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -348,7 +348,7 @@ Also checks if buffers visiting the files are in read-only mode." (with-current-buffer buf buffer-read-only)) (ding) - (or (y-or-n-p (format "Buffer %s is read-only. Continue?" + (or (y-or-n-p (format "Buffer %s is read-only. Continue?" (buffer-name buf))) (error "Abort")))))) diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index a5d83c34d67..15d86b359cc 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -230,7 +230,7 @@ This function is controlled by the settings of reftex-insert-label-flags." (symbol-value reftex-docstruct-symbol))) (ding) (if (y-or-n-p - (format-message "Label `%s' exists. Use anyway? " label)) + (format-message "Label `%s' exists. Use anyway?" label)) (setq valid t))) ;; Label is ok diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index 843bbb2bca7..6862da60464 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -1508,7 +1508,7 @@ will be at some level higher in the Texinfo file. The fourth argument 'normal 'no-pointer)) (t - (error "texinfo-find-pointer: lack proper arguments"))))) + (error "texinfo-find-pointer: Lack proper arguments"))))) (defun texinfo-pointer-name (kind) "Return the node name preceding the section command. @@ -1676,7 +1676,7 @@ or `Up' pointer." 'normal 'no-pointer)) (t - (error "texinfo-sequential-find-pointer: lack proper arguments"))))) + (error "texinfo-sequential-find-pointer: Lack proper arguments"))))) ;;; Inserting `@node' lines diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index fa26b0b32f9..bec0ec01208 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -1677,7 +1677,7 @@ With prefix arg UNHIDE, unhide instead." (setq custom-diff-buf ediff-custom-diff-buffer))))) (or (ediff-buffer-live-p meta-diff-buff) - (user-error "Ediff: something wrong--killed multiple diff's buffer")) + (user-error "Ediff: Something wrong--killed multiple diff's buffer")) (cond ((ediff-buffer-live-p custom-diff-buf) ;; for live session buffers we do them first because the user may diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 9016d1df5c4..7c36291eea1 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3220,7 +3220,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." (if (buffer-modified-p) ;; If buffer is not obsolete and is modified, offer to save (if (yes-or-no-p - (format "Buffer %s has been modified. Save it in file %s? " + (format "Buffer %s has been modified. Save it in file %s?" (buffer-name) buffer-file-name)) (condition-case nil diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index e0a87ba941c..4d151d555cc 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -891,7 +891,7 @@ name or time." Actually, the narrowed region doesn't include the date line. A \"page\" in a ChangeLog file is the area between two dates." (or (eq major-mode 'change-log-mode) - (error "log-edit-narrow-changelog: current buffer isn't a ChangeLog")) + (error "log-edit-narrow-changelog: Current buffer isn't a ChangeLog")) (goto-char (point-min)) -- cgit v1.2.3 From 07edc28bdbfeeaeb1008b4fe21bfda586feae562 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 11 Oct 2021 11:14:26 +0200 Subject: Fix ert errors when there's a test that binds `debug-on-error' * lisp/emacs-lisp/ert.el (ert--run-test-internal): Don't infloop on errors when signalling errors (bug#51131). --- lisp/emacs-lisp/ert.el | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 98cb1fd1cf6..b7d984374cb 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -783,6 +783,10 @@ This mainly sets up debugger-related bindings." (ert--run-test-debugger test-execution-info args))) (debug-on-error t) + ;; Don't infloop if the error being called is erroring + ;; out, and we have `debug-on-error' bound to nil inside + ;; the test. + (backtrace-on-error-noninteractive nil) (debug-on-quit t) ;; FIXME: Do we need to store the old binding of this ;; and consider it in `ert--run-test-debugger'? -- cgit v1.2.3 From 713e19a60adde301e5d7edc79f92bbb1b25b71a8 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 27 Oct 2021 16:13:30 +0200 Subject: Fix parsing of erts files * lisp/emacs-lisp/ert.el (ert-test-erts-file): Fix progress through a test file (bug#51409). --- lisp/emacs-lisp/ert.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 57655403c20..efc1825017b 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2670,10 +2670,11 @@ TRANSFORM will be called to get from before to after." (insert-file-contents file) (let ((gen-specs (list (cons 'dummy t) (cons 'code transform)))) - ;; The start of the "before" part starts with a form feed and then - ;; the name of the test. + ;; Find the start of a test. (while (re-search-forward "^=-=\n" nil t) - (setq gen-specs (ert-test--erts-test gen-specs file)))))) + (setq gen-specs (ert-test--erts-test gen-specs file)) + ;; Search to the end of the test. + (re-search-forward "^=-=-=\n"))))) (defun ert-test--erts-test (gen-specs file) (let* ((file-buffer (current-buffer)) -- cgit v1.2.3 From 8227d1273e2b82dbed14c0cba06959083d377745 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 20 Oct 2021 14:16:07 +0200 Subject: Fix bug with string values in equal-including-properties * src/intervals.c (intervals_equal_1): Factor out from intervals_equal. Optionally use Fequal for comparison of string values in property lists. (intervals_equal): Update for the above. (compare_string_intervals): Use the above optional Fequal comparison to fix a bug where 'equal-including-properties' compared strings with eq, instead of equal. (Bug#6581) * test/src/fns-tests.el (fns-tests-equal-including-properties) (fns-tests-equal-including-properties/string-prop-vals): New tests. * test/lisp/emacs-lisp/ert-tests.el (ert-test-equal-including-properties): Remove parts testing 'equal-including-properties'. * lisp/emacs-lisp/ert.el (ert-equal-including-properties): Add FIXME that this should be removed. --- lisp/emacs-lisp/ert.el | 1 + src/intervals.c | 20 +++++++++++++++----- test/lisp/emacs-lisp/ert-tests.el | 14 -------------- test/src/fns-tests.el | 27 +++++++++++++++++++++++++++ 4 files changed, 43 insertions(+), 19 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index efc1825017b..f7cf1e4289a 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -92,6 +92,7 @@ Use nil for no limit (caution: backtrace lines can be very long)." ;;; Copies/reimplementations of cl functions. +;; FIXME: Bug#6581 is fixed, so this should be deleted. (defun ert-equal-including-properties (a b) "Return t if A and B have similar structure and contents. diff --git a/src/intervals.c b/src/intervals.c index f88a41f2549..11d5b6bbb6f 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -166,10 +166,11 @@ merge_properties (register INTERVAL source, register INTERVAL target) } } -/* Return true if the two intervals have the same properties. */ +/* Return true if the two intervals have the same properties. + If use_equal is true, use Fequal for comparisons instead of EQ. */ -bool -intervals_equal (INTERVAL i0, INTERVAL i1) +static bool +intervals_equal_1 (INTERVAL i0, INTERVAL i1, bool use_equal) { Lisp_Object i0_cdr, i0_sym; Lisp_Object i1_cdr, i1_val; @@ -204,7 +205,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1) /* i0 and i1 both have sym, but it has different values in each. */ if (!CONSP (i1_val) || (i1_val = XCDR (i1_val), !CONSP (i1_val)) - || !EQ (XCAR (i1_val), XCAR (i0_cdr))) + || use_equal ? NILP (Fequal (XCAR (i1_val), XCAR (i0_cdr))) + : !EQ (XCAR (i1_val), XCAR (i0_cdr))) return false; i0_cdr = XCDR (i0_cdr); @@ -218,6 +220,14 @@ intervals_equal (INTERVAL i0, INTERVAL i1) /* Lengths of the two plists were equal. */ return (NILP (i0_cdr) && NILP (i1_cdr)); } + +/* Return true if the two intervals have the same properties. */ + +bool +intervals_equal (INTERVAL i0, INTERVAL i1) +{ + return intervals_equal_1 (i0, i1, false); +} /* Traverse an interval tree TREE, performing FUNCTION on each node. @@ -2291,7 +2301,7 @@ compare_string_intervals (Lisp_Object s1, Lisp_Object s2) /* If we ever find a mismatch between the strings, they differ. */ - if (! intervals_equal (i1, i2)) + if (! intervals_equal_1 (i1, i2, true)) return 0; /* Advance POS till the end of the shorter interval, diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index a18664bba3b..39b7b475555 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -715,27 +715,13 @@ This macro is used to test if macroexpansion in `should' works." context-before "f" context-after "o")))) (ert-deftest ert-test-equal-including-properties () - (should (equal-including-properties "foo" "foo")) (should (ert-equal-including-properties "foo" "foo")) - - (should (equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) (should (ert-equal-including-properties #("foo" 0 3 (a b)) (propertize "foo" 'a 'b))) - - (should (equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) (should (ert-equal-including-properties #("foo" 0 3 (a b c d)) (propertize "foo" 'a 'b 'c 'd))) - - (should-not (equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e)) (propertize "foo" 'a 'b 'c 'd))) - - ;; This is bug 6581. - (should-not (equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t)))) (should (ert-equal-including-properties #("foo" 0 3 (a (t))) (propertize "foo" 'a (list t))))) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 3dc2e7b3ec8..bec5c03f9e7 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -57,6 +57,33 @@ (puthash nan t h) (should (eq (funcall test nan -nan) (gethash -nan h)))))) +(ert-deftest fns-tests-equal-including-properties () + (should (equal-including-properties "" "")) + (should (equal-including-properties "foo" "foo")) + (should (equal-including-properties #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + (should (equal-including-properties #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + (should (equal-including-properties #("a" 0 1 (k v)) + #("a" 0 1 (k v)))) + (should-not (equal-including-properties #("a" 0 1 (k v)) + #("a" 0 1 (k x)))) + (should-not (equal-including-properties #("a" 0 1 (k v)) + #("b" 0 1 (k v)))) + (should-not (equal-including-properties #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd)))) + +(ert-deftest fns-tests-equal-including-properties/string-prop-vals () + "Handle string property values. (Bug#6581)" + (should (equal-including-properties #("a" 0 1 (k "v")) + #("a" 0 1 (k "v")))) + (should (equal-including-properties #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t)))) + (should-not (equal-including-properties #("a" 0 1 (k "v")) + #("a" 0 1 (k "x")))) + (should-not (equal-including-properties #("a" 0 1 (k "v")) + #("b" 0 1 (k "v"))))) + (ert-deftest fns-tests-reverse () (should-error (reverse)) (should-error (reverse 1)) -- cgit v1.2.3 From 54b8ec4e6fb1eeac049e7bd68372e78c180fe8e4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 21 Oct 2021 19:53:00 +0200 Subject: Remove workaround for fixed Bug#6581 from ert * lisp/emacs-lisp/ert.el (ert-equal-including-properties): Make into obsolete function alias for 'equal-including-properties'. * test/src/editfns-tests.el (format-properties): * test/lisp/emacs-lisp/ert-x-tests.el (ert-propertized-string) (ert-test-run-tests-interactively-2): Don't use above obsolete name. (ert--explain-equal-including-properties-rec): New function. (ert--explain-equal-including-properties): Use as an explainer for 'equal-including-properties' now that Bug#6581 is fixed. * test/lisp/emacs-lisp/ert-tests.el (ert-test-explain-equal-string-properties): Expand test. (ert-test-equal-including-properties): Merge test into above expanded test. --- lisp/emacs-lisp/ert.el | 55 ++++++++++++++----------------------- test/lisp/emacs-lisp/ert-tests.el | 55 ++++++++++++++++++++----------------- test/lisp/emacs-lisp/ert-x-tests.el | 8 +++--- test/src/editfns-tests.el | 48 ++++++++++++++++---------------- 4 files changed, 78 insertions(+), 88 deletions(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index f7cf1e4289a..aff38040271 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -89,24 +89,6 @@ Use nil for no limit (caution: backtrace lines can be very long)." :background "red3")) "Face used for unexpected results in the ERT results buffer.") - -;;; Copies/reimplementations of cl functions. - -;; FIXME: Bug#6581 is fixed, so this should be deleted. -(defun ert-equal-including-properties (a b) - "Return t if A and B have similar structure and contents. - -This is like `equal-including-properties' except that it compares -the property values of text properties structurally (by -recursing) rather than with `eq'. Perhaps this is what -`equal-including-properties' should do in the first place; see -Emacs bug 6581 at URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." - ;; This implementation is inefficient. Rather than making it - ;; efficient, let's hope bug 6581 gets fixed so that we can delete - ;; it altogether. - (not (ert--explain-equal-including-properties a b))) - - ;;; Defining and locating tests. ;; The data structure that represents a test case. @@ -467,7 +449,7 @@ Errors during evaluation are caught and handled like nil." (defun ert--explain-equal-rec (a b) "Return a programmer-readable explanation of why A and B are not `equal'. -Returns nil if they are." +Return nil if they are." (if (not (eq (type-of a) (type-of b))) `(different-types ,a ,b) (pcase a @@ -600,14 +582,9 @@ If SUFFIXP is non-nil, returns a suffix of S, otherwise a prefix." (t (substring s 0 len))))) -;; TODO(ohler): Once bug 6581 is fixed, rename this to -;; `ert--explain-equal-including-properties-rec' and add a fast-path -;; wrapper like `ert--explain-equal'. -(defun ert--explain-equal-including-properties (a b) - "Explainer function for `ert-equal-including-properties'. - -Returns a programmer-readable explanation of why A and B are not -`ert-equal-including-properties', or nil if they are." +(defun ert--explain-equal-including-properties-rec (a b) + "Return explanation of why A and B are not `equal-including-properties'. +Return nil if they are." (if (not (equal a b)) (ert--explain-equal a b) (cl-assert (stringp a) t) @@ -629,15 +606,17 @@ Returns a programmer-readable explanation of why A and B are not ,(ert--abbreviate-string (substring-no-properties a (1+ i)) 10 nil)))) - ;; TODO(ohler): Get `equal-including-properties' fixed in - ;; Emacs, delete `ert-equal-including-properties', and - ;; re-enable this assertion. - ;;finally (cl-assert (equal-including-properties a b) t) - ))) -(put 'ert-equal-including-properties - 'ert-explainer - 'ert--explain-equal-including-properties) + finally (cl-assert (equal-including-properties a b) t)))) +(defun ert--explain-equal-including-properties (a b) + "Explainer function for `equal-including-properties'." + ;; Do a quick comparison in C to avoid running our expensive + ;; comparison when possible. + (if (equal-including-properties a b) + nil + (ert--explain-equal-including-properties-rec a b))) +(put 'equal-including-properties 'ert-explainer + 'ert--explain-equal-including-properties) ;;; Implementation of `ert-info'. @@ -2787,6 +2766,12 @@ TRANSFORM will be called to get from before to after." (defvar ert-unload-hook ()) (add-hook 'ert-unload-hook #'ert--unload-function) +;;; Obsolete + +(define-obsolete-function-alias 'ert-equal-including-properties + #'equal-including-properties "29.1") +(put 'ert-equal-including-properties 'ert-explainer + 'ert--explain-equal-including-properties) (provide 'ert) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 39b7b475555..79576d24032 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -695,35 +695,40 @@ This macro is used to test if macroexpansion in `should' works." (should (equal (ert--abbreviate-string "bar" 0 t) ""))) (ert-deftest ert-test-explain-equal-string-properties () - (should - (equal (ert--explain-equal-including-properties #("foo" 0 1 (a b)) - "foo") - '(char 0 "f" - (different-properties-for-key a (different-atoms b nil)) - context-before "" - context-after "oo"))) - (should (equal (ert--explain-equal-including-properties + (should-not (ert--explain-equal-including-properties-rec "foo" "foo")) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b)) + (propertize "foo" 'a 'b))) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b c d)) + (propertize "foo" 'a 'b 'c 'd))) + (should-not (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a (t))) + (propertize "foo" 'a (list t)))) + + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 3 (a b c e)) + (propertize "foo" 'a 'b 'c 'd)) + '(char 0 "f" (different-properties-for-key c (different-atoms e d)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 1 (a b)) + "foo") + '(char 0 "f" + (different-properties-for-key a (different-atoms b nil)) + context-before "" + context-after "oo"))) + (should (equal (ert--explain-equal-including-properties-rec #("foo" 1 3 (a b)) #("goo" 0 1 (c d))) '(array-elt 0 (different-atoms (?f "#x66" "?f") (?g "#x67" "?g"))))) - (should - (equal (ert--explain-equal-including-properties - #("foo" 0 1 (a b c d) 1 3 (a b)) - #("foo" 0 1 (c d a b) 1 2 (a foo))) - '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) - context-before "f" context-after "o")))) - -(ert-deftest ert-test-equal-including-properties () - (should (ert-equal-including-properties "foo" "foo")) - (should (ert-equal-including-properties #("foo" 0 3 (a b)) - (propertize "foo" 'a 'b))) - (should (ert-equal-including-properties #("foo" 0 3 (a b c d)) - (propertize "foo" 'a 'b 'c 'd))) - (should-not (ert-equal-including-properties #("foo" 0 3 (a b c e)) - (propertize "foo" 'a 'b 'c 'd))) - (should (ert-equal-including-properties #("foo" 0 3 (a (t))) - (propertize "foo" 'a (list t))))) + (should (equal (ert--explain-equal-including-properties-rec + #("foo" 0 1 (a b c d) 1 3 (a b)) + #("foo" 0 1 (c d a b) 1 2 (a foo))) + '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) + context-before "f" context-after "o")))) (ert-deftest ert-test-stats-set-test-and-result () (let* ((test-1 (make-ert-test :name 'test-1 diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 9f40a18d343..1784934acb3 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -90,10 +90,10 @@ "foo baz"))) (ert-deftest ert-propertized-string () - (should (ert-equal-including-properties + (should (equal-including-properties (ert-propertized-string "a" '(a b) "b" '(c t) "cd") #("abcd" 1 2 (a b) 2 4 (c t)))) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-propertized-string "foo " '(face italic) "bar" " baz" nil " quux") #("foo bar baz quux" 4 11 (face italic))))) @@ -166,7 +166,7 @@ "1 skipped")))) (with-current-buffer buffer-name (font-lock-mode 0) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-filter-string (buffer-string) '("Started at:\\(.*\\)$" 1) '("Finished at:\\(.*\\)$" 1)) @@ -175,7 +175,7 @@ ;; pretend we are. (let ((noninteractive nil)) (font-lock-mode 1)) - (should (ert-equal-including-properties + (should (equal-including-properties (ert-filter-string (buffer-string) '("Started at:\\(.*\\)$" 1) '("Finished at:\\(.*\\)$" 1)) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index a731a95ccf0..e83dd7c857b 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -23,16 +23,16 @@ (ert-deftest format-properties () ;; Bug #23730 - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%d" 'face '(:background "red")) 1) #("1" 0 1 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%2d" 'face '(:background "red")) 1) #(" 1" 0 2 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "%02d" 'face '(:background "red")) 1) #("01" 0 2 (face (:background "red"))))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat (propertize "%2d" 'x 'X) (propertize "a" 'a 'A) (propertize "b" 'b 'B)) @@ -40,27 +40,27 @@ #(" 1ab" 0 2 (x X) 2 3 (a A) 3 4 (b B)))) ;; Bug #5306 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%.10s" (concat "1234567890aaaa" (propertize "12345678901234567890" 'xxx 25))) "1234567890")) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%.10s" (concat "123456789" (propertize "12345678901234567890" 'xxx 25))) #("1234567891" 9 10 (xxx 25)))) ;; Bug #23859 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%4s" (propertize "hi" 'face 'bold)) #(" hi" 2 4 (face bold)))) ;; Bug #23897 - (should (ert-equal-including-properties + (should (equal-including-properties (format "%s" (concat (propertize "01234" 'face 'bold) "56789")) #("0123456789" 0 5 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) @@ -68,63 +68,63 @@ ;; The last property range is extended to include padding on the ;; right, but the first range is not extended to the left to include ;; padding on the left! - (should (ert-equal-including-properties + (should (equal-including-properties (format "%12s" (concat (propertize "01234" 'face 'bold) "56789")) #(" 0123456789" 2 7 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-12s" (concat (propertize "01234" 'face 'bold) "56789")) #("0123456789 " 0 5 (face bold)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) #(" 012345" 4 6 (face bold) 6 8 (face underline)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) "45")) #("012345 " 0 2 (face bold) 2 4 (face underline)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format "%-10s" (concat (propertize "01" 'face 'bold) (propertize "23" 'face 'underline) (propertize "45" 'face 'italic))) #("012345 " 0 2 (face bold) 2 4 (face underline) 4 10 (face italic)))) ;; Bug #38191 - (should (ert-equal-including-properties + (should (equal-including-properties (format (propertize "‘foo’ %s bar" 'face 'bold) "xxx") #("‘foo’ xxx bar" 0 13 (face bold)))) ;; Bug #32404 - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat (propertize "%s" 'face 'bold) "" (propertize "%s" 'face 'error)) "foo" "bar") #("foobar" 0 3 (face bold) 3 6 (face error)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%s" (propertize "%s" 'face 'error)) "foo" "bar") #("foobar" 3 6 (face error)))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar") #("foo bar" 4 7 (face error)))) ;; Bug #46317 (let ((s (propertize "X" 'prop "val"))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3s/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3S/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%3d/" s) 12) #(" 12/X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3s/" s) 12) #("12 /X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3S/" s) 12) #("12 /X" 4 5 (prop "val")))) - (should (ert-equal-including-properties + (should (equal-including-properties (format (concat "%-3d/" s) 12) #("12 /X" 4 5 (prop "val")))))) -- cgit v1.2.3 From 67276f3403588718a11441ef5a43989b3f3d1cb7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Nov 2021 23:45:14 +0100 Subject: Make debugging ert--erts-specifications easier * lisp/emacs-lisp/ert.el (ert--erts-specifications): Strip text properties from specs to make debugging easier. --- lisp/emacs-lisp/ert.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/ert.el') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index aff38040271..8ebc81fd418 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2759,7 +2759,7 @@ TRANSFORM will be called to get from before to after." (while (looking-at "[ \t]+\\(.*\\)") (setq value (concat value (match-string 1))) (forward-line 1)) - (push (cons name value) specs)) + (push (cons name (substring-no-properties value)) specs)) (forward-line 1))) (nreverse specs)))) -- cgit v1.2.3