diff options
Diffstat (limited to 'test/lisp')
25 files changed, 803 insertions, 119 deletions
diff --git a/test/lisp/cus-edit-tests.el b/test/lisp/cus-edit-tests.el index 0ef5168109b..31ba68b4107 100644 --- a/test/lisp/cus-edit-tests.el +++ b/test/lisp/cus-edit-tests.el @@ -83,7 +83,14 @@ (ert-deftest test-setopt () (should (= (setopt cus-edit-test-foo1 1) 1)) (should (= cus-edit-test-foo1 1)) - (should-error (setopt cus-edit-test-foo1 :foo))) - + (let* ((text-quoting-style 'grave) + (warn-txt + (with-current-buffer (get-buffer-create "*Warnings*") + (let ((inhibit-read-only t)) + (erase-buffer)) + (setopt cus-edit-test-foo1 :foo) + (buffer-substring-no-properties (point-min) (point-max))))) + (should (string-search "Value `:foo' does not match type number" + warn-txt)))) (provide 'cus-edit-tests) ;;; cus-edit-tests.el ends here diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el index 429ef266572..3d6e7686935 100644 --- a/test/lisp/elide-head-tests.el +++ b/test/lisp/elide-head-tests.el @@ -180,6 +180,90 @@ ;; along with Mentor. If not, see <https://www.gnu.org/licenses>. " "Mentor is distributed in the hope that") +;; from GnuTLS [has a line break in snail mail address] +(elide-head--add-test gpl3-6 "\ +# This file is part of GnuTLS. +# +# This program 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. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 +# USA +" "This program is distributed in the hope that") + +;; from GnuTLS [has a different line break in snail mail address] +(elide-head--add-test gpl3-7 "\ +# This file is part of GnuTLS. +# +# The GnuTLS is free software; you can redistribute it and/or +# modify it under the terms of the GNU Lesser General Public License +# as published by the Free Software Foundation; either version 2.1 of +# the License, or (at your option) any later version. +# +# The GnuTLS 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 +# Lesser General Public License for more details. +# +# You should have received a copy of the GNU Lesser General Public +# License along with GnuTLS; if not, write to the Free +# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +# MA 02110-1301, USA +" "The GnuTLS is distributed in the hope that") + +;; from GnuTLS [has a typo in the 02111-1301 part] +(elide-head--add-test gpl3-8 "\ +/* nettle, low-level cryptographics library + * + * Copyright (C) 2002 Niels Möller + * Copyright (C) 2014 Red Hat + *\s\s + * The nettle library is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation; either version 2.1 of the License, or (at your + * option) any later version. + *\s + * The nettle library 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 Lesser General Public + * License for more details. + *\s + * You should have received a copy of the GNU Lesser General Public License + * along with the nettle library; see the file COPYING.LIB. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, + * MA 02111-1301, USA. + */ +" "The nettle library is distributed in the hope that") + +;; from GnuTLS-EXTRA [has a different line break in snail mail address] +(elide-head--add-test gpl3-9 "\ +# This file is part of GnuTLS-EXTRA. +# +# GnuTLS-extra 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. +# +# GnuTLS-extra 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 GnuTLS-EXTRA; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301, USA. +" "GnuTLS-extra is distributed in the hope that") + ;;; GPLv2 @@ -201,6 +285,28 @@ " "This program is distributed in the hope that") +;;; Apache License + +(elide-head--add-test apache1-1 "\ +/* + * Copyright 2011-2016 The Pkcs11Interop Project + * + * Licensed under the Apache License, Version 2.0 (the \"License\"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * https://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an \"AS IS\" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ +" "Unless required by applicable law") + + + ;;; Obsolete (with-suppressed-warnings ((obsolete elide-head) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 3400128759a..5c61ca10b9c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -704,6 +704,59 @@ inner loops respectively." (let ((bytecomp-tests--xx 1)) (set (make-local-variable 'bytecomp-tests--xx) 2) bytecomp-tests--xx) + + ;; Check for-effect optimisation of `condition-case' body form. + ;; With `condition-case' in for-effect context: + (let ((x (bytecomp-test-identity ?A)) + (r nil)) + (condition-case e + (characterp x) ; value (:success, var) + (error (setq r 'bad)) + (:success (setq r (list 'good e)))) + r) + (let ((x (bytecomp-test-identity ?B)) + (r nil)) + (condition-case nil + (characterp x) ; for-effect (:success, no var) + (error (setq r 'bad)) + (:success (setq r 'good))) + r) + (let ((x (bytecomp-test-identity ?C)) + (r nil)) + (condition-case e + (characterp x) ; for-effect (no :success, var) + (error (setq r (list 'bad e)))) + r) + (let ((x (bytecomp-test-identity ?D)) + (r nil)) + (condition-case nil + (characterp x) ; for-effect (no :success, no var) + (error (setq r 'bad))) + r) + ;; With `condition-case' in value context: + (let ((x (bytecomp-test-identity ?E))) + (condition-case e + (characterp x) ; for-effect (:success, var) + (error (list 'bad e)) + (:success (list 'good e)))) + (let ((x (bytecomp-test-identity ?F))) + (condition-case nil + (characterp x) ; for-effect (:success, no var) + (error 'bad) + (:success 'good))) + (let ((x (bytecomp-test-identity ?G))) + (condition-case e + (characterp x) ; value (no :success, var) + (error (list 'bad e)))) + (let ((x (bytecomp-test-identity ?H))) + (condition-case nil + (characterp x) ; value (no :success, no var) + (error 'bad))) + + (condition-case nil + (bytecomp-test-identity 3) + (error 'bad) + (:success)) ; empty handler ) "List of expressions for cross-testing interpreted and compiled code.") @@ -869,6 +922,16 @@ byte-compiled. Run with dynamic binding." (bytecomp--with-warning-test "defvar.*foo.*wider than.*characters" `(defvar foo t ,bytecomp-tests--docstring))) +(ert-deftest bytecomp-warn-quoted-condition () + (bytecomp--with-warning-test + "Warning: `condition-case' condition should not be quoted: 'arith-error" + '(condition-case nil + (abc) + ('arith-error "ugh"))) + (bytecomp--with-warning-test + "Warning: `ignore-error' condition argument should not be quoted: 'error" + '(ignore-error 'error (abc)))) + (ert-deftest bytecomp-warn-dodgy-args-eq () (dolist (fn '(eq eql)) (cl-flet ((msg (type arg) @@ -1370,7 +1433,50 @@ literals (Bug#20852)." (set-buffer (get-buffer-create "foo")) nil)) '((suspicious set-buffer)) - "Warning: Use .with-current-buffer. rather than")) + "Warning: Use .with-current-buffer. rather than") + + (test-suppression + '(defun zot () + (let ((_ 1)) + )) + '((empty-body let)) + "Warning: `let' with empty body") + + (test-suppression + '(defun zot () + (let* ((_ 1)) + )) + '((empty-body let*)) + "Warning: `let\\*' with empty body") + + (test-suppression + '(defun zot (x) + (when x + )) + '((empty-body when)) + "Warning: `when' with empty body") + + (test-suppression + '(defun zot (x) + (unless x + )) + '((empty-body unless)) + "Warning: `unless' with empty body") + + (test-suppression + '(defun zot (x) + (ignore-error arith-error + )) + '((empty-body ignore-error)) + "Warning: `ignore-error' with empty body") + + (test-suppression + '(defun zot (x) + (with-suppressed-warnings ((suspicious eq)) + )) + '((empty-body with-suppressed-warnings)) + "Warning: `with-suppressed-warnings' with empty body") + ) (ert-deftest bytecomp-tests--not-writable-directory () "Test that byte compilation works if the output directory isn't diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 63e7cd7608f..1cfd218592a 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -82,6 +82,40 @@ (should-not (buffer-live-p buffer-1)) (should (buffer-live-p buffer-2)))))) +(ert-deftest ert-test-with-buffer-selected/current () + (let ((origbuf (current-buffer))) + (ert-with-test-buffer () + (let ((buf (current-buffer))) + (should (not (eq buf origbuf))) + (with-current-buffer origbuf + (ert-with-buffer-selected buf + (should (eq (current-buffer) buf)))))))) + +(ert-deftest ert-test-with-buffer-selected/selected () + (ert-with-test-buffer () + (ert-with-buffer-selected (current-buffer) + (should (eq (window-buffer) (current-buffer)))))) + +(ert-deftest ert-test-with-buffer-selected/nil-buffer () + (ert-with-test-buffer () + (let ((buf (current-buffer))) + (ert-with-buffer-selected nil + (should (eq (window-buffer) buf)))))) + +(ert-deftest ert-test-with-buffer-selected/modification-hooks () + (ert-with-test-buffer () + (ert-with-buffer-selected (current-buffer) + (should (null inhibit-modification-hooks))))) + +(ert-deftest ert-test-with-buffer-selected/read-only () + (ert-with-test-buffer () + (ert-with-buffer-selected (current-buffer) + (should (null inhibit-read-only)) + (should (null buffer-read-only))))) + +(ert-deftest ert-test-with-buffer-selected/return-value () + (should (equal (ert-with-buffer-selected nil "foo") "foo"))) + (ert-deftest ert-test-with-test-buffer-selected/selected () (ert-with-test-buffer-selected () (should (eq (window-buffer) (current-buffer))))) @@ -90,6 +124,11 @@ (ert-with-test-buffer-selected () (should (null inhibit-modification-hooks)))) +(ert-deftest ert-test-with-test-buffer-selected/read-only () + (ert-with-test-buffer-selected () + (should (null inhibit-read-only)) + (should (null buffer-read-only)))) + (ert-deftest ert-test-with-test-buffer-selected/return-value () (should (equal (ert-with-test-buffer-selected () "foo") "foo"))) diff --git a/test/lisp/emacs-lisp/multisession-tests.el b/test/lisp/emacs-lisp/multisession-tests.el index 5807c27bd20..68d9c9646ff 100644 --- a/test/lisp/emacs-lisp/multisession-tests.el +++ b/test/lisp/emacs-lisp/multisession-tests.el @@ -94,7 +94,7 @@ (dotimes (i 100) (cl-incf (multisession-value multisession--bar)))))))) (while (process-live-p proc) - (ignore-error 'sqlite-locked-error + (ignore-error sqlite-locked-error (message "multisession--bar %s" (multisession-value multisession--bar)) ;;(cl-incf (multisession-value multisession--bar)) ) diff --git a/test/lisp/erc/erc-scenarios-base-unstable.el b/test/lisp/erc/erc-scenarios-base-unstable.el index f5b8df6f4a1..e6db40c5efb 100644 --- a/test/lisp/erc/erc-scenarios-base-unstable.el +++ b/test/lisp/erc/erc-scenarios-base-unstable.el @@ -24,7 +24,7 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(eval-when-compile (require 'erc-join)) +(eval-when-compile (require 'erc-join) (require 'warnings)) ;; Not unstable, but stashed here for now @@ -132,4 +132,56 @@ (not (setq failed (zerop (cl-decf tries))))))) (should-not failed))) +;; The `erc-networks' library has slowly become a hard dependency of +;; the interactive client since its incorporation in 2006. But its +;; module, which was added in ERC 5.3 (2008) and thereafter loaded by +;; default, only became quasi-required in ERC 5.5 (2022). Despite +;; this, a basic connection should still always succeed, at least long +;; enough to warn users that their setup is abnormal. Of course, +;; third-party code intentionally omitting the module will have to +;; override various erc-server-*-functions to avoid operating in a +;; degraded state, which has likely been the case for a while. + +(ert-deftest erc-scenarios-networks-no-module () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "networks/no-module") + (erc-server-flood-penalty 0.1) + (erc-networks-mode-orig erc-networks-mode) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (remq 'networks erc-modules)) + (warning-suppress-log-types '((erc))) + (expect (erc-d-t-make-expecter))) + + (erc-networks-mode -1) + (ert-info ("Connect and retain dialed name") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "Required module `networks' not loaded") + (funcall expect 10 "This server is in debug mode") + ;; Buffer not named after network + (should (string= (buffer-name) (format "127.0.0.1:%d" port))) + (erc-cmd-JOIN "#chan"))) + + (ert-info ("Join #chan, change nick, query op") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 20 "Even at thy teat thou") + (erc-cmd-NICK "dummy") + (funcall expect 10 "Your new nickname is dummy") + (erc-scenarios-common-say "/msg alice hi"))) + + (ert-info ("Switch to query and quit") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "alice")) + (funcall expect 20 "bye")) + + (with-current-buffer (format "127.0.0.1:%d" port) + (erc-cmd-QUIT "") + (funcall expect 10 "finished"))) + (when erc-networks-mode-orig + (erc-networks-mode +1)))) + ;;; erc-scenarios-base-unstable.el ends here diff --git a/test/lisp/erc/resources/networks/no-module/basic.eld b/test/lisp/erc/resources/networks/no-module/basic.eld new file mode 100644 index 00000000000..f1bdbd1219f --- /dev/null +++ b/test/lisp/erc/resources/networks/no-module/basic.eld @@ -0,0 +1,44 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 1 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.8.0") + (0.00 ":irc.foonet.org 003 tester :This server was created Mon, 12 Dec 2022 01:25:38 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this server") + (0.00 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #chan") + (0.03 ":tester!~u@z5d6jyn8pwxge.irc JOIN #chan")) + +((~nick 10 "NICK dummy") + (0.01 ":tester!~u@z5d6jyn8pwxge.irc NICK dummy")) + +((mode-1 10 "MODE #chan") + (0.01 ":irc.foonet.org 353 tester = #chan :@alice bob foonet tester") + (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list") + (0.03 ":irc.foonet.org 324 tester #chan +nt") + (0.00 ":irc.foonet.org 329 tester #chan 1670808354") + (0.00 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!") + (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!") + (0.03 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :alice: Forbear it therefore; give your cause to heaven.") + (0.01 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :bob: Even at thy teat thou hadst thy tyranny.")) + +((privmsg 10 "PRIVMSG alice :hi") + (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG dummy :bye")) + +((quit 10 "QUIT :\2ERC\2") + (0.03 ":dummy!~u@z5d6jyn8pwxge.irc QUIT :Quit: \2ERC\2")) diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el index 04e78279427..a2646a0296b 100644 --- a/test/lisp/eshell/em-extpipe-tests.el +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -42,7 +42,7 @@ (shell-command-switch "-c")) ;; Strip `eshell-trap-errors'. (should (equal ,expected - (cadr (eshell-parse-command input)))))) + (cadadr (eshell-parse-command input)))))) (with-substitute-for-temp (&rest body) ;; Substitute name of an actual temporary file and/or ;; buffer into `input'. The substitution logic is diff --git a/test/lisp/eshell/em-script-tests.el b/test/lisp/eshell/em-script-tests.el index b837d464ccd..f720f697c67 100644 --- a/test/lisp/eshell/em-script-tests.el +++ b/test/lisp/eshell/em-script-tests.el @@ -35,21 +35,43 @@ ;;; Tests: (ert-deftest em-script-test/source-script () - "Test sourcing script with no argumentss" + "Test sourcing a simple script." (ert-with-temp-file temp-file :text "echo hi" (with-temp-eshell (eshell-match-command-output (format "source %s" temp-file) "hi\n")))) -(ert-deftest em-script-test/source-script-arg-vars () - "Test sourcing script with $0, $1, ... variables" +(ert-deftest em-script-test/source-script/redirect () + "Test sourcing a script and redirecting its output." + (ert-with-temp-file temp-file + :text "echo hi\necho bye" + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "source %s > #<%s>" temp-file bufname) + "\\`\\'")) + (should (equal (buffer-string) "hibye"))))) + +(ert-deftest em-script-test/source-script/redirect/dev-null () + "Test sourcing a script and redirecting its output, including to /dev/null." + (ert-with-temp-file temp-file + :text "echo hi\necho bad > /dev/null\necho bye" + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "source %s > #<%s>" temp-file bufname) + "\\`\\'")) + (should (equal (buffer-string) "hibye"))))) + +(ert-deftest em-script-test/source-script/arg-vars () + "Test sourcing script with $0, $1, ... variables." (ert-with-temp-file temp-file :text "printnl $0 \"$1 $2\"" (with-temp-eshell (eshell-match-command-output (format "source %s one two" temp-file) (format "%s\none two\n" temp-file))))) -(ert-deftest em-script-test/source-script-all-args-var () - "Test sourcing script with the $* variable" +(ert-deftest em-script-test/source-script/all-args-var () + "Test sourcing script with the $* variable." (ert-with-temp-file temp-file :text "printnl $*" (with-temp-eshell (eshell-match-command-output (format "source %s" temp-file) diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el index 6cc35ecdb1b..936397d8869 100644 --- a/test/lisp/eshell/em-tramp-tests.el +++ b/test/lisp/eshell/em-tramp-tests.el @@ -23,37 +23,41 @@ (require 'em-tramp) (require 'tramp) +(defmacro em-tramp-test/should-replace-command (form replacement) + "Check that calling FORM results in it being replaced with REPLACEMENT." + (declare (indent 1)) + `(should (equal + (catch 'eshell-replace-command ,form) + (list 'eshell-with-copied-handles + (list 'eshell-trap-errors + ,replacement) + t)))) + (ert-deftest em-tramp-test/su-default () "Test Eshell `su' command with no arguments." - (should (equal - (catch 'eshell-replace-command (eshell/su)) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:root@%s:%s" - tramp-default-host default-directory))))))) + (em-tramp-test/should-replace-command (eshell/su) + `(eshell-named-command + "cd" + (list ,(format "/su:root@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/su-user () "Test Eshell `su' command with USER argument." - (should (equal - (catch 'eshell-replace-command (eshell/su "USER")) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:USER@%s:%s" - tramp-default-host default-directory))))))) + (em-tramp-test/should-replace-command (eshell/su "USER") + `(eshell-named-command + "cd" + (list ,(format "/su:USER@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/su-login () "Test Eshell `su' command with -/-l/--login option." (dolist (args '(("--login") ("-l") ("-"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/su args)) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/su:root@%s:~/" tramp-default-host)))))))) + (em-tramp-test/should-replace-command (apply #'eshell/su args) + `(eshell-named-command + "cd" + (list ,(format "/su:root@%s:~/" tramp-default-host)))))) (defun mock-eshell-named-command (&rest args) "Dummy function to test Eshell `sudo' command rewriting." @@ -89,23 +93,19 @@ "Test Eshell `sudo' command with -s/--shell option." (dolist (args '(("--shell") ("-s"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/sudo args)) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/sudo:root@%s:%s" - tramp-default-host default-directory)))))))) + (em-tramp-test/should-replace-command (apply #'eshell/sudo args) + `(eshell-named-command + "cd" + (list ,(format "/sudo:root@%s:%s" + tramp-default-host default-directory)))))) (ert-deftest em-tramp-test/sudo-user-shell () "Test Eshell `sudo' command with -s and -u options." - (should (equal - (catch 'eshell-replace-command (eshell/sudo "-u" "USER" "-s")) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/sudo:USER@%s:%s" - tramp-default-host default-directory))))))) + (em-tramp-test/should-replace-command (eshell/sudo "-u" "USER" "-s") + `(eshell-named-command + "cd" + (list ,(format "/sudo:USER@%s:%s" + tramp-default-host default-directory))))) (ert-deftest em-tramp-test/doas-basic () "Test Eshell `doas' command with default user." @@ -142,22 +142,18 @@ "Test Eshell `doas' command with -s/--shell option." (dolist (args '(("--shell") ("-s"))) - (should (equal - (catch 'eshell-replace-command (apply #'eshell/doas args)) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/doas:root@%s:%s" - tramp-default-host default-directory)))))))) + (em-tramp-test/should-replace-command (apply #'eshell/doas args) + `(eshell-named-command + "cd" + (list ,(format "/doas:root@%s:%s" + tramp-default-host default-directory)))))) (ert-deftest em-tramp-test/doas-user-shell () "Test Eshell `doas' command with -s and -u options." - (should (equal - (catch 'eshell-replace-command (eshell/doas "-u" "USER" "-s")) - `(eshell-trap-errors - (eshell-named-command - "cd" - (list ,(format "/doas:USER@%s:%s" - tramp-default-host default-directory))))))) + (em-tramp-test/should-replace-command (eshell/doas "-u" "USER" "-s") + `(eshell-named-command + "cd" + (list ,(format "/doas:USER@%s:%s" + tramp-default-host default-directory))))) ;;; em-tramp-tests.el ends here diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index 92d785d7fdf..cc40dde3552 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -148,14 +148,21 @@ e.g. \"{(+ 1 2)} 3\" => 3" "echo $name; for name in 3 { echo $name }; echo $name" "env-value\n3\nenv-value\n")))) +(ert-deftest esh-cmd-test/for-loop-pipe () + "Test invocation of a for loop piped to another command." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (eshell-match-command-output "for i in foo bar baz { echo $i } | rev" + "zabraboof"))) + (ert-deftest esh-cmd-test/while-loop () "Test invocation of a while loop." (with-temp-eshell (let ((eshell-test-value '(0 1 2))) (eshell-match-command-output (concat "while $eshell-test-value " - "{ setq eshell-test-value (cdr eshell-test-value) }") - "(1 2)\n(2)\n")))) + "{ (pop eshell-test-value) }") + "0\n1\n2\n")))) (ert-deftest esh-cmd-test/while-loop-lisp-form () "Test invocation of a while loop using a Lisp form." @@ -176,6 +183,17 @@ e.g. \"{(+ 1 2)} 3\" => 3" "{ setq eshell-test-value (1+ eshell-test-value) }") "1\n2\n3\n")))) +(ert-deftest esh-cmd-test/while-loop-pipe () + "Test invocation of a while loop piped to another command." + (skip-unless (executable-find "rev")) + (with-temp-eshell + (let ((eshell-test-value '("foo" "bar" "baz"))) + (eshell-match-command-output + (concat "while $eshell-test-value " + "{ (pop eshell-test-value) }" + " | rev") + "zabraboof")))) + (ert-deftest esh-cmd-test/until-loop () "Test invocation of an until loop." (with-temp-eshell @@ -253,6 +271,28 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil." (eshell-command-result-equal "if {[ foo = bar ]} {echo yes} {echo no}" "no")) +(ert-deftest esh-cmd-test/if-statement-pipe () + "Test invocation of an if statement piped to another command." + (skip-unless (executable-find "rev")) + (let ((eshell-test-value t)) + (eshell-command-result-equal "if $eshell-test-value {echo yes} | rev" + "sey")) + (let ((eshell-test-value nil)) + (eshell-command-result-equal "if $eshell-test-value {echo yes} | rev" + nil))) + +(ert-deftest esh-cmd-test/if-else-statement-pipe () + "Test invocation of an if/else statement piped to another command." + (skip-unless (executable-find "rev")) + (let ((eshell-test-value t)) + (eshell-command-result-equal + "if $eshell-test-value {echo yes} {echo no} | rev" + "sey")) + (let ((eshell-test-value nil)) + (eshell-command-result-equal + "if $eshell-test-value {echo yes} {echo no} | rev" + "on"))) + (ert-deftest esh-cmd-test/unless-statement () "Test invocation of an unless statement." (let ((eshell-test-value t)) diff --git a/test/lisp/eshell/esh-io-tests.el b/test/lisp/eshell/esh-io-tests.el index 37b234eaf06..0f09afa19e4 100644 --- a/test/lisp/eshell/esh-io-tests.el +++ b/test/lisp/eshell/esh-io-tests.el @@ -146,6 +146,45 @@ (should (equal (buffer-string) "new")) (should (equal eshell-test-value "new"))))) +(ert-deftest esh-io-test/redirect-subcommands () + "Check that redirecting subcommands applies to all subcommands." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command (format "{echo foo; echo bar} > #<%s>" bufname))) + (should (equal (buffer-string) "foobar")))) + +(ert-deftest esh-io-test/redirect-subcommands/override () + "Check that redirecting subcommands applies to all subcommands. +Include a redirect to another location in the subcommand to +ensure only its statement is redirected." + (eshell-with-temp-buffer bufname "old" + (eshell-with-temp-buffer bufname-2 "also old" + (with-temp-eshell + (eshell-insert-command + (format "{echo foo; echo bar > #<%s>; echo baz} > #<%s>" + bufname-2 bufname))) + (should (equal (buffer-string) "bar"))) + (should (equal (buffer-string) "foobaz")))) + +(ert-deftest esh-io-test/redirect-subcommands/dev-null () + "Check that redirecting subcommands applies to all subcommands. +Include a redirect to /dev/null to ensure it only applies to its +statement." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command + (format "{echo foo; echo bar > /dev/null; echo baz} > #<%s>" + bufname))) + (should (equal (buffer-string) "foobaz")))) + +(ert-deftest esh-io-test/redirect-subcommands/interpolated () + "Check that redirecting interpolated subcommands applies to all subcommands." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-insert-command + (format "echo ${echo foo; echo bar} > #<%s>" bufname))) + (should (equal (buffer-string) "foobar")))) + ;; Redirecting specific handles @@ -262,24 +301,55 @@ stdout originally pointed (the terminal)." "stderr\n")) (should (equal (buffer-string) "stdout\n")))) -(ert-deftest esh-io-test/redirect-pipe () - "Check that \"redirecting\" to a pipe works." - ;; `|' should only redirect stdout. + +;; Pipelines + +(ert-deftest esh-io-test/pipeline/default () + "Check that `|' only pipes stdout." + (skip-unless (executable-find "rev")) (eshell-command-result-equal "test-output | rev" - "stderr\ntuodts\n") - ;; `|&' should redirect stdout and stderr. + "stderr\ntuodts\n")) + + +(ert-deftest esh-io-test/pipeline/all () + "Check that `|&' only pipes stdout and stderr." + (skip-unless (executable-find "rev")) (eshell-command-result-equal "test-output |& rev" "tuodts\nrredts\n")) +(ert-deftest esh-io-test/pipeline/subcommands () + "Chek that all commands in a subcommand are properly piped." + (skip-unless (executable-find "rev")) + (eshell-command-result-equal "{echo foo; echo bar} | rev" + "raboof")) + ;; Virtual targets -(ert-deftest esh-io-test/virtual-dev-eshell () +(ert-deftest esh-io-test/virtual/dev-null () + "Check that redirecting to /dev/null works." + (with-temp-eshell + (eshell-match-command-output "echo hi > /dev/null" "\\`\\'"))) + +(ert-deftest esh-io-test/virtual/dev-null/multiple () + "Check that redirecting to /dev/null works alongside other redirections." + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "echo new > /dev/null > #<%s>" bufname) "\\`\\'")) + (should (equal (buffer-string) "new"))) + (eshell-with-temp-buffer bufname "old" + (with-temp-eshell + (eshell-match-command-output + (format "echo new > #<%s> > /dev/null" bufname) "\\`\\'")) + (should (equal (buffer-string) "new")))) + +(ert-deftest esh-io-test/virtual/dev-eshell () "Check that redirecting to /dev/eshell works." (with-temp-eshell (eshell-match-command-output "echo hi > /dev/eshell" "hi"))) -(ert-deftest esh-io-test/virtual-dev-kill () +(ert-deftest esh-io-test/virtual/dev-kill () "Check that redirecting to /dev/kill works." (with-temp-eshell (eshell-insert-command "echo one > /dev/kill") diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index 1d9674070c0..a9338050311 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -33,9 +33,9 @@ (defvar eshell-history-file-name nil) (defvar eshell-last-dir-ring-file-name nil) -(defvar eshell-test--max-subprocess-time 5 - "The maximum amount of time to wait for a subprocess to finish, in seconds. -See `eshell-wait-for-subprocess'.") +(defvar eshell-test--max-wait-time 5 + "The maximum amount of time to wait for a condition to resolve, in seconds. +See `eshell-wait-for'.") (defun eshell-tests-remote-accessible-p () "Return if a test involving remote files can proceed. @@ -73,19 +73,28 @@ BUFNAME will be set to the name of the temporary buffer." (let ((,bufname (buffer-name))) ,@body))) +(defun eshell-wait-for (predicate &optional message) + "Wait until PREDICATE returns non-nil. +If this takes longer than `eshell-test--max-wait-time', raise an +error. MESSAGE is an optional message to use if this times out." + (let ((start (current-time)) + (message (or message "timed out waiting for condition"))) + (while (not (funcall predicate)) + (when (> (float-time (time-since start)) + eshell-test--max-wait-time) + (error message)) + (sit-for 0.1)))) + (defun eshell-wait-for-subprocess (&optional all) "Wait until there is no interactive subprocess running in Eshell. If ALL is non-nil, wait until there are no Eshell subprocesses at all running. -If this takes longer than `eshell-test--max-subprocess-time', +If this takes longer than `eshell-test--max-wait-time', raise an error." - (let ((start (current-time))) - (while (if all eshell-process-list (eshell-interactive-process-p)) - (when (> (float-time (time-since start)) - eshell-test--max-subprocess-time) - (error "timed out waiting for subprocess(es)")) - (sit-for 0.1)))) + (eshell-wait-for + (lambda () + (not (if all eshell-process-list (eshell-interactive-process-p)))))) (defun eshell-insert-command (command &optional func) "Insert a COMMAND at the end of the buffer. diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index c67ac67fd36..dd8be8e65f0 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -128,16 +128,17 @@ (delete-region (point) (point-max)))))) (ert-deftest eshell-test/queue-input () - "Test queuing command input" + "Test queuing command input. +This should let the current command finish, then automatically +insert the queued one at the next prompt, and finally run it." (with-temp-eshell - (eshell-insert-command "sleep 2") - (eshell-insert-command "echo alpha" 'eshell-queue-input) - (let ((count 10)) - (while (and eshell-current-command - (> count 0)) - (sit-for 1) - (setq count (1- count)))) - (should (eshell-match-output "alpha\n")))) + (eshell-insert-command "sleep 1; echo slept") + (eshell-insert-command "echo alpha" #'eshell-queue-input) + (let ((start (marker-position (eshell-beginning-of-output)))) + (eshell-wait-for (lambda () (not eshell-current-command))) + (should (string-match "^slept\n.*echo alpha\nalpha\n$" + (buffer-substring-no-properties + start (eshell-end-of-output))))))) (ert-deftest eshell-test/flush-output () "Test flushing of previous output" diff --git a/test/lisp/gnus/mml-sec-resources/trustlist.txt b/test/lisp/gnus/mml-sec-resources/trustlist.txt index f886572d283..947ec526199 100644 --- a/test/lisp/gnus/mml-sec-resources/trustlist.txt +++ b/test/lisp/gnus/mml-sec-resources/trustlist.txt @@ -2,7 +2,7 @@ # well as empty lines are ignored. Lines have a length limit but this # is not a serious limitation as the format of the entries is fixed and # checked by gpg-agent. A non-comment line starts with optional white -# space, followed by the SHA-1 fingerpint in hex, followed by a flag +# space, followed by the SHA-1 fingerprint in hex, followed by a flag # which may be one of 'P', 'S' or '*' and optionally followed by a list of # other flags. The fingerprint may be prefixed with a '!' to mark the # key as not trusted. You should give the gpg-agent a HUP or run the diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 79b2fc803d6..d7f4576335c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2857,6 +2857,7 @@ This checks also `file-name-as-directory', `file-name-directory', This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (tramp--test-enabled)) + ;; Since Emacs 29.1, `make-directory' has defined return values. (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "foo/bar" tmp-name1)) @@ -2865,7 +2866,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (unwind-protect (progn (with-file-modes unusual-file-mode-1 - (make-directory tmp-name1)) + (if (tramp--test-emacs29-p) + (should-not (make-directory tmp-name1)) + (make-directory tmp-name1))) (should-error (make-directory tmp-name1) :type 'file-already-exists) @@ -2878,15 +2881,19 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (make-directory tmp-name2) :type 'file-error) (with-file-modes unusual-file-mode-2 - (make-directory tmp-name2 'parents)) + (if (tramp--test-emacs29-p) + (should-not (make-directory tmp-name2 'parents)) + (make-directory tmp-name2 'parents))) (should (file-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2)) (when (tramp--test-supports-set-file-modes-p) (should (equal (format "%#o" unusual-file-mode-2) (format "%#o" (file-modes tmp-name2))))) ;; If PARENTS is non-nil, `make-directory' shall not - ;; signal an error when DIR exists already. - (make-directory tmp-name2 'parents)) + ;; signal an error when DIR exists already. It returns t. + (if (tramp--test-emacs29-p) + (should (make-directory tmp-name2 'parents)) + (make-directory tmp-name2 'parents))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) diff --git a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl index fa328438cb1..6d3f478595e 100644 --- a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl +++ b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl @@ -1,4 +1,4 @@ -# The following Perl punctiation variables contain characters which +# The following Perl punctuation variables contain characters which # are classified as string delimiters in the syntax table. The mode # should not be confused by these. # The corresponding tests check that two consecutive '#' characters diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index 1bb206e7040..96615c19383 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -114,7 +114,7 @@ end of the statement." ;;; Fontification tests (ert-deftest cperl-test-fontify-punct-vars () - "Test fontification of Perl's punctiation variables. + "Test fontification of Perl's punctuation variables. Perl has variable names containing unbalanced quotes for the list separator $\" and pre- and postmatch $` and $'. A reference to these variables, for example \\$\", should not cause the dollar diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-method-params-indent.rb b/test/lisp/progmodes/ruby-mode-resources/ruby-method-params-indent.rb new file mode 100644 index 00000000000..2b665797397 --- /dev/null +++ b/test/lisp/progmodes/ruby-mode-resources/ruby-method-params-indent.rb @@ -0,0 +1,18 @@ +class C + def self.foo( + baz, + bar + ) = + what + + def foo=( + baz, + bar + ) + hello + end +end + +# Local Variables: +# ruby-method-params-indent: 0 +# End: diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb index 2451edaee22..6a69d9db78a 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb @@ -538,3 +538,7 @@ class Bar baz end end + +# Local Variables: +# ruby-method-params-indent: t +# End: diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index 9be01dc78f9..560f780285a 100644 --- a/test/lisp/progmodes/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el @@ -943,16 +943,20 @@ VALUES-PLIST is a list with alternating index and value elements." "Blub#bye" "Blub#hiding"))))) -(ert-deftest ruby--indent/converted-from-manual-test () - :tags '(:expensive-test) - ;; Converted from manual test. - (let ((buf (find-file-noselect (ert-resource-file "ruby.rb")))) - (unwind-protect - (with-current-buffer buf - (let ((orig (buffer-string))) - (indent-region (point-min) (point-max)) - (should (equal (buffer-string) orig)))) - (kill-buffer buf)))) +(defmacro ruby-deftest-indent (file) + `(ert-deftest ,(intern (format "ruby-indent-test/%s" file)) () + ;; :tags '(:expensive-test) + (let ((buf (find-file-noselect (ert-resource-file ,file)))) + (unwind-protect + (with-current-buffer buf + (let ((orig (buffer-string))) + ;; Indent and check that we get the original text. + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) orig)))) + (kill-buffer buf))))) + +(ruby-deftest-indent "ruby.rb") +(ruby-deftest-indent "ruby-method-params-indent.rb") (ert-deftest ruby--test-chained-indentation () (with-temp-buffer diff --git a/test/lisp/repeat-tests.el b/test/lisp/repeat-tests.el index 1382d003599..06c6f748a2a 100644 --- a/test/lisp/repeat-tests.el +++ b/test/lisp/repeat-tests.el @@ -76,27 +76,27 @@ "C-x w a b a c" '((1 a) (1 b) (1 a)) "c") (repeat-tests--check - "M-C-a b a c" + "C-M-a b a c" '((1 a) (1 b) (1 a)) "c") (repeat-tests--check - "M-C-z b a c" + "C-M-z b a c" '((1 a)) "bac") (unwind-protect (progn (put 'repeat-tests-call-a 'repeat-check-key 'no) (repeat-tests--check - "M-C-z b a c" + "C-M-z b a c" '((1 a) (1 b) (1 a)) "c")) (put 'repeat-tests-call-a 'repeat-check-key nil))) (let ((repeat-check-key nil)) (repeat-tests--check - "M-C-z b a c" + "C-M-z b a c" '((1 a) (1 b) (1 a)) "c") (unwind-protect (progn (put 'repeat-tests-call-a 'repeat-check-key t) (repeat-tests--check - "M-C-z b a c" + "C-M-z b a c" '((1 a)) "bac")) (put 'repeat-tests-call-a 'repeat-check-key nil)))))) @@ -125,15 +125,17 @@ (repeat-tests--check "C-2 C-x w a C-3 c" '((2 a)) "ccc")) - ;; TODO: fix and uncomment - ;; (let ((repeat-keep-prefix t)) - ;; (repeat-tests--check - ;; "C-2 C-x w a b a b c" - ;; '((2 a) (2 b) (2 a) (2 b)) "c") - ;; (repeat-tests--check - ;; "C-2 C-x w a C-1 C-2 b a C-3 C-4 b c" - ;; '((2 a) (12 b) (12 a) (34 b)) "c")) - ))) + ;; Fixed in bug#51281 and bug#55986 + (let ((repeat-keep-prefix t)) + ;; Re-enable to take effect. + (repeat-mode -1) (repeat-mode +1) + (repeat-tests--check + "C-2 C-x w a b a b c" + '((2 a) (2 b) (2 a) (2 b)) "c") + ;; (repeat-tests--check + ;; "C-2 C-x w a C-1 C-2 b a C-3 C-4 b c" + ;; '((2 a) (12 b) (12 a) (34 b)) "c") + )))) ;; TODO: :tags '(:expensive-test) for repeat-exit-timeout diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el index 5083fc5abae..ec1796f7670 100644 --- a/test/lisp/url/url-future-tests.el +++ b/test/lisp/url/url-future-tests.el @@ -52,7 +52,7 @@ (should (equal (url-future-cancel tocancel) tocancel)) (should-error (url-future-call tocancel)) (should (null url-future-tests--saver)) - (should (url-future-cancelled-p tocancel)))) + (should (url-future-canceled-p tocancel)))) (provide 'url-future-tests) diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index 19e3dbb42a6..b67ccd4fe09 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -478,5 +478,84 @@ baz")))) (should (equal (diff-hunk-file-names) '("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el"))))) +(ert-deftest diff-mode-test-fixups-added-lines () + "Check that `diff-fixup-modifs' works well with hunks with added lines." + (let ((patch "--- file ++++ file +@@ -0,0 +1,15 @@ ++1 ++2 ++3 ++4 +")) + (with-temp-buffer + (insert patch) + (diff-fixup-modifs (point-min) (point-max)) + (should (equal (buffer-string) "--- file ++++ file +@@ -0,0 +1,4 @@ ++1 ++2 ++3 ++4 +")))) + (let ((patch "--- file ++++ file +@@ -389,5 +398,6 @@ + while (1) + ; ++ # not needed + # at all + # stop +")) + (with-temp-buffer + (insert patch) + (diff-fixup-modifs (point-min) (point-max)) + (should (equal (buffer-string) "--- file ++++ file +@@ -389,4 +398,5 @@ + while (1) + ; ++ # not needed + # at all + # stop +"))))) + +(ert-deftest diff-mode-test-fixups-empty-hunks () + "Check that `diff-fixup-modifs' works well with empty hunks." + (let ((patch "--- file ++++ file +@@ -1 +1 @@ +-1 +@@ -10 +10 @@ +-1 ++1 +--- otherfile ++++ otherfile +@@ -1 +1 @@ ++2 +@@ -10 +10 @@ +-1 ++1 +")) + (with-temp-buffer + (insert patch) + (diff-fixup-modifs (point-min) (point-max)) + (should (equal (buffer-string) "--- file ++++ file +@@ -1,1 +1,0 @@ +-1 +@@ -10,1 +10,1 @@ +-1 ++1 +--- otherfile ++++ otherfile +@@ -1,0 +1,1 @@ ++2 +@@ -10,1 +10,1 @@ +-1 ++1 +"))))) + (provide 'diff-mode-tests) ;;; diff-mode-tests.el ends here diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index fb53543c9e1..d72748cd0c9 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -327,6 +327,84 @@ buffer's content." "«:whitespace-empty:\n" "»"))))) +(ert-deftest whitespace-tests--empty-bob-eob-modified () + "Regression test for Bug#60066." + (whitespace-tests--with-test-buffer '() + (insert "\nx\n\n") + (goto-char 2) + (set-buffer-modified-p nil) + (let ((whitespace-style '(face empty))) + (whitespace-mode 1) + (should (not (buffer-modified-p)))))) + +(ert-deftest whitespace-tests--indirect-clone-breaks-base-markers () + "Specific regression test for Bug#59618." + (whitespace-tests--with-test-buffer '(face empty) + (insert "\nx\n\n") + (let ((base (current-buffer)) + ;; `unwind-protect' is not used to clean up `indirect' + ;; because the buffer should only be killed on success. + (indirect (clone-indirect-buffer (buffer-name) nil))) + (should (eq (marker-buffer whitespace-bob-marker) base)) + (should (eq (marker-buffer whitespace-eob-marker) base)) + (ert-with-buffer-selected indirect + ;; Mutate the indirect buffer to update its bob/eob markers. + (execute-kbd-macro (kbd "z RET M-< a"))) + ;; With Bug#59618, the above mutation would cause the base + ;; buffer's markers to point inside the indirect buffer because + ;; the indirect buffer erroneously shared marker objects with + ;; the base buffer. Killing the indirect buffer would then + ;; invalidate those markers (make them point nowhere). + (kill-buffer indirect) + (should (eq (marker-buffer whitespace-bob-marker) base)) + (should (eq (marker-buffer whitespace-eob-marker) base))))) + +(defun whitespace-tests--check-markers (buf bpos epos) + (with-current-buffer buf + (should (eq (marker-buffer whitespace-bob-marker) buf)) + (should (eq (marker-position whitespace-bob-marker) bpos)) + (should (eq (marker-buffer whitespace-eob-marker) buf)) + (should (eq (marker-position whitespace-eob-marker) epos)))) + +(ert-deftest whitespace-tests--indirect-clone-markers () + "Test `whitespace--clone' on indirect clones." + (whitespace-tests--with-test-buffer '(face empty) + (insert "\nx\n\n") + (let ((base (current-buffer)) + ;; `unwind-protect' is not used to clean up `indirect' + ;; because the buffer should only be killed on success. + (indirect (clone-indirect-buffer nil nil))) + (whitespace-tests--check-markers base 2 4) + (ert-with-buffer-selected indirect + (whitespace-tests--check-markers indirect 2 4) + ;; Mutate the buffer to trigger `after-change-functions' and + ;; thus `whitespace--update-bob-eob'. + (execute-kbd-macro (kbd "z RET M-< a")) + (whitespace-tests--check-markers indirect 1 8)) + (kill-buffer indirect) + ;; When the buffer was modified above, the new "a" character at + ;; the beginning moved the base buffer's markers by one. Emacs + ;; did not run the base buffer's `after-change-functions' after + ;; the indirect buffer was edited (Bug#46982), so the end result + ;; is just the shift by one. + (whitespace-tests--check-markers base 3 5)))) + +(ert-deftest whitespace-tests--regular-clone-markers () + "Test `whitespace--clone' on regular clones." + (whitespace-tests--with-test-buffer '(face empty) + (insert "\nx\n\n") + (let ((orig (current-buffer)) + ;; `unwind-protect' is not used to clean up `clone' because + ;; the buffer should only be killed on success. + (clone (clone-buffer))) + (whitespace-tests--check-markers orig 2 4) + (ert-with-buffer-selected clone + (whitespace-tests--check-markers clone 2 4) + (execute-kbd-macro (kbd "z RET M-< a")) + (whitespace-tests--check-markers clone 1 8)) + (kill-buffer clone) + (whitespace-tests--check-markers orig 2 4)))) + (provide 'whitespace-tests) ;;; whitespace-tests.el ends here |