From 9d1c3c9830fc620290626fda1cf5a2250287ba31 Mon Sep 17 00:00:00 2001
From: Eli Zaretskii <eliz@gnu.org>
Date: Thu, 5 Aug 2021 20:42:10 +0300
Subject: Fix files-tests on non-Posix systems
* test/lisp/files-tests.el (files-test-auto-save-name-default)
(files-test-auto-save-name-transform)
(files-test-auto-save-name-unique, files-test-lock-name-default)
(files-test-lock-name-unique): Skip the drive letter in absolute
file names on MS-Windows/MS-DOS when comparing file names against
the expected ones.
(files-tests-file-name-non-special--subprocess): Skip test on
MS-Windows/MS-DOS.
---
test/lisp/files-tests.el | 43 ++++++++++++++++++++++++++++---------------
1 file changed, 28 insertions(+), 15 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index a5c82360177..640f7d8420e 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -316,7 +316,9 @@ be $HOME."
(ert-deftest files-tests-file-name-non-special--subprocess ()
"Check that Bug#25949 and Bug#48177 are fixed."
- (skip-unless (and (executable-find "true") (file-exists-p null-device)))
+ (skip-unless (and (executable-find "true") (file-exists-p null-device)
+ ;; These systems cannot set date of the null device.
+ (not (memq system-type '(windows-nt ms-dos)))))
(let ((default-directory (file-name-quote temporary-file-directory))
(true (file-name-quote (executable-find "true")))
(null (file-name-quote null-device)))
@@ -951,40 +953,51 @@ unquoted file names."
(ert-deftest files-test-auto-save-name-default ()
(with-temp-buffer
- (let ((auto-save-file-name-transforms nil))
+ (let ((auto-save-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
(setq buffer-file-name "/tmp/foo.txt")
- (should (equal (make-auto-save-file-name) "/tmp/#foo.txt#")))))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/tmp/#foo.txt#")))))
(ert-deftest files-test-auto-save-name-transform ()
(with-temp-buffer
(setq buffer-file-name "/tmp/foo.txt")
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil))))
- (should (equal (make-auto-save-file-name) "/var/tmp/#foo.txt#")))))
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" nil)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#foo.txt#")))))
(ert-deftest files-test-auto-save-name-unique ()
(with-temp-buffer
(setq buffer-file-name "/tmp/foo.txt")
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
- (should (equal (make-auto-save-file-name) "/var/tmp/#!tmp!foo.txt#")))
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
+ "/var/tmp/#!tmp!foo.txt#")))
(let ((auto-save-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
- (should (equal (make-auto-save-file-name)
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-auto-save-file-name) name-start)
"/var/tmp/#b57c5a04f429a83305859d3350ecdab8315a9037#")))))
(ert-deftest files-test-lock-name-default ()
- (let ((lock-file-name-transforms nil))
- (should (equal (make-lock-file-name "/tmp/foo.txt") "/tmp/.#foo.txt"))))
+ (let ((lock-file-name-transforms nil)
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
+ "/tmp/.#foo.txt"))))
(ert-deftest files-test-lock-name-unique ()
(let ((lock-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t))))
- (should (equal (make-lock-file-name "/tmp/foo.txt")
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" t)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
"/var/tmp/.#!tmp!foo.txt")))
(let ((lock-file-name-transforms
- '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1))))
- (should (equal (make-lock-file-name "/tmp/foo.txt")
+ '(("\\`/.*/\\([^/]+\\)\\'" "/var/tmp/\\1" sha1)))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2 nil)))
+ (should (equal (substring (make-lock-file-name "/tmp/foo.txt") name-start)
"/var/tmp/.#b57c5a04f429a83305859d3350ecdab8315a9037"))))
(ert-deftest files-tests-file-name-non-special-make-directory ()
--
cgit v1.2.3
From 9a6fc638433c19021278616019ef5064740f86fe Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sat, 7 Aug 2021 12:50:56 +0200
Subject: Fix problem with relative directories in CDPATH
* lisp/files.el (parse-colon-path): Allow relative directories
(like ".") in CDPATH (bug#49918).
---
lisp/files.el | 5 ++++-
test/lisp/files-tests.el | 5 ++++-
2 files changed, 8 insertions(+), 2 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/lisp/files.el b/lisp/files.el
index c2607956915..b58f90db48c 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -782,7 +782,10 @@ nil (meaning `default-directory') as the associated list element."
(let ((spath (substitute-env-vars search-path)))
(mapcar (lambda (f)
(if (equal "" f) nil
- (let ((dir (expand-file-name (file-name-as-directory f))))
+ (let ((dir (file-name-as-directory f)))
+ (when (file-name-absolute-p dir)
+ ;; Expand "~".
+ (setq dir (expand-file-name dir)))
;; Previous implementation used `substitute-in-file-name'
;; which collapse multiple "/" in front. Do the same for
;; backward compatibility.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 640f7d8420e..523f51e0194 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1461,7 +1461,10 @@ See <https://debbugs.gnu.org/36401>."
(should (equal (parse-colon-path "x:/foo//bar/baz")
'("x:/foo/bar/baz/")))
(should (equal (parse-colon-path "/foo//bar/baz")
- '("/foo/bar/baz/")))))
+ '("/foo/bar/baz/"))))
+
+ (should (equal (parse-colon-path ".:/tmp")
+ '("./" "/tmp/"))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."
--
cgit v1.2.3
From 85c8a9cd0cff0e2f6d5470423731d9f1e87e2cde Mon Sep 17 00:00:00 2001
From: Eli Zaretskii <eliz@gnu.org>
Date: Sat, 7 Aug 2021 14:29:45 +0300
Subject: Fix files-tests broken on MS-Windows by a recent change
* test/lisp/files-tests.el (files-colon-path): Use path-separator, and
account for drive letters in absolute file names on MS-Windows. (Bug#49918)
---
test/lisp/files-tests.el | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 523f51e0194..a612c0617d3 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1462,9 +1462,11 @@ See <https://debbugs.gnu.org/36401>."
'("x:/foo/bar/baz/")))
(should (equal (parse-colon-path "/foo//bar/baz")
'("/foo/bar/baz/"))))
-
- (should (equal (parse-colon-path ".:/tmp")
- '("./" "/tmp/"))))
+ (let* ((path (concat "." path-separator "/tmp"))
+ (parsed-path (parse-colon-path path))
+ (name-start (if (memq system-type '(windows-nt ms-dos)) 2)))
+ (should (equal (car parsed-path) "./"))
+ (should (equal (substring (cadr parsed-path) name-start) "/tmp/"))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."
--
cgit v1.2.3
From 1cae6b9aab0796f5fdb97aafaa018b8081ebb294 Mon Sep 17 00:00:00 2001
From: Eli Zaretskii <eliz@gnu.org>
Date: Sun, 8 Aug 2021 17:29:56 +0300
Subject: Another fix for parse-colon-path
* test/lisp/files-tests.el (files-tests-bug-21454, files-colon-path):
Adapt to change in behavior of 'parse-colon-path'.
* lisp/files.el (parse-colon-path): Don't expand the directory
names: that changes the names in ways this function is not
supposed to. (Bug#49918)
---
lisp/files.el | 3 ---
test/lisp/files-tests.el | 33 +++++++++++++++------------------
2 files changed, 15 insertions(+), 21 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/lisp/files.el b/lisp/files.el
index b58f90db48c..89ee13eb686 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -783,9 +783,6 @@ nil (meaning `default-directory') as the associated list element."
(mapcar (lambda (f)
(if (equal "" f) nil
(let ((dir (file-name-as-directory f)))
- (when (file-name-absolute-p dir)
- ;; Expand "~".
- (setq dir (expand-file-name dir)))
;; Previous implementation used `substitute-in-file-name'
;; which collapse multiple "/" in front. Do the same for
;; backward compatibility.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index a612c0617d3..db93250b17b 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -206,24 +206,24 @@ form.")
"Test for https://debbugs.gnu.org/21454 ."
(let ((input-result
(if (memq system-type '(windows-nt ms-dos))
- '(("x:/foo/bar//baz/;y:/bar/foo/baz//" nil
- ("x:/foo/bar/baz/" "y:/bar/foo/baz/"))
+ '(("/foo/bar//baz/;/bar/foo/baz//" nil
+ ("/foo/bar//baz/" "/bar/foo/baz//"))
("x:/foo/bar/;y:/bar/qux/;z:/qux/foo" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x://foo/bar/;y:/bar/qux/;z:/qux/foo/" nil
- ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x://foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo/bar/;y:/bar/qux/;z:/qux/foo/" nil
("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo//bar/;y:/bar/qux/;z:/qux/foo/" nil
- ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo//bar/;y:/bar/qux/;z:/qux/foo" nil
- ("x:/foo/bar/" "y:/bar/qux/" "z:/qux/foo/"))
+ ("x:/foo//bar/" "y:/bar/qux/" "z:/qux/foo/"))
("x:/foo/bar" "$FOO/baz/;z:/qux/foo/"
("x:/foo/bar/baz/" "z:/qux/foo/"))
- ("x://foo/bar/" "$FOO/baz/;z:/qux/foo/"
- ("x:/foo/bar/baz/" "z:/qux/foo/")))
+ ("//foo/bar/" "$FOO/baz/;/qux/foo/"
+ ("/foo/bar//baz/" "/qux/foo/")))
'(("/foo/bar//baz/:/bar/foo/baz//" nil
- ("/foo/bar/baz/" "/bar/foo/baz/"))
+ ("/foo/bar//baz/" "/bar/foo/baz//"))
("/foo/bar/:/bar/qux/:/qux/foo" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("//foo/bar/:/bar/qux/:/qux/foo/" nil
@@ -231,11 +231,11 @@ form.")
("/foo/bar/:/bar/qux/:/qux/foo/" nil
("/foo/bar/" "/bar/qux/" "/qux/foo/"))
("/foo//bar/:/bar/qux/:/qux/foo/" nil
- ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
("/foo//bar/:/bar/qux/:/qux/foo" nil
- ("/foo/bar/" "/bar/qux/" "/qux/foo/"))
+ ("/foo//bar/" "/bar/qux/" "/qux/foo/"))
("/foo/bar" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/"))
- ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar/baz/" "/qux/foo/")))))
+ ("//foo/bar/" "$FOO/baz/:/qux/foo/" ("/foo/bar//baz/" "/qux/foo/")))))
(foo-env (getenv "FOO"))
(bar-env (getenv "BAR")))
(unwind-protect
@@ -1459,14 +1459,11 @@ See <https://debbugs.gnu.org/36401>."
(ert-deftest files-colon-path ()
(if (memq system-type '(windows-nt ms-dos))
(should (equal (parse-colon-path "x:/foo//bar/baz")
- '("x:/foo/bar/baz/")))
+ '("x:/foo//bar/baz/")))
(should (equal (parse-colon-path "/foo//bar/baz")
- '("/foo/bar/baz/"))))
- (let* ((path (concat "." path-separator "/tmp"))
- (parsed-path (parse-colon-path path))
- (name-start (if (memq system-type '(windows-nt ms-dos)) 2)))
- (should (equal (car parsed-path) "./"))
- (should (equal (substring (cadr parsed-path) name-start) "/tmp/"))))
+ '("/foo//bar/baz/"))))
+ (should (equal (parse-colon-path (concat "." path-separator "/tmp"))
+ '("./" "/tmp/"))))
(ert-deftest files-test-magic-mode-alist-doctype ()
"Test that DOCTYPE and variants put files in mhtml-mode."
--
cgit v1.2.3
From 3b7b181bded1bddb2505eda1224a5631cbf04c1b Mon Sep 17 00:00:00 2001
From: Mattias EngdegÄrd <mattiase@acm.org>
Date: Mon, 9 Aug 2021 11:20:00 +0200
Subject: Use string-search instead of string-match[-p]
`string-search` is easier to understand, less error-prone, much
faster, does not pollute the regexp cache, and does not mutate global
state. Use it where applicable and obviously safe (erring on the
conservative side).
* admin/authors.el (authors-canonical-file-name)
(authors-scan-change-log):
* lisp/apropos.el (apropos-command)
(apropos-documentation-property, apropos-symbols-internal):
* lisp/arc-mode.el (archive-arc-summarize)
(archive-zoo-summarize):
* lisp/calc/calc-aent.el (math-read-factor):
* lisp/calc/calc-ext.el (math-read-big-expr)
(math-format-nice-expr, math-format-number-fancy):
* lisp/calc/calc-forms.el (math-read-angle-brackets):
* lisp/calc/calc-graph.el (calc-graph-set-range):
* lisp/calc/calc-keypd.el (calc-keypad-press):
* lisp/calc/calc-lang.el (tex, latex, math-read-big-rec):
* lisp/calc/calc-prog.el (calc-fix-token-name)
(calc-user-define-permanent, math-define-exp):
* lisp/calc/calc.el (calc-record, calcDigit-key)
(calc-count-lines):
* lisp/calc/calcalg2.el (calc-solve-for, calc-poly-roots)
(math-do-integral):
* lisp/calc/calcalg3.el (calc-find-root, calc-find-minimum)
(calc-get-fit-variables):
* lisp/cedet/ede/speedbar.el (ede-tag-expand):
* lisp/cedet/semantic/java.el (semantic-java-expand-tag):
* lisp/cedet/semantic/sb.el (semantic-sb-show-extra)
(semantic-sb-expand-group):
* lisp/cedet/semantic/wisent/python.el
(semantic-python-instance-variable-p):
* lisp/cus-edit.el (get):
* lisp/descr-text.el (describe-text-sexp):
* lisp/dired-aux.el (dired-compress-file):
* lisp/dired-x.el (dired-make-relative-symlink):
* lisp/dired.el (dired-glob-regexp):
* lisp/dos-fns.el (dos-convert-standard-filename, dos-8+3-filename):
* lisp/edmacro.el (edmacro-format-keys):
* lisp/emacs-lisp/eieio-opt.el (eieio-sb-expand):
* lisp/emacs-lisp/eieio-speedbar.el (eieio-speedbar-object-expand):
* lisp/emacs-lisp/lisp-mnt.el (lm-keywords-list):
* lisp/emacs-lisp/warnings.el (display-warning):
* lisp/emulation/viper-ex.el (viper-ex-read-file-name)
(ex-print-display-lines):
* lisp/env.el (read-envvar-name, setenv):
* lisp/epa-mail.el (epa-mail-encrypt):
* lisp/epg.el (epg--start):
* lisp/erc/erc-backend.el (erc-parse-server-response):
* lisp/erc/erc-dcc.el (erc-dcc-member):
* lisp/erc/erc-speedbar.el (erc-speedbar-expand-server)
(erc-speedbar-expand-channel, erc-speedbar-expand-user):
* lisp/erc/erc.el (erc-send-input):
* lisp/eshell/em-glob.el (eshell-glob-entries):
* lisp/eshell/esh-proc.el (eshell-needs-pipe-p):
* lisp/eshell/esh-util.el (eshell-convert):
* lisp/eshell/esh-var.el (eshell-envvar-names):
* lisp/faces.el (x-resolve-font-name):
* lisp/ffap.el (ffap-file-at-point):
* lisp/files.el (wildcard-to-regexp, shell-quote-wildcard-pattern):
* lisp/forms.el (forms--update):
* lisp/frameset.el (frameset-filter-unshelve-param):
* lisp/gnus/gnus-art.el (article-decode-charset):
* lisp/gnus/gnus-kill.el (gnus-kill-parse-rn-kill-file):
* lisp/gnus/gnus-mlspl.el (gnus-group-split-fancy):
* lisp/gnus/gnus-msg.el (gnus-summary-resend-message-insert-gcc)
(gnus-inews-insert-gcc):
* lisp/gnus/gnus-rfc1843.el (rfc1843-decode-article-body):
* lisp/gnus/gnus-search.el (gnus-search-indexed-parse-output)
(gnus-search--complete-key-data):
* lisp/gnus/gnus-spec.el (gnus-parse-simple-format):
* lisp/gnus/gnus-sum.el (gnus-summary-refer-article):
* lisp/gnus/gnus-util.el (gnus-extract-address-components)
(gnus-newsgroup-directory-form):
* lisp/gnus/gnus-uu.el (gnus-uu-grab-view):
* lisp/gnus/gnus.el (gnus-group-native-p, gnus-short-group-name):
* lisp/gnus/message.el (message-check-news-header-syntax)
(message-make-message-id, message-user-mail-address)
(message-make-fqdn, message-get-reply-headers, message-followup):
* lisp/gnus/mm-decode.el (mm-dissect-buffer):
* lisp/gnus/nnheader.el (nnheader-insert):
* lisp/gnus/nnimap.el (nnimap-process-quirk)
(nnimap-imap-ranges-to-gnus-ranges):
* lisp/gnus/nnmaildir.el (nnmaildir--ensure-suffix):
* lisp/gnus/nnmairix.el (nnmairix-determine-original-group-from-path):
* lisp/gnus/nnrss.el (nnrss-match-macro):
* lisp/gnus/nntp.el (nntp-find-group-and-number):
* lisp/help-fns.el (help--symbol-completion-table-affixation):
* lisp/help.el (help-function-arglist):
* lisp/hippie-exp.el (he-concat-directory-file-name):
* lisp/htmlfontify.el (hfy-relstub):
* lisp/ido.el (ido-make-prompt, ido-complete, ido-copy-current-word)
(ido-exhibit):
* lisp/image/image-converter.el (image-convert-p):
* lisp/info-xref.el (info-xref-docstrings):
* lisp/info.el (Info-toc-build, Info-follow-reference)
(Info-backward-node, Info-finder-find-node)
(Info-speedbar-expand-node):
* lisp/international/mule-diag.el (print-fontset-element):
* lisp/language/korea-util.el (default-korean-keyboard):
* lisp/linum.el (linum-after-change):
* lisp/mail/ietf-drums.el (ietf-drums-parse-address):
* lisp/mail/mail-utils.el (mail-dont-reply-to):
* lisp/mail/rfc2047.el (rfc2047-encode-1, rfc2047-decode-string):
* lisp/mail/rfc2231.el (rfc2231-parse-string):
* lisp/mail/rmailkwd.el (rmail-set-label):
* lisp/mail/rmailsum.el (rmail-header-summary):
* lisp/mail/smtpmail.el (smtpmail-maybe-append-domain)
(smtpmail-user-mail-address):
* lisp/mail/uce.el (uce-reply-to-uce):
* lisp/man.el (Man-default-man-entry):
* lisp/mh-e/mh-alias.el (mh-alias-gecos-name)
(mh-alias-minibuffer-confirm-address):
* lisp/mh-e/mh-comp.el (mh-forwarded-letter-subject):
* lisp/mh-e/mh-speed.el (mh-speed-parse-flists-output):
* lisp/mh-e/mh-utils.el (mh-collect-folder-names-filter)
(mh-folder-completion-function):
* lisp/minibuffer.el (completion--make-envvar-table)
(completion-file-name-table, completion-flex-try-completion)
(completion-flex-all-completions):
* lisp/mpc.el (mpc--proc-quote-string, mpc-cmd-special-tag-p)
(mpc-constraints-tag-lookup):
* lisp/net/ange-ftp.el (ange-ftp-send-cmd)
(ange-ftp-allow-child-lookup):
* lisp/net/mailcap.el (mailcap-mime-types):
* lisp/net/mairix.el (mairix-search-thread-this-article):
* lisp/net/pop3.el (pop3-open-server):
* lisp/net/soap-client.el (soap-decode-xs-complex-type):
* lisp/net/socks.el (socks-filter):
* lisp/nxml/nxml-outln.el (nxml-highlighted-qname):
* lisp/nxml/rng-cmpct.el (rng-c-expand-name, rng-c-expand-datatype):
* lisp/nxml/rng-uri.el (rng-uri-file-name-1):
* lisp/obsolete/complete.el (partial-completion-mode)
(PC-do-completion):
* lisp/obsolete/longlines.el (longlines-encode-string):
* lisp/obsolete/nnir.el (nnir-compose-result):
* lisp/obsolete/terminal.el (te-quote-arg-for-sh):
* lisp/obsolete/tpu-edt.el (tpu-check-search-case):
* lisp/obsolete/url-ns.el (isPlainHostName):
* lisp/pcmpl-unix.el (pcomplete/scp):
* lisp/play/dunnet.el (dun-listify-string2, dun-get-path)
(dun-unix-parse, dun-doassign, dun-cat, dun-batch-unix-interface):
* lisp/progmodes/ebnf2ps.el: (ebnf-eps-header-footer-comment):
* lisp/progmodes/gdb-mi.el (gdb-var-delete)
(gdb-speedbar-expand-node, gdbmi-bnf-incomplete-record-result):
* lisp/progmodes/gud.el (gud-find-expr):
* lisp/progmodes/idlw-help.el (idlwave-do-context-help1):
* lisp/progmodes/idlw-shell.el (idlwave-shell-mode)
(idlwave-shell-filter-hidden-output, idlwave-shell-filter):
* lisp/progmodes/idlwave.el (idlwave-skip-label-or-case)
(idlwave-routine-info):
* lisp/progmodes/octave.el (inferior-octave-completion-at-point):
* lisp/progmodes/sh-script.el (sh-add-completer):
* lisp/progmodes/sql.el (defun):
* lisp/progmodes/xscheme.el (xscheme-process-filter):
* lisp/replace.el (query-replace-compile-replacement)
(map-query-replace-regexp):
* lisp/shell.el (shell--command-completion-data)
(shell-environment-variable-completion):
* lisp/simple.el (display-message-or-buffer):
* lisp/speedbar.el (speedbar-dired, speedbar-tag-file)
(speedbar-tag-expand):
* lisp/subr.el (split-string-and-unquote):
* lisp/tar-mode.el (tar-extract):
* lisp/term.el (term-command-hook, serial-read-name):
* lisp/textmodes/bibtex.el (bibtex-print-help-message):
* lisp/textmodes/ispell.el (ispell-lookup-words, ispell-filter)
(ispell-parse-output, ispell-buffer-local-parsing):
* lisp/textmodes/reftex-cite.el (reftex-do-citation):
* lisp/textmodes/reftex-parse.el (reftex-notice-new):
* lisp/textmodes/reftex-ref.el (reftex-show-entry):
* lisp/textmodes/reftex.el (reftex-compile-variables):
* lisp/textmodes/tex-mode.el (tex-send-command)
(tex-start-tex, tex-append):
* lisp/thingatpt.el (thing-at-point-url-at-point):
* lisp/tmm.el (tmm-add-one-shortcut):
* lisp/transient.el (transient-format-key):
* lisp/url/url-auth.el (url-basic-auth)
(url-digest-auth-directory-id-assoc):
* lisp/url/url-news.el (url-news):
* lisp/url/url-util.el (url-parse-query-string):
* lisp/vc/vc-cvs.el (vc-cvs-parse-entry):
* lisp/wid-browse.el (widget-browse-sexp):
* lisp/woman.el (woman-parse-colon-path, woman-mini-help)
(WoMan-getpage-in-background, woman-negative-vertical-space):
* lisp/xml.el:
* test/lisp/emacs-lisp/check-declare-tests.el
(check-declare-tests-warn):
* test/lisp/files-tests.el
(files-tests-file-name-non-special-dired-compress-handler):
* test/lisp/net/network-stream-tests.el (server-process-filter):
* test/src/coding-tests.el (ert-test-unibyte-buffer-dos-eol-decode):
Use `string-search` instead of `string-match` and `string-match-p`.
---
admin/authors.el | 4 ++--
lisp/apropos.el | 8 ++++----
lisp/arc-mode.el | 4 ++--
lisp/calc/calc-aent.el | 4 ++--
lisp/calc/calc-ext.el | 6 +++---
lisp/calc/calc-forms.el | 2 +-
lisp/calc/calc-graph.el | 2 +-
lisp/calc/calc-keypd.el | 2 +-
lisp/calc/calc-lang.el | 8 ++++----
lisp/calc/calc-prog.el | 8 ++++----
lisp/calc/calc.el | 6 +++---
lisp/calc/calcalg2.el | 6 +++---
lisp/calc/calcalg3.el | 6 +++---
lisp/cedet/ede/speedbar.el | 4 ++--
lisp/cedet/semantic/java.el | 2 +-
lisp/cedet/semantic/sb.el | 8 ++++----
lisp/cedet/semantic/wisent/python.el | 2 +-
lisp/cus-edit.el | 2 +-
lisp/descr-text.el | 2 +-
lisp/dired-aux.el | 2 +-
lisp/dired-x.el | 6 +++---
lisp/dired.el | 2 +-
lisp/dos-fns.el | 12 ++++++------
lisp/edmacro.el | 2 +-
lisp/emacs-lisp/eieio-opt.el | 4 ++--
lisp/emacs-lisp/eieio-speedbar.el | 4 ++--
lisp/emacs-lisp/lisp-mnt.el | 2 +-
lisp/emacs-lisp/warnings.el | 2 +-
lisp/emulation/viper-ex.el | 6 +++---
lisp/env.el | 4 ++--
lisp/epa-mail.el | 2 +-
lisp/epg.el | 2 +-
lisp/erc/erc-backend.el | 10 +++++-----
lisp/erc/erc-dcc.el | 2 +-
lisp/erc/erc-speedbar.el | 12 ++++++------
lisp/erc/erc.el | 2 +-
lisp/eshell/em-glob.el | 2 +-
lisp/eshell/esh-proc.el | 2 +-
lisp/eshell/esh-util.el | 2 +-
lisp/eshell/esh-var.el | 2 +-
lisp/faces.el | 2 +-
lisp/ffap.el | 2 +-
lisp/files.el | 4 ++--
lisp/forms.el | 2 +-
lisp/frameset.el | 2 +-
lisp/gnus/gnus-art.el | 2 +-
lisp/gnus/gnus-kill.el | 2 +-
lisp/gnus/gnus-mlspl.el | 2 +-
lisp/gnus/gnus-msg.el | 10 +++++-----
lisp/gnus/gnus-rfc1843.el | 2 +-
lisp/gnus/gnus-search.el | 4 ++--
lisp/gnus/gnus-spec.el | 2 +-
lisp/gnus/gnus-sum.el | 2 +-
lisp/gnus/gnus-util.el | 4 ++--
lisp/gnus/gnus-uu.el | 2 +-
lisp/gnus/gnus.el | 8 ++++----
lisp/gnus/message.el | 26 +++++++++++++-------------
lisp/gnus/mm-decode.el | 2 +-
lisp/gnus/nnheader.el | 2 +-
lisp/gnus/nnimap.el | 4 ++--
lisp/gnus/nnmaildir.el | 2 +-
lisp/gnus/nnmairix.el | 2 +-
lisp/gnus/nnrss.el | 2 +-
lisp/gnus/nntp.el | 4 ++--
lisp/help-fns.el | 2 +-
lisp/help.el | 2 +-
lisp/hippie-exp.el | 4 ++--
lisp/htmlfontify.el | 2 +-
lisp/ido.el | 10 +++++-----
lisp/image/image-converter.el | 2 +-
lisp/info-xref.el | 2 +-
lisp/info.el | 12 ++++++------
lisp/international/mule-diag.el | 4 ++--
lisp/language/korea-util.el | 2 +-
lisp/linum.el | 2 +-
lisp/mail/ietf-drums.el | 2 +-
lisp/mail/mail-utils.el | 2 +-
lisp/mail/rfc2047.el | 4 ++--
lisp/mail/rfc2231.el | 6 +++---
lisp/mail/rmailkwd.el | 2 +-
lisp/mail/rmailsum.el | 2 +-
lisp/mail/smtpmail.el | 4 ++--
lisp/mail/uce.el | 8 ++++----
lisp/man.el | 2 +-
lisp/mh-e/mh-alias.el | 6 +++---
lisp/mh-e/mh-comp.el | 4 ++--
lisp/mh-e/mh-speed.el | 2 +-
lisp/mh-e/mh-utils.el | 4 ++--
lisp/minibuffer.el | 8 ++++----
lisp/mpc.el | 6 +++---
lisp/net/ange-ftp.el | 6 +++---
lisp/net/mailcap.el | 2 +-
lisp/net/mairix.el | 2 +-
lisp/net/pop3.el | 4 ++--
lisp/net/soap-client.el | 2 +-
lisp/net/socks.el | 2 +-
lisp/nxml/nxml-outln.el | 2 +-
lisp/nxml/rng-cmpct.el | 4 ++--
lisp/nxml/rng-uri.el | 4 ++--
lisp/obsolete/complete.el | 4 ++--
lisp/obsolete/longlines.el | 4 ++--
lisp/obsolete/nnir.el | 2 +-
lisp/obsolete/terminal.el | 2 +-
lisp/obsolete/tpu-edt.el | 6 +++---
lisp/obsolete/url-ns.el | 2 +-
lisp/pcmpl-unix.el | 2 +-
lisp/play/dunnet.el | 18 +++++++++---------
lisp/progmodes/ebnf2ps.el | 2 +-
lisp/progmodes/gdb-mi.el | 8 ++++----
lisp/progmodes/gud.el | 2 +-
lisp/progmodes/idlw-help.el | 2 +-
lisp/progmodes/idlw-shell.el | 10 +++++-----
lisp/progmodes/idlwave.el | 8 ++++----
lisp/progmodes/octave.el | 2 +-
lisp/progmodes/sh-script.el | 2 +-
lisp/progmodes/sql.el | 2 +-
lisp/progmodes/xscheme.el | 4 ++--
lisp/replace.el | 8 ++++----
lisp/shell.el | 4 ++--
lisp/simple.el | 4 ++--
lisp/speedbar.el | 12 ++++++------
lisp/subr.el | 2 +-
lisp/tar-mode.el | 2 +-
lisp/term.el | 6 +++---
lisp/textmodes/bibtex.el | 2 +-
lisp/textmodes/ispell.el | 10 +++++-----
lisp/textmodes/reftex-cite.el | 2 +-
lisp/textmodes/reftex-parse.el | 2 +-
lisp/textmodes/reftex-ref.el | 2 +-
lisp/textmodes/reftex.el | 2 +-
lisp/textmodes/tex-mode.el | 6 +++---
lisp/thingatpt.el | 2 +-
lisp/tmm.el | 2 +-
lisp/transient.el | 2 +-
lisp/url/url-auth.el | 8 ++++----
lisp/url/url-news.el | 2 +-
lisp/url/url-util.el | 2 +-
lisp/vc/vc-cvs.el | 2 +-
lisp/wid-browse.el | 2 +-
lisp/woman.el | 10 +++++-----
lisp/xml.el | 4 ++--
test/lisp/emacs-lisp/check-declare-tests.el | 10 +++++-----
test/lisp/files-tests.el | 2 +-
test/lisp/net/network-stream-tests.el | 2 +-
test/src/coding-tests.el | 2 +-
145 files changed, 299 insertions(+), 299 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/admin/authors.el b/admin/authors.el
index a400b1327af..b4e6c934b67 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -1330,7 +1330,7 @@ to print a message if FILE is not found."
(unless (or valid
(member file authors-ignored-files)
(authors-obsolete-file-p file)
- (string-match "[*]" file)
+ (string-search "*" file)
(string-match "^[0-9.]+$" file)
laxlog)
(setq authors-invalid-file-names
@@ -1465,7 +1465,7 @@ Suggested\\|Trivial\\|Version\\|Originally\\|From:\\|Patch[ \t]+[Bb]y\\)")))
((looking-at "^[ \t]+\\*")
(let ((line (buffer-substring-no-properties
(match-end 0) (line-end-position))))
- (while (and (not (string-match ":" line))
+ (while (and (not (string-search ":" line))
(forward-line 1)
(not (looking-at ":\\|^[ \t]*$")))
(setq line (concat line
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 376c1b2cbc5..a1470537d9a 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -616,7 +616,7 @@ while a list of strings is used as a word list."
(if (eq doc 'error)
"(documentation error)"
(setq score (+ score (apropos-score-doc doc)))
- (substring doc 0 (string-match "\n" doc)))
+ (substring doc 0 (string-search "\n" doc)))
"(not documented)")))
(and var-predicate
(funcall var-predicate symbol)
@@ -625,7 +625,7 @@ while a list of strings is used as a word list."
(progn
(setq score (+ score (apropos-score-doc doc)))
(substring doc 0
- (string-match "\n" doc)))))))
+ (string-search "\n" doc)))))))
(setcar (cdr (car p)) score)
(setq p (cdr p))))
(and (let ((apropos-multi-type do-all))
@@ -639,7 +639,7 @@ while a list of strings is used as a word list."
"Like (documentation-property SYMBOL PROPERTY RAW) but handle errors."
(condition-case ()
(let ((doc (documentation-property symbol property raw)))
- (if doc (substring doc 0 (string-match "\n" doc))
+ (if doc (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(error "(error retrieving documentation)")))
@@ -767,7 +767,7 @@ the output includes key-bindings of commands."
"(alias for undefined function)")
(error
"(can't retrieve function documentation)")))
- (substring doc 0 (string-match "\n" doc))
+ (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(when (boundp symbol)
(apropos-documentation-property
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 83c516100ab..71ad7bd0c5d 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -1707,7 +1707,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(= (get-byte p) ?\C-z)
(> (get-byte (1+ p)) 0))
(let* ((namefld (buffer-substring (+ p 2) (+ p 2 13)))
- (fnlen (or (string-match "\0" namefld) 13))
+ (fnlen (or (string-search "\0" namefld) 13))
(efnname (decode-coding-string (substring namefld 0 fnlen)
archive-file-name-coding-system))
(csize (archive-l-e (+ p 15) 4))
@@ -2089,7 +2089,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
(dirtype (get-byte (+ p 4)))
(lfnlen (if (= dirtype 2) (get-byte (+ p 56)) 0))
(ldirlen (if (= dirtype 2) (get-byte (+ p 57)) 0))
- (fnlen (or (string-match "\0" namefld) 13))
+ (fnlen (or (string-search "\0" namefld) 13))
(efnname (let ((str
(concat
(if (> ldirlen 0)
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 1e31c3cadc0..db4751a9fbb 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -1139,7 +1139,7 @@ If the current Calc language does not use placeholders, return nil."
0)
(setq sym (intern (substring (symbol-name sym)
1))))
- (or (string-match "-" (symbol-name sym))
+ (or (string-search "-" (symbol-name sym))
(setq sym (intern
(concat "calcFunc-"
(symbol-name sym))))))
@@ -1149,7 +1149,7 @@ If the current Calc language does not use placeholders, return nil."
(let ((val (list 'var
(intern (math-remove-dashes
(symbol-name sym)))
- (if (string-match "-" (symbol-name sym))
+ (if (string-search "-" (symbol-name sym))
sym
(intern (concat "var-"
(symbol-name sym)))))))
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index e85ecf03906..45337e187be 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -3088,7 +3088,7 @@ If X is not an error form, return 1."
(math-read-big-err-msg nil)
math-read-big-baseline math-read-big-h2
new-pos p)
- (while (setq new-pos (string-match "\n" str pos))
+ (while (setq new-pos (string-search "\n" str pos))
(setq math-read-big-lines
(cons (substring str pos new-pos) math-read-big-lines)
pos (1+ new-pos)))
@@ -3249,7 +3249,7 @@ If X is not an error form, return 1."
(t
(let ((str (math-format-flat-expr x 0))
(pos 0) p)
- (or (string-match "\"" str)
+ (or (string-search "\"" str)
(while (<= (setq p (+ pos w)) (length str))
(while (and (> (setq p (1- p)) pos)
(not (= (aref str p) ? ))))
@@ -3278,7 +3278,7 @@ If X is not an error form, return 1."
(math-format-radix-float a prec))
(format "%d#%s" calc-number-radix
(math-format-radix-float a prec)))))
- (if (and prec (> prec 191) (string-match "\\*" str))
+ (if (and prec (> prec 191) (string-search "*" str))
(concat "(" str ")")
str))))
((eq (car a) 'frac)
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index ee53b94cd64..ac57011da04 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -2238,7 +2238,7 @@ and ends on the last Sunday of October at 2 a.m."
(if (eq (car-safe str2) 'error)
str2
(append '(calcFunc-lambda) (cdr str1) (list str2)))))
- (if (string-match "#" str)
+ (if (string-search "#" str)
(let ((calc-hashes-used 0))
(and (setq str (math-read-expr str))
(if (eq (car-safe str) 'error)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index 423d1e64126..9ac24bf1889 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1025,7 +1025,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(calc-pop-stack 1))))
(if (string-match "\\[.+\\]" range)
(setq range (substring range 1 -1)))
- (if (and (not (string-match ":" range))
+ (if (and (not (string-search ":" range))
(or (string-match "," range)
(string-match " " range)))
(aset range (match-beginning 0) ?\:))
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index 1902a4f3f29..acbef27a1da 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -481,7 +481,7 @@
":"
(if (and (equal cmd "e")
(or (not input)
- (string-match
+ (string-search
"#" input))
(> radix 14))
(format "*%d.^" radix)
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index 0117f449dd5..aef3173f5c0 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -660,7 +660,7 @@
(setq math-exp-pos (match-end 0)
math-exp-token 'punc
math-expr-data "[")
- (let ((right (string-match "}" math-exp-str math-exp-pos)))
+ (let ((right (string-search "}" math-exp-str math-exp-pos)))
(and right
(setq math-exp-str (copy-sequence math-exp-str))
(aset math-exp-str right ?\]))))))))))
@@ -899,7 +899,7 @@
(setq math-exp-pos (match-end 0)
math-exp-token 'punc
math-expr-data "[")
- (let ((right (string-match "}" math-exp-str math-exp-pos)))
+ (let ((right (string-search "}" math-exp-str math-exp-pos)))
(and right
(setq math-exp-str (copy-sequence math-exp-str))
(aset math-exp-str right ?\]))))))))))
@@ -2342,7 +2342,7 @@ order to Calc's."
(math-read-big-emptyp math-rb-h1 (1+ v) h math-rb-v2 nil t)
(if (= (math-read-big-char widest v) ?\()
(progn
- (setq line (if (string-match "-" p)
+ (setq line (if (string-search "-" p)
(intern p)
(intern (concat "calcFunc-" p)))
h (1+ widest)
@@ -2362,7 +2362,7 @@ order to Calc's."
(setq p (cons line (nreverse p))))
(setq p (list 'var
(intern (math-remove-dashes p))
- (if (string-match "-" p)
+ (if (string-search "-" p)
(intern p)
(intern (concat "var-" p)))))))
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 6f1e5c782df..f9dd9eb98a9 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -604,7 +604,7 @@
((equal name "#")
(search-backward "#")
(error "Token `#' is reserved"))
- ((and unquoted (string-match "#" name))
+ ((and unquoted (string-search "#" name))
(error "Tokens containing `#' must be quoted"))
((not (string-match "[^ ]" name))
(search-backward "\"" nil t)
@@ -1068,7 +1068,7 @@ Redefine the corresponding command."
(insert (setq str (prin1-to-string
(cons 'defun (cons cmd (cdr fcmd)))))
"\n")
- (or (and (string-match "\"" str) (not q-ok))
+ (or (and (string-search "\"" str) (not q-ok))
(fill-region pt (point)))
(indent-rigidly pt (point) 2)
(delete-region pt (1+ pt))
@@ -1087,7 +1087,7 @@ Redefine the corresponding command."
(cons 'defun (cons func
(cdr ffunc)))))
"\n")
- (or (and (string-match "\"" str) (not q-ok))
+ (or (and (string-search "\"" str) (not q-ok))
(fill-region pt (point)))
(indent-rigidly pt (point) 2)
(delete-region pt (1+ pt))
@@ -2132,7 +2132,7 @@ Redefine the corresponding command."
(cdr prim))
((memq exp math-exp-env)
exp)
- ((string-match "-" name)
+ ((string-search "-" name)
exp)
(t
(intern (concat "var-" name))))))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 1e7d5e7766c..a10b3178302 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -2126,7 +2126,7 @@ the United States."
(goto-char (point-max))
(cond ((null prefix) (insert " "))
((and (> (length prefix) 4)
- (string-match " " prefix 4))
+ (string-search " " prefix 4))
(insert (substring prefix 0 4) " "))
(t (insert (format "%4s " prefix))))
(insert fval "\n")
@@ -2469,7 +2469,7 @@ the United States."
(calc-minibuffer-contains
"[-+]?\\(.*\\+/- *\\|.*mod *\\)?\\([0-9]+\\.?0*[@oh] *\\)?\\([0-9]+\\.?0*['m] *\\)?[0-9]*\\(\\.?[0-9]*\\(e[-+]?[0-3]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\\)?\\|[0-9]:\\([0-9]+:\\)?[0-9]*\\)?[\"s]?\\'"))
(if (and (memq last-command-event '(?@ ?o ?h ?\' ?m))
- (string-match " " calc-hms-format))
+ (string-search " " calc-hms-format))
(insert " "))
(if (and (memq last-command '(calcDigit-start calcDigit-key))
(eq last-command-event ?.))
@@ -3059,7 +3059,7 @@ the United States."
(defun calc-count-lines (s)
(let ((pos 0)
(num 1))
- (while (setq pos (string-match "\n" s pos))
+ (while (setq pos (string-search "\n" s pos))
(setq pos (1+ pos)
num (1+ num)))
num))
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index 94b99aa29d8..8d93ae987a1 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -158,7 +158,7 @@
(calc-top-n 2)
(calc-top-n 1)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -175,7 +175,7 @@
(calc-top-n 2)
(calc-top-n 1)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -1028,7 +1028,7 @@
(fset 'calcFunc-integ math-old-integ))))
;; See if the function is a symbolic derivative.
- (and (string-match "'" (symbol-name (car expr)))
+ (and (string-search "'" (symbol-name (car expr)))
(let ((name (symbol-name (car expr)))
(p expr) (n 0) (which nil) (bad nil))
(while (setq n (1+ n) p (cdr p))
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index ee3ae0a4c1f..3cb1886f3bd 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -56,7 +56,7 @@
(calc-top-n 1)
(calc-top-n 2)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -81,7 +81,7 @@
(calc-top-n 1)
(calc-top-n 2)))
(let ((var (if (and (string-match ",\\|[^ ] +[^ ]" var)
- (not (string-match "\\[" var)))
+ (not (string-search "[" var)))
(math-read-expr (concat "[" var "]"))
(math-read-expr var))))
(if (eq (car-safe var) 'error)
@@ -490,7 +490,7 @@
defc)
",")))))
(coefs nil))
- (setq vars (if (string-match "\\[" vars)
+ (setq vars (if (string-search "[" vars)
(math-read-expr vars)
(math-read-expr (concat "[" vars "]"))))
(if (eq (car-safe vars) 'error)
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index 01d4f943df5..b321cb637bc 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -276,7 +276,7 @@ INDENT is the current indentation level."
Etags does not support this feature. TEXT will be the button
string. TOKEN will be the list, and INDENT is the current indentation
level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -284,7 +284,7 @@ level."
(speedbar-insert-generic-list indent token
'ede-tag-expand
'ede-tag-find))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index f48b835fe39..0c2fb843f0b 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -141,7 +141,7 @@ corresponding compound declaration."
(semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim)))
(semantic-tag-set-bounds clone start end)))
- ((and (eq class 'type) (string-match "\\." (semantic-tag-name tag)))
+ ((and (eq class 'type) (string-search "." (semantic-tag-name tag)))
;; javap outputs files where the package name is stuck onto the class or interface
;; name. To make this more regular, we extract the package name into a package statement,
;; then make the class name regular.
diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el
index debdfd1dc04..fe981d34fb7 100644
--- a/lisp/cedet/semantic/sb.el
+++ b/lisp/cedet/semantic/sb.el
@@ -279,7 +279,7 @@ Optional MODIFIERS is additional text needed for variables."
(defun semantic-sb-show-extra (text token indent)
"Display additional information about the token as an expansion.
TEXT TOKEN and INDENT are the details."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -288,7 +288,7 @@ TEXT TOKEN and INDENT are the details."
(narrow-to-region (point) (point))
;; Add in stuff specific to this type of token.
(semantic-sb-insert-details token (1+ indent))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -325,7 +325,7 @@ TEXT TOKEN and INDENT are the details."
(defun semantic-sb-expand-group (text token indent)
"Expand a group which has semantic tokens.
TEXT TOKEN and INDENT are the details."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -333,7 +333,7 @@ TEXT TOKEN and INDENT are the details."
(save-restriction
(narrow-to-region (point-min) (point))
(semantic-sb-buttons-plain (1+ indent) token)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el
index 9ac4ed9f518..fb878dde712 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -555,7 +555,7 @@ SELF or the instance name \"self\" if SELF is nil."
(rx-to-string
`(seq string-start ,(or self "self") "."))
name)
- (not (string-match "\\." (substring name 5)))))))
+ (not (string-search "." (substring name 5)))))))
(defun semantic-python-docstring-p (tag)
"Return non-nil, when TAG is a Python documentation string."
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 980a1cc7179..7eae2e416bb 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1910,7 +1910,7 @@ item in another window.\n\n"))
(widget-put (get 'editable-field 'widget-type)
:custom-show (lambda (_widget value)
(let ((pp (pp-to-string value)))
- (cond ((string-match-p "\n" pp)
+ (cond ((string-search "\n" pp)
nil)
((> (length pp) 40)
nil)
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 85017de5d5e..f5e467d37e7 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -50,7 +50,7 @@
(when (string-match-p "\n\\'" pp)
(setq pp (substring pp 0 (1- (length pp)))))
- (if (and (not (string-match-p "\n" pp))
+ (if (and (not (string-search "\n" pp))
(<= (length pp) (- (window-width) (current-column))))
(insert pp)
(insert-text-button
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 5dbd55849e9..0b8c693b29f 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1288,7 +1288,7 @@ Return nil if no change in files."
nil t)
nil t)))
;; We found an uncompression rule.
- (let ((match (string-match " " command))
+ (let ((match (string-search " " command))
(msg (concat "Uncompressing " file)))
(unless (if match
(dired-check-process msg
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index a990bd3fec3..380e47786fc 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -1044,11 +1044,11 @@ results in
len2 (length file2))
;; Find common initial file name components:
(let (next)
- (while (and (setq next (string-match "/" file1 index))
+ (while (and (setq next (string-search "/" file1 index))
(< (setq next (1+ next)) (min len1 len2))
;; For the comparison, both substrings must end in
;; `/', so NEXT is *one plus* the result of the
- ;; string-match.
+ ;; string-search.
;; E.g., consider the case of linking "/tmp/a/abc"
;; to "/tmp/abc" erroneously giving "/tmp/a" instead
;; of "/tmp/" as common initial component
@@ -1066,7 +1066,7 @@ results in
(start 0)
(count 0))
;; Count number of slashes we must compensate for ...
- (while (setq start (string-match "/" tem start))
+ (while (setq start (string-search "/" tem start))
(setq count (1+ count)
start (1+ start)))
;; ... and prepend a "../" for each slash found:
diff --git a/lisp/dired.el b/lisp/dired.el
index 816b8b69881..ff822506bf1 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2909,7 +2909,7 @@ dired-buffers."
(if (= (aref pattern (1+ set-start)) ?^)
(+ 3 set-start)
(+ 2 set-start)))
- (set-end (string-match-p "]" pattern set-cont))
+ (set-end (string-search "]" pattern set-cont))
(set (substring pattern set-start (1+ set-end))))
(setq regexp (concat regexp set))
(setq matched-in-pattern (1+ set-end))))
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 255edd0f371..e0a533c637a 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -86,7 +86,7 @@ sure to obey the 8.3 limitations."
;; close to the beginning, change that to a period. This
;; is so we could salvage more characters of the original
;; name by pushing them into the extension.
- (if (and (not (string-match "\\." string))
+ (if (and (not (string-search "." string))
(> (length string) 8)
;; We don't gain anything if we put the period closer
;; than 5 chars from the beginning (5 + 3 = 8).
@@ -100,21 +100,21 @@ sure to obey the 8.3 limitations."
;; If we don't have a period in the first 8 chars, insert one.
;; This enables having 3 more characters from the original
;; name in the extension.
- (if (> (or (string-match "\\." string) (length string))
+ (if (> (or (string-search "." string) (length string))
8)
(setq string
(concat (substring string 0 8)
"."
(substring string 8))))
- (setq firstdot (or (string-match "\\." string)
+ (setq firstdot (or (string-search "." string)
(1- (length string))))
;; Truncate to 3 chars after the first period.
(if (> (length string) (+ firstdot 4))
(setq string (substring string 0 (+ firstdot 4))))
;; Change all periods except the first one into underscores.
;; (DOS doesn't allow more than one period.)
- (while (string-match "\\." string (1+ firstdot))
- (setq i (string-match "\\." string (1+ firstdot)))
+ (while (string-search "." string (1+ firstdot))
+ (setq i (string-search "." string (1+ firstdot)))
(aset string i ?_))
;; If the last character of the original filename was `~' or `#',
;; make sure the munged name ends with it also. This is so that
@@ -160,7 +160,7 @@ sure to obey the 8.3 limitations."
(strlen (length string))
(lastchar (aref string (1- strlen)))
firstdot)
- (setq firstdot (string-match "\\." string))
+ (setq firstdot (string-search "." string))
(cond
(firstdot
;; Truncate the extension to 3 characters.
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 84de69a2ce1..9e4a71c336e 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -559,7 +559,7 @@ doubt, use whitespace."
(or fkey key) " "))))
(if prefix
(setq desc (concat (edmacro-sanitize-for-string prefix) desc)))
- (unless (string-match " " desc)
+ (unless (string-search " " desc)
(let ((times 1) (pos bind-len))
(while (not (cl-mismatch rest-mac rest-mac
:start1 0 :end1 bind-len
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 08a6debc203..9c842f46829 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -323,7 +323,7 @@ current expansion depth."
(defun eieio-sb-expand (text class indent)
"For button TEXT, expand CLASS at the current location.
Argument INDENT is the depth of indentation."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -332,7 +332,7 @@ Argument INDENT is the depth of indentation."
(while subclasses
(eieio-class-button (car subclasses) (1+ indent))
(setq subclasses (cdr subclasses)))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index 3f2a6537ab8..86b22cad73b 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -344,14 +344,14 @@ The object is at indentation level INDENT."
(defun eieio-speedbar-object-expand (text token indent)
"Expand object represented by TEXT.
TOKEN is the object. INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(oset token expanded t)
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(eieio-speedbar-expand token (1+ indent)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(oset token expanded nil)
(speedbar-delete-subblock indent))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 83da495edf0..d6a6a5f0442 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -458,7 +458,7 @@ each line."
"Return list of keywords given in file FILE."
(let ((keywords (lm-keywords file)))
(if keywords
- (if (string-match-p "," keywords)
+ (if (string-search "," keywords)
(split-string keywords ",[ \t\n]*" t "[ ]+")
(split-string keywords "[ \t\n]+" t "[ ]+")))))
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 67de690e67d..36b275e2d3c 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -307,7 +307,7 @@ entirely by setting `warning-suppress-types' or
'type 'warning-suppress-log-warning
'warning-type type))
(funcall newline)
- (when (and warning-fill-prefix (not (string-match "\n" message)))
+ (when (and warning-fill-prefix (not (string-search "\n" message)))
(let ((fill-prefix warning-fill-prefix)
(fill-column warning-fill-column))
(fill-region start (point))))
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 5b2fa048a09..55930e7e6bc 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1100,7 +1100,7 @@ reversed."
(setq viper-keep-reading-filename nil
val (read-file-name (concat prompt str) nil default-directory))
(setq val (expand-file-name val))
- (if (and (string-match " " val)
+ (if (and (string-search " " val)
(ex-cmd-accepts-multiple-files-p ex-token))
(setq val (concat "\"" val "\"")))
(setq str (concat str (if (equal val "") "" " ")
@@ -2300,10 +2300,10 @@ Type `mak ' (including the space) to run make with no args."
(defun ex-print-display-lines (lines)
(cond
;; String doesn't contain a newline.
- ((not (string-match "\n" lines))
+ ((not (string-search "\n" lines))
(message "%s" lines))
;; String contains only one newline at the end. Strip it off.
- ((= (string-match "\n" lines) (1- (length lines)))
+ ((= (string-search "\n" lines) (1- (length lines)))
(message "%s" (substring lines 0 -1)))
;; String spans more than one line. Use a temporary buffer.
(t
diff --git a/lisp/env.el b/lisp/env.el
index 51247f1ff84..83f43d1006b 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -44,7 +44,7 @@ If it is also not t, RET does not exit if it does non-null completion."
(completing-read prompt
(mapcar (lambda (enventry)
(let ((str (substring enventry 0
- (string-match "=" enventry))))
+ (string-search "=" enventry))))
(if (multibyte-string-p str)
(decode-coding-string
str locale-coding-system t)
@@ -184,7 +184,7 @@ a side-effect."
(setq variable (encode-coding-string variable locale-coding-system)))
(if (and value (multibyte-string-p value))
(setq value (encode-coding-string value locale-coding-system)))
- (if (string-match-p "=" variable)
+ (if (string-search "=" variable)
(error "Environment variable name `%s' contains `='" variable))
(if (string-equal "TZ" variable)
(set-time-zone-rule value))
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index bed0c065aea..b9dd437ed12 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -219,7 +219,7 @@ If no one is selected, symmetric encryption will be performed. "
(epa-mail--find-usable-key
(epg-list-keys
(epg-make-context epa-protocol)
- (if (string-match "@" recipient)
+ (if (string-search "@" recipient)
(concat "<" recipient ">")
recipient))
'encrypt)))
diff --git a/lisp/epg.el b/lisp/epg.el
index 36515ef4e5f..9d6295594fd 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -573,7 +573,7 @@ callback data (if any)."
"--status-fd" "1"
"--yes")
(if (and (not (eq (epg-context-protocol context) 'CMS))
- (string-match ":" (or agent-info "")))
+ (string-search ":" (or agent-info "")))
'("--use-agent"))
(if (and (not (eq (epg-context-protocol context) 'CMS))
(epg-context-progress-callback context))
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 7a17ee233fd..6d84665873e 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -950,15 +950,15 @@ PROCs `process-buffer' is `current-buffer' when this function is called."
(unless (string= string "") ;; Ignore empty strings
(save-match-data
(let* ((tag-list (when (eq (aref string 0) ?@)
- (substring string 1 (string-match " " string))))
+ (substring string 1 (string-search " " string))))
(msg (make-erc-response :unparsed string :tags (when tag-list
(erc-parse-tags
tag-list))))
(string (if tag-list
- (substring string (+ 1 (string-match " " string)))
+ (substring string (+ 1 (string-search " " string)))
string))
(posn (if (eq (aref string 0) ?:)
- (string-match " " string)
+ (string-search " " string)
0)))
(setf (erc-response.sender msg)
@@ -968,7 +968,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called."
(setf (erc-response.command msg)
(let* ((bposn (string-match "[^ \n]" string posn))
- (eposn (string-match " " string bposn)))
+ (eposn (string-search " " string bposn)))
(setq posn (and eposn
(string-match "[^ \n]" string eposn)))
(substring string bposn eposn)))
@@ -976,7 +976,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called."
(while (and posn
(not (eq (aref string posn) ?:)))
(push (let* ((bposn posn)
- (eposn (string-match " " string bposn)))
+ (eposn (string-search " " string bposn)))
(setq posn (and eposn
(string-match "[^ \n]" string eposn)))
(substring string bposn eposn))
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index fcdb8df2032..de72624aaa1 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -187,7 +187,7 @@ compared with `erc-nick-equal-p' which is IRC case-insensitive."
(plist-get elt prop)))
;; if the property exists and is equal, we continue, else, try the
;; next element of the list
- (or (and (eq prop :nick) (string-match "!" val)
+ (or (and (eq prop :nick) (string-search "!" val)
test (string-equal test val))
(and (eq prop :nick)
test val
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index bb858445235..e61e741302d 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -139,7 +139,7 @@ This will add a speedbar major display mode."
t))))
(defun erc-speedbar-expand-server (text server indent)
- (cond ((string-match "\\+" text)
+ (cond ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(if (speedbar-with-writable
(save-excursion
@@ -147,7 +147,7 @@ This will add a speedbar major display mode."
(erc-speedbar-channel-buttons nil (1+ indent) server)))
(speedbar-change-expand-button-char ?-)
(speedbar-change-expand-button-char ??)))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -184,7 +184,7 @@ This will add a speedbar major display mode."
"For the line matching TEXT, in CHANNEL, expand or contract a line.
INDENT is the current indentation level."
(cond
- ((string-match "\\+" text)
+ ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -233,7 +233,7 @@ INDENT is the current indentation level."
(speedbar-with-writable
(dolist (entry names)
(erc-speedbar-insert-user entry ?+ (1+ indent))))))))))
- ((string-match "-" text)
+ ((string-search "-" text)
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -284,7 +284,7 @@ The update is only done when the channel is actually expanded already."
(erc-speedbar-expand-channel "+" buffer 1)))))
(defun erc-speedbar-expand-user (text token indent)
- (cond ((string-match "\\+" text)
+ (cond ((string-search "+" text)
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
@@ -307,7 +307,7 @@ The update is only done when the channel is actually expanded already."
nil nil nil nil
info nil nil nil
(1+ indent)))))))
- ((string-match "-" text)
+ ((string-search "-" text)
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index c66b03d2e4e..73202016ba7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5587,7 +5587,7 @@ This returns non-nil only if we actually send anything."
(when (and (erc-input-sendp state)
erc-send-this)
(let ((string (erc-input-string state)))
- (if (or (string-match "\n" string)
+ (if (or (string-search "\n" string)
(not (string-match erc-command-regexp string)))
(mapc
(lambda (line)
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index 316094b17e4..e36f2d0c7fe 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -291,7 +291,7 @@ the form:
(let ((index 1))
(setq incl glob)
(while (and (eq incl glob)
- (setq index (string-match "~" glob index)))
+ (setq index (string-search "~" glob index)))
(if (or (get-text-property index 'escaped glob)
(or (= (1+ index) len)))
(setq index (1+ index))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 96c9a60deab..7a0b26a0658 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -266,7 +266,7 @@ See `eshell-needs-pipe'."
;; neither 'first nor 'last? See bug#1388 discussion.
(catch 'found
(dolist (exe eshell-needs-pipe)
- (if (string-equal exe (if (string-match "/" exe)
+ (if (string-equal exe (if (string-search "/" exe)
command
(file-name-nondirectory command)))
(throw 'found t))))))
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 30104816f07..72de6b13e2e 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -204,7 +204,7 @@ then quoting is done by a backslash, rather than a doubled delimiter."
string
(if (eq (aref string (1- len)) ?\n)
(setq string (substring string 0 (1- len))))
- (if (string-match "\n" string)
+ (if (string-search "\n" string)
(split-string string "\n")
(if (and eshell-convert-numeric-arguments
(string-match
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 9fccc6b1c9d..5dc6a193050 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -381,7 +381,7 @@ This function is explicit for adding to `eshell-parse-argument-hook'."
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
(mapcar (lambda (x)
- (substring x 0 (string-match "=" x)))
+ (substring x 0 (string-search "=" x)))
(or environment process-environment)))
(defun eshell-environment-variables ()
diff --git a/lisp/faces.el b/lisp/faces.el
index 4bb3a2b00fc..a3a6f1b78dd 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -3062,7 +3062,7 @@ also the same size as FACE on FRAME, or fail."
(let ((fonts (x-list-fonts pattern face frame 1)))
(or fonts
(if face
- (if (string-match-p "\\*" pattern)
+ (if (string-search "*" pattern)
(if (null (face-font face))
(error "No matching fonts are the same height as the frame default font")
(error "No matching fonts are the same height as face `%s'" face))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 9be9c2906ea..0069af25974 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1418,7 +1418,7 @@ which may actually result in an URL rather than a filename."
(string (ffap-string-at-point)) ; uses mode alist
(name
(or (condition-case nil
- (and (not (string-match "//" string)) ; foo.com://bar
+ (and (not (string-search "//" string)) ; foo.com://bar
(substitute-in-file-name string))
(error nil))
string))
diff --git a/lisp/files.el b/lisp/files.el
index 54d0b919e1d..6c366177ce8 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6979,7 +6979,7 @@ by `sh' are supported."
(prog1 ; copy everything upto next `]'.
(substring wildcard
i
- (setq j (string-match
+ (setq j (string-search
"]" wildcard i)))
(setq i (if j (1- j) (1- len)))))))
((eq ch ?.) "\\.")
@@ -7105,7 +7105,7 @@ need to be passed verbatim to shell commands."
;; DOS/Windows don't allow `"' in file names. So if the
;; argument has quotes, we can safely assume it is already
;; quoted by the caller.
- (if (or (string-match "[\"]" pattern)
+ (if (or (string-search "\"" pattern)
;; We quote [&()#$`'] in case their shell is a port of a
;; Unixy shell. We quote [,=+] because stock DOS and
;; Windows shells require that in some cases, such as
diff --git a/lisp/forms.el b/lisp/forms.el
index 8696aea98ee..46f4df9b6c4 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -1576,7 +1576,7 @@ As a side effect: sets `forms--the-record-list'."
(forms--trans the-record "\n" forms-multi-line))
;; A final sanity check before updating.
- (if (string-match-p "\n" the-record)
+ (if (string-search "\n" the-record)
(error "Multi-line fields in this record - update refused"))
(with-current-buffer forms--file-buffer
diff --git a/lisp/frameset.el b/lisp/frameset.el
index e698d5401db..6aa94f8be5a 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -636,7 +636,7 @@ see `frameset-filter-alist'."
(not (frameset-switch-to-gui-p parameters))
(let* ((prefix:p (symbol-name (car current)))
(p (intern (substring prefix:p
- (1+ (string-match-p ":" prefix:p)))))
+ (1+ (string-search ":" prefix:p)))))
(val (cdr current))
(found (assq p filtered)))
(if (not found)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index d65e75e44c2..3c1403e1551 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2519,7 +2519,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
format (and ctl (mail-content-type-get ctl 'format)))
(when cte
(setq cte (mail-header-strip-cte cte)))
- (if (and ctl (not (string-match "/" (car ctl))))
+ (if (and ctl (not (string-search "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max)))
(forward-line 1)
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index f73627a6480..525823e72ce 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -435,7 +435,7 @@ Returns the number of articles marked as read."
;; The "f:+" command marks everything *but* the matches as read,
;; so we simply first match everything as read, and then unmark
;; PATTERN later.
- (when (string-match "\\+" commands)
+ (when (string-search "+" commands)
(gnus-kill "from" ".")
(setq commands "m"))
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index 664027f0164..6adda2ed147 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -169,7 +169,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
(when (not (null params))
(let ((split-spec (assoc 'split-spec params)) group-clean)
;; Remove backend from group name
- (setq group-clean (string-match ":" group))
+ (setq group-clean (string-search ":" group))
(setq group-clean
(if group-clean
(substring group (1+ group-clean))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index db54237a767..ef89e6e9fcb 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1323,7 +1323,7 @@ For the \"inline\" alternatives, also see the variable
((stringp self)
(insert "Gcc: "
(encode-coding-string
- (if (string-match " " self)
+ (if (string-search " " self)
(concat "\"" self "\"")
self)
(gnus-group-name-charset (gnus-inews-group-method self)
@@ -1681,7 +1681,7 @@ this is a reply."
(gnus-group-find-parameter group 'gcc-self t)))
(gcc-self-get (lambda (gcc-self-val group)
(if (stringp gcc-self-val)
- (if (string-match " " gcc-self-val)
+ (if (string-search " " gcc-self-val)
(concat "\"" gcc-self-val "\"")
gcc-self-val)
;; In nndoc groups, we use the parent group name
@@ -1689,7 +1689,7 @@ this is a reply."
(let ((group (or (gnus-group-find-parameter
gnus-newsgroup-name 'parent-group)
group)))
- (if (string-match " " group)
+ (if (string-search " " group)
(concat "\"" group "\"")
group)))))
result
@@ -1752,11 +1752,11 @@ this is a reply."
(gnus-delete-line)))
;; Use the list of groups.
(while (setq name (pop groups))
- (let ((str (if (string-match ":" name)
+ (let ((str (if (string-search ":" name)
name
(gnus-group-prefixed-name
name gnus-message-archive-method))))
- (insert (if (string-match " " str)
+ (insert (if (string-search " " str)
(concat "\"" str "\"")
str)))
(when groups
diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el
index 5697c870888..c135ecea369 100644
--- a/lisp/gnus/gnus-rfc1843.el
+++ b/lisp/gnus/gnus-rfc1843.el
@@ -44,7 +44,7 @@
(case-fold-search t)
(ct (message-fetch-field "Content-Type" t))
(ctl (and ct (mail-header-parse-content-type ct))))
- (if (and ctl (not (string-match "/" (car ctl))))
+ (if (and ctl (not (string-search "/" (car ctl))))
(setq ctl nil))
(goto-char (point-max))
(widen)
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 59b8efaa3ac..2a8069d400c 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1392,7 +1392,7 @@ Returns a list of [group article score] vectors."
(if (string-match-p "\\`[[:digit:]]+\\'" article)
(string-to-number article)
(nnmaildir-base-name-to-article-number
- (substring article 0 (string-match ":" article))
+ (substring article 0 (string-search ":" article))
group (string-remove-prefix "nnmaildir:" server))))
(when (and (numberp article)
(or (null groups)
@@ -2136,7 +2136,7 @@ article came from is also searched."
;; If the value contains spaces, make sure it's
;; quoted.
(when (and (memql status '(exact finished))
- (or (string-match-p " " str)
+ (or (string-search " " str)
in-string))
(unless (looking-at-p "\\s\"")
(insert "\""))
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index cb60108ea9c..59c6956ac2f 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -582,7 +582,7 @@ or to characters when given a pad value."
((string= fstring "")
nil)
;; Not a format string.
- ((not (string-match "%" fstring))
+ ((not (string-search "%" fstring))
(list fstring))
;; A format string with just a single string spec.
((string= fstring "%s")
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index dc004927b67..856e95c0ba0 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9199,7 +9199,7 @@ specified by the `gnus-refer-thread-limit' variable."
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
;; People often post MIDs from URLs, so unhex it:
- (unless (string-match "@" message-id)
+ (unless (string-search "@" message-id)
(setq message-id (gnus-url-unhex-string message-id)))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 7a5e00c5ec9..70ae81d95ea 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -154,7 +154,7 @@ is slower."
(and (string-match "(.+)" from)
(setq name (substring from (1+ (match-beginning 0))
(1- (match-end 0)))))
- (and (string-match "()" from)
+ (and (string-search "()" from)
(setq name address))
;; XOVER might not support folded From headers.
(and (string-match "(.*" from)
@@ -265,7 +265,7 @@ If END is non-nil, use the end of the span instead."
(defun gnus-newsgroup-directory-form (newsgroup)
"Make hierarchical directory name from NEWSGROUP name."
(let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
- (idx (string-match ":" newsgroup)))
+ (idx (string-search ":" newsgroup)))
(concat
(if idx (substring newsgroup 0 idx))
(if idx "/")
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index ceb2ebcdcb1..6c926384c97 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -1434,7 +1434,7 @@ When called interactively, prompt for REGEXP."
"View FILE using the gnus-uu methods."
(let ((action (gnus-uu-get-action file)))
(gnus-execute-command
- (if (string-match "%" action)
+ (if (string-search "%" action)
(format action file)
(concat action " " file))
(eq gnus-view-pseudos 'not-confirm))))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 8b93accccad..d52bd26a2cb 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3526,7 +3526,7 @@ You should probably use `gnus-find-method-for-group' instead."
(defun gnus-group-native-p (group)
"Say whether the group is native or not."
- (not (string-match ":" group)))
+ (not (string-search ":" group)))
(defun gnus-group-secondary-p (group)
"Say whether the group is secondary or not."
@@ -3742,13 +3742,13 @@ just the host name."
;; Separate foreign select method from group name and collapse.
;; If method contains a server, collapse to non-domain server name,
;; otherwise collapse to select method.
- (let* ((colon (string-match ":" group))
+ (let* ((colon (string-search ":" group))
(server (and colon (substring group 0 colon)))
- (plus (and server (string-match "\\+" server))))
+ (plus (and server (string-search "+" server))))
(when server
(if plus
(setq foreign (substring server (+ 1 plus)
- (string-match "\\." server))
+ (string-search "." server))
group (substring group (+ 1 colon)))
(setq foreign server
group (substring group (+ 1 colon))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index a3ffaec3ff3..bff1b2a60d9 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -5340,7 +5340,7 @@ Otherwise, generate and save a value for `canlock-password' first."
(followup-to (message-fetch-field "followup-to"))
to)
(when (and newsgroups
- (string-match "," newsgroups)
+ (string-search "," newsgroups)
(not followup-to)
(not
(zerop
@@ -5371,11 +5371,11 @@ Otherwise, generate and save a value for `canlock-password' first."
(message-id (message-fetch-field "message-id" t)))
(or (not message-id)
;; Is there an @ in the ID?
- (and (string-match "@" message-id)
+ (and (string-search "@" message-id)
;; Is there a dot in the ID?
(string-match "@[^.]*\\." message-id)
;; Does the ID end with a dot?
- (not (string-match "\\.>" message-id)))
+ (not (string-search ".>" message-id)))
(y-or-n-p
(format "The Message-ID looks strange: \"%s\". Really post? "
message-id)))))
@@ -5497,8 +5497,8 @@ Otherwise, generate and save a value for `canlock-password' first."
"@[^\\.]*\\."
(setq ad (nth 1 (mail-extract-address-components
from))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-search ".." ad) ;larsi@ifi..uio
+ (string-search "@." ad) ;larsi@.ifi.uio
(string-match "\\.$" ad) ;larsi@ifi.uio.
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
(string-match "(.*).*(.*)" from)) ;(lars) (lars)
@@ -5523,7 +5523,7 @@ Otherwise, generate and save a value for `canlock-password' first."
(cond
((not reply-to)
t)
- ((string-match "," reply-to)
+ ((string-search "," reply-to)
(y-or-n-p
(format "Multiple Reply-To addresses: \"%s\". Really post? "
reply-to)))
@@ -5531,8 +5531,8 @@ Otherwise, generate and save a value for `canlock-password' first."
"@[^\\.]*\\."
(setq ad (nth 1 (mail-extract-address-components
reply-to))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
+ (string-search ".." ad) ;larsi@ifi..uio
+ (string-search "@." ad) ;larsi@.ifi.uio
(string-match "\\.$" ad) ;larsi@ifi.uio.
(not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
(string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
@@ -5806,7 +5806,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
(mail-header-subject message-reply-headers))
(message-strip-subject-re psubject))))
(and psupersedes
- (string-match "_-_@" psupersedes)))
+ (string-search "_-_@" psupersedes)))
"_-_" ""))
"@" (message-make-fqdn) ">"))
@@ -6022,7 +6022,7 @@ give as trustworthy answer as possible."
"Return the pertinent part of `user-mail-address'."
(when (and user-mail-address
(string-match "@.*\\." user-mail-address))
- (if (string-match " " user-mail-address)
+ (if (string-search " " user-mail-address)
(nth 1 (mail-extract-address-components user-mail-address))
user-mail-address)))
@@ -6053,7 +6053,7 @@ give as trustworthy answer as possible."
message-user-fqdn)
;; A system name without any dots is unlikely to be a good fully
;; qualified domain name.
- ((and (string-match "[.]" sysname)
+ ((and (string-search "." sysname)
(not (string-match message-bogus-system-names sysname)))
;; `system-name' returned the right result.
sysname)
@@ -7053,7 +7053,7 @@ article, it has the value of
" mft "
-which directs your response to " (if (string-match "," mft)
+which directs your response to " (if (string-search "," mft)
"the specified addresses"
"that address only") ".
@@ -7357,7 +7357,7 @@ want to get rid of this query permanently."))
You should normally obey the Followup-To: header.
`Followup-To: " followup-to "'
-directs your response to " (if (string-match "," followup-to)
+directs your response to " (if (string-search "," followup-to)
"the specified newsgroups"
"that newsgroup only") ".
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 02cd6af0c98..82d1de25f3d 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -649,7 +649,7 @@ MIME-Version header before proceeding."
(setq description (mail-decode-encoded-word-string
description)))))
(if (or (not ctl)
- (not (string-match "/" (car ctl))))
+ (not (string-search "/" (car ctl))))
(mm-dissect-singlepart
(list mm-dissect-default-type)
(and cte (intern (downcase (mail-header-strip-cte cte))))
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 708887cb9c7..c35e89289a2 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -803,7 +803,7 @@ If FORMAT isn't a format string, it and all ARGS will be inserted
without formatting."
(with-current-buffer nntp-server-buffer
(erase-buffer)
- (if (string-match "%" format)
+ (if (string-search "%" format)
(insert (apply #'format format args))
(apply #'insert format args))
t))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 3cf65453f3b..8a48cd87dba 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1299,7 +1299,7 @@ If LIMIT, first try to limit the search to the N last articles."
(when (and (nnimap-greeting nnimap-object)
(string-match greeting-match (nnimap-greeting nnimap-object))
(eq type 'append)
- (string-match "\000" data))
+ (string-search "\000" data))
(let ((choice (gnus-multiple-choice
"Message contains NUL characters. Delete, continue, abort? "
'((?d "Delete NUL characters")
@@ -1761,7 +1761,7 @@ If LIMIT, first try to limit the search to the N last articles."
(let ((result nil))
(dolist (elem (split-string irange ","))
(push
- (if (string-match ":" elem)
+ (if (string-search ":" elem)
(let ((numbers (split-string elem ":")))
(cons (string-to-number (car numbers))
(string-to-number (cadr numbers))))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 372df64e2e5..171f0813b38 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -87,7 +87,7 @@ See `nnmaildir-flag-mark-mapping'."
(defun nnmaildir--ensure-suffix (filename)
"Ensure that FILENAME contains the suffix \":2,\"."
- (if (string-match-p ":2," filename)
+ (if (string-search ":2," filename)
filename
(concat filename ":2,")))
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index c6aaf460ece..92944887f44 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -1629,7 +1629,7 @@ SERVER."
(while (string-match "[<>]" mid)
(setq mid (replace-match "" t t mid)))
;; mairix somehow does not like '$' in message-id
- (when (string-match "\\$" mid)
+ (when (string-search "$" mid)
(setq mid (concat mid "=")))
(while (string-match "\\$" mid)
(setq mid (replace-match "=," t t mid)))
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 8cd8cbe84f1..0f12ee0e9d2 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -849,7 +849,7 @@ DATA should be the output of `xml-parse-region'."
(defmacro nnrss-match-macro (base-uri item onsite-list offsite-list)
`(cond ((or (string-match (concat "^" ,base-uri) ,item)
- (not (string-match "://" ,item)))
+ (not (string-search "://" ,item)))
(setq ,onsite-list (append ,onsite-list (list ,item))))
(t (setq ,offsite-list (append ,offsite-list (list ,item))))))
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 1fd2ed06eba..615a3c931bf 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1697,7 +1697,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
;; article comes from that group, I'd say.
((and (setq newsgroups
(mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
+ (not (string-search "," newsgroups)))
newsgroups)
;; If there is more than one group in the
;; Newsgroups header, then the Xref header should
@@ -1725,7 +1725,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the
number (string-to-number (match-string 2 xref))))
((and (setq newsgroups
(mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
+ (not (string-search "," newsgroups)))
(setq group newsgroups))
(group)
(t (setq group ""))))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index d7fb038f45a..2c7956d9680 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -154,7 +154,7 @@ with the current prefix. The files are chosen according to
(mapcar (lambda (c)
(let* ((s (intern c))
(doc (condition-case nil (documentation s) (error nil)))
- (doc (and doc (substring doc 0 (string-match "\n" doc)))))
+ (doc (and doc (substring doc 0 (string-search "\n" doc)))))
(list c (propertize
(format "%-4s" (help--symbol-class s))
'face 'completions-annotations)
diff --git a/lisp/help.el b/lisp/help.el
index ba27fc5810f..29ae3404813 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1912,7 +1912,7 @@ the same names as used in the original source code, when possible."
(let ((name (symbol-name arg)))
(if (eq (aref name 0) ?&)
(memq arg '(&rest &optional))
- (not (string-match "\\." name)))))
+ (not (string-search "." name)))))
(setq valid nil)))
(when valid arglist)))
(let* ((arity (func-arity def))
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index cbb69b206d4..4fadbbe4180 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -507,8 +507,8 @@ otherwise."
"Try to slam together two parts of a file specification, system dependently."
(cond ((null dir-part) name-part)
((eq system-type 'ms-dos)
- (if (and (string-match "\\\\" dir-part)
- (not (string-match "/" dir-part))
+ (if (and (string-search "\\" dir-part)
+ (not (string-search "/" dir-part))
(= (aref name-part (1- (length name-part))) ?/))
(aset name-part (1- (length name-part)) ?\\))
(concat dir-part name-part))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index b453061388f..3b961989e3e 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1902,7 +1902,7 @@ tree depth, as determined from FILE (a filename).
START is the offset at which to start looking for the / character in FILE."
;;(message "hfy-relstub");;DBUG
(let ((c ""))
- (while (setq start (string-match "/" file start))
+ (while (setq start (string-search "/" file start))
(setq start (1+ start)) (setq c (concat c "../")))
c))
diff --git a/lisp/ido.el b/lisp/ido.el
index ea5ff32b8d7..b81a9db5eb9 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1770,7 +1770,7 @@ is enabled then some keybindings are changed in the keymap."
(let ((l (length dirname)))
(if (and max-width (> max-width 0) (> l max-width))
(let* ((s (substring dirname (- max-width)))
- (i (string-match "/" s)))
+ (i (string-search "/" s)))
(concat "..." (if i (substring s i) s)))
dirname)))))
(t prompt)))
@@ -2516,7 +2516,7 @@ If cursor is not at the end of the user input, move to end of input."
;; Do nothing
)
((and (memq ido-cur-item '(file dir))
- (string-match "[$]" ido-text))
+ (string-search "$" ido-text))
(let ((evar (substitute-in-file-name (concat ido-current-directory ido-text))))
(if (not (file-exists-p (file-name-directory evar)))
(message "Expansion generates non-existing directory name")
@@ -3089,7 +3089,7 @@ If repeated, insert text from buffer instead."
(setq ido-text-init word
ido-try-merged-list nil
ido-exit 'chdir))
- ((string-match "/" word)
+ ((string-search "/" word)
(setq ido-text-init (concat ido-current-directory word)
ido-try-merged-list nil
ido-exit 'chdir))
@@ -4559,7 +4559,7 @@ For details of keybindings, see `ido-find-file'."
(setq try-single-dir-match t))))
((and (string-equal (substring contents -2 -1) "/")
- (not (string-match "[$]" contents)))
+ (not (string-search "$" contents)))
(ido-set-current-directory
(cond
((= (length contents) 2)
@@ -4656,7 +4656,7 @@ For details of keybindings, see `ido-find-file'."
(memq ido-cur-item '(file dir))
(not (ido-is-root-directory))
(> (length contents) 1)
- (not (string-match "[$]" contents))
+ (not (string-search "$" contents))
(not ido-directory-nonreadable)
(not ido-directory-too-big))
(ido-trace "merge?")
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el
index 97bf1ac058c..75d2e6692c0 100644
--- a/lisp/image/image-converter.el
+++ b/lisp/image/image-converter.el
@@ -78,7 +78,7 @@ is a string, it should be a MIME format string like
(string-match image-converter-regexp source))
(and data-p
(symbolp data-p)
- (string-match "/" (symbol-name data-p))
+ (string-search "/" (symbol-name data-p))
(string-match
image-converter-regexp
(concat "foo." (image-converter--mime-type data-p)))))
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 538a017f3c0..e2e3e30ca21 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -547,7 +547,7 @@ the sources handy."
;; skip nodes with "%" as probably `format' strings such as in
;; info-look.el
- (unless (string-match "%" node)
+ (unless (string-search "%" node)
;; "(emacs)" is the default manual for docstring hyperlinks,
;; per `help-make-xrefs'
diff --git a/lisp/info.el b/lisp/info.el
index 1c477a7082f..3718a1eb83f 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2483,7 +2483,7 @@ Table of contents is created from the tree structure of menus."
(match-string-no-properties 1)))
(section "Top")
menu-items)
- (when (and upnode (string-match "(" upnode)) (setq upnode nil))
+ (when (and upnode (string-search "(" upnode)) (setq upnode nil))
(when (and (not (Info-index-node nodename file))
(re-search-forward "^\\* Menu:" bound t))
(forward-line 1)
@@ -2616,7 +2616,7 @@ new buffer."
(let (target i (str (concat "\\*note " (regexp-quote footnotename)))
(case-fold-search t))
- (while (setq i (string-match " " str i))
+ (while (setq i (string-search " " str i))
(setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
(setq i (+ i 6)))
(save-excursion
@@ -2933,7 +2933,7 @@ last sub-node, if any; otherwise go \"up\" to the parent node."
(let ((prevnode (Info-extract-pointer "prev[ious]*" t))
(upnode (Info-extract-pointer "up" t))
(case-fold-search t))
- (cond ((and upnode (string-match "(" upnode))
+ (cond ((and upnode (string-search "(" upnode))
(user-error "First node in file"))
((and upnode (or (null prevnode)
;; Use string-equal, not equal,
@@ -3778,7 +3778,7 @@ Build a menu of the possible matches."
"The following packages match the keyword â" nodename "â:\n\n")
(insert "* Menu:\n\n")
(let ((keywords
- (mapcar #'intern (if (string-match-p "," nodename)
+ (mapcar #'intern (if (string-search "," nodename)
(split-string nodename ",[ \t\n]*" t)
(list nodename))))
hits desc)
@@ -5244,7 +5244,7 @@ The INDENT level is ignored."
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node (NAME . FILE).
INDENT is the current indentation depth."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(if (speedbar-with-writable
(save-excursion
@@ -5252,7 +5252,7 @@ INDENT is the current indentation depth."
(Info-speedbar-hierarchy-buttons nil (1+ indent) token)))
(speedbar-change-expand-button-char ?-)
(speedbar-change-expand-button-char ??)))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 2d3cd25b4a4..02169ceb689 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -905,13 +905,13 @@ The IGNORED argument is ignored."
(setq family "*-*")
(if (symbolp family)
(setq family (symbol-name family)))
- (or (string-match "-" family)
+ (or (string-search "-" family)
(setq family (concat "*-" family))))
(if (not registry)
(setq registry "*-*")
(if (symbolp registry)
(setq registry (symbol-name registry)))
- (or (string-match "-" registry)
+ (or (string-search "-" registry)
(= (aref registry (1- (length registry))) ?*)
(setq registry (concat registry "*"))))
(insert (format"\n -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index b999eff662f..121a4c542e7 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -29,7 +29,7 @@
;;;###autoload
(defvar default-korean-keyboard
- (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
+ (purecopy (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") ""))
"3"
""))
"The kind of Korean keyboard for Korean (Hangul) input method.
diff --git a/lisp/linum.el b/lisp/linum.el
index b0281d366cd..c78f596d768 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -219,7 +219,7 @@ Linum mode is a buffer-local minor mode."
;; update overlays on deletions, and after newlines are inserted
(when (or (= beg end)
(= end (point-max))
- (string-match-p "\n" (buffer-substring-no-properties beg end)))
+ (string-search "\n" (buffer-substring-no-properties beg end)))
(linum-update-current)))
(defun linum-after-scroll (win _start)
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 2d683574743..b1682cf78a2 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -236,7 +236,7 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
(setq display-string (ietf-drums-get-comment string)))
(if (not mailbox)
(when (and display-string
- (string-match "@" display-string))
+ (string-search "@" display-string))
(cons
(mapconcat #'identity (nreverse display-name) "")
(ietf-drums-get-comment string)))
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index bb1f8f13bac..3eb3ccb93de 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -252,7 +252,7 @@ comma-separated list, and return the pruned list."
(setq cur-pos (string-match "[,\"]" destinations cur-pos))
(if (and cur-pos (equal (match-string 0 destinations) "\""))
;; Search for matching quote.
- (let ((next-pos (string-match "\"" destinations (1+ cur-pos))))
+ (let ((next-pos (string-search "\"" destinations (1+ cur-pos))))
(if next-pos
(setq cur-pos (1+ next-pos))
;; If the open-quote has no close-quote,
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 5b08713949f..c442913d282 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -612,7 +612,7 @@ should not change this value.")
(setq next prev
prev nil)
(if (or (< index limit)
- (<= (+ len (or (string-match "\n" tail)
+ (<= (+ len (or (string-search "\n" tail)
(length tail)))
rfc2047-encode-max-chars))
(setq prev next
@@ -1111,7 +1111,7 @@ strings are stripped."
"Decode MIME-encoded STRING and return the result.
If ADDRESS-MIME is non-nil, strip backslashes which precede characters
other than `\"' and `\\' in quoted strings."
- (if (string-match "=\\?" string)
+ (if (string-search "=?" string)
(with-temp-buffer
;; We used to only call mm-enable-multibyte if `m' is non-nil,
;; but this can't be the right criterion. Don't just revert this
diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el
index db34fd2cb9e..a398ce0e9cc 100644
--- a/lisp/mail/rfc2231.el
+++ b/lisp/mail/rfc2231.el
@@ -61,12 +61,12 @@ must never cause a Lisp error."
;; make it parsable. Let's try...
(error
(let (mod)
- (when (and (string-match "\\\\\"" string)
+ (when (and (string-search "\\\"" string)
(not (string-match "\\`\"\\|[^\\]\"" string)))
(setq string (string-replace "\\\"" "\"" string)
mod t))
- (when (and (string-match "\\\\(" string)
- (string-match "\\\\)" string)
+ (when (and (string-search "\\(" string)
+ (string-search "\\)" string)
(not (string-match "\\`(\\|[^\\][()]" string)))
(setq string (replace-regexp-in-string
"\\\\\\([()]\\)" "\\1" string)
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index acbb5880b5c..58a8eb7a370 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -93,7 +93,7 @@ according to the choice made, and returns a symbol."
"Set LABEL as present or absent according to STATE in message MSG.
LABEL may be a symbol or string."
(or (stringp label) (setq label (symbol-name label)))
- (if (string-match "," label)
+ (if (string-search "," label)
(error "More than one label specified"))
(with-current-buffer rmail-buffer
(rmail-maybe-set-message-counters)
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index ac933b9706d..9dd9573a9fc 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -759,7 +759,7 @@ the message being processed."
;; If there are multiple lines in FROM,
;; discard up to the last newline in it.
(while (and (stringp from)
- (setq newline (string-match "\n" from)))
+ (setq newline (string-search "\n" from)))
(setq from (substring from (1+ newline))))
(if (or (null from)
(string-match
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 8e3927cdcf2..ec9f340db86 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -516,7 +516,7 @@ for `smtpmail-try-auth-method'.")
(defun smtpmail-maybe-append-domain (recipient)
(if (or (not smtpmail-sendto-domain)
- (string-match "@" recipient))
+ (string-search "@" recipient))
recipient
(concat recipient "@" smtpmail-sendto-domain)))
@@ -700,7 +700,7 @@ Returns an error if the server cannot be contacted."
(let ((parts (split-string user-mail-address "@")))
(and (= (length parts) 2)
;; There's a dot in the domain name.
- (string-match "\\." (cadr parts))
+ (string-search "." (cadr parts))
user-mail-address))))
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index 9ebffef2e59..b07004de38c 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -246,10 +246,10 @@ You might need to set `uce-mail-reader' before using this."
(if reply-to
(setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
(let (first-at-sign end-of-hostname sender-host)
- (setq first-at-sign (string-match "@" to)
+ (setq first-at-sign (string-search "@" to)
end-of-hostname (string-match "[ ,>]" to first-at-sign)
sender-host (substring to first-at-sign end-of-hostname))
- (if (string-match "\\." sender-host)
+ (if (string-search "." sender-host)
(setq to (format "%s, postmaster%s, abuse%s"
to sender-host sender-host))))
(setq mail-send-actions nil)
@@ -291,7 +291,7 @@ You might need to set `uce-mail-reader' before using this."
(search-forward " ")
(forward-char -1)
;; And add its postmaster to the list of addresses.
- (if (string-match "\\." (buffer-substring temp (point)))
+ (if (string-search "." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))
;; Also look at the message-id, it helps *very* often.
@@ -302,7 +302,7 @@ You might need to set `uce-mail-reader' before using this."
(setq temp (point))
(search-forward ">")
(forward-char -1)
- (if (string-match "\\." (buffer-substring temp (point)))
+ (if (string-search "." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))))
(when (eq uce-mail-reader 'gnus)
diff --git a/lisp/man.el b/lisp/man.el
index 54b6ffe9836..6009a319198 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -801,7 +801,7 @@ POS defaults to `point'."
;; doesn't include a hyphen, we consider the hyphen to be
;; added by troff, and remove it.
(or (not (eq (string-to-char (substring 1st-part -1)) ?-))
- (string-match-p "-" (substring 1st-part 0 -1))
+ (string-search "-" (substring 1st-part 0 -1))
(setq word (string-replace "-" "" word))))
;; Make sure the section number gets included by the code below.
(goto-char (match-end 1)))
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index 415e9848258..37fdb166011 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -111,10 +111,10 @@ COMMA-SEPARATOR is non-nil."
(string-match "^\\([^,]+\\)," res))
(setq res (match-string 1 res)))
;; Replace "&" with capitalized username
- (if (string-match "&" res)
+ (if (string-search "&" res)
(setq res (mh-replace-regexp-in-string "&" (capitalize username) res)))
;; Remove " character
- (if (string-match "\"" res)
+ (if (string-search "\"" res)
(setq res (mh-replace-regexp-in-string "\"" "" res)))
;; If empty string, use username instead
(if (string-equal "" res)
@@ -285,7 +285,7 @@ Blind aliases or users from /etc/passwd are not expanded."
(message "%s -> %s" the-name (mh-alias-expand the-name))
;; Check if it was a single word likely to be an alias
(if (and (equal mh-alias-flash-on-comma 1)
- (not (string-match " " the-name)))
+ (not (string-search " " the-name)))
(message "No alias for %s" the-name))))))
(self-insert-command 1))
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index b64bbfb6f3b..4fae69defaf 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -637,8 +637,8 @@ See also `mh-compose-forward-as-mime-flag',
(defun mh-forwarded-letter-subject (from subject)
"Return a Subject suitable for a forwarded message.
Original message has headers FROM and SUBJECT."
- (let ((addr-start (string-match "<" from))
- (comment (string-match "(" from)))
+ (let ((addr-start (string-search "<" from))
+ (comment (string-search "(" from)))
(cond ((and addr-start (> addr-start 0))
;; Full Name <luser@host>
(setq from (substring from 0 (1- addr-start))))
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 3af840c3a31..76ef990d825 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -441,7 +441,7 @@ be handled next."
(position 0)
line-end line folder unseen total)
(unwind-protect
- (while (setq line-end (string-match "\n" output position))
+ (while (setq line-end (string-search "\n" output position))
(setq line (format "%s%s"
mh-speed-partial-line
(substring output position line-end))
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 8e900dc0113..bbce17013b1 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -378,7 +378,7 @@ names and the function is called when OUTPUT is available."
(prevailing-match-data (match-data))
line-end folder)
(unwind-protect
- (while (setq line-end (string-match "\n" output position))
+ (while (setq line-end (string-search "\n" output position))
(setq folder (format "+%s%s"
mh-flists-partial-line
(substring output position line-end)))
@@ -702,7 +702,7 @@ See Info node `(elisp) Programmed Completion' for details."
(let ((slash (mh-search-from-end ?/ orig-name)))
(if slash (1+ slash)
(if (string-match "\\`\\+" orig-name) 1 0)))
- (if (cdr flag) (string-match "/" (cdr flag)))))
+ (if (cdr flag) (string-search "/" (cdr flag)))))
((eq flag nil)
(let ((try-res
(try-completion
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 2c6340e1c3e..9f327df28f5 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2741,7 +2741,7 @@ Useful to give the user default values that won't be substituted."
(defun completion--make-envvar-table ()
(mapcar (lambda (enventry)
- (substring enventry 0 (string-match-p "=" enventry)))
+ (substring enventry 0 (string-search "=" enventry)))
process-environment))
(defconst completion--embedded-envvar-re
@@ -2810,7 +2810,7 @@ same as `substitute-in-file-name'."
pred action))
((eq (car-safe action) 'boundaries)
(let ((start (length (file-name-directory string)))
- (end (string-match-p "/" (cdr action))))
+ (end (string-search "/" (cdr action))))
`(boundaries
;; if `string' is "C:" in w32, (file-name-directory string)
;; returns "C:/", so `start' is 3 rather than 2.
@@ -3988,7 +3988,7 @@ which is at the core of flex logic. The extra
(defun completion-flex-try-completion (string table pred point)
"Try to flex-complete STRING in TABLE given PRED and POINT."
- (unless (and completion-flex-nospace (string-match-p " " string))
+ (unless (and completion-flex-nospace (string-search " " string))
(pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
(completion-substring--all-completions
string table pred point
@@ -4005,7 +4005,7 @@ which is at the core of flex logic. The extra
(defun completion-flex-all-completions (string table pred point)
"Get flex-completions of STRING in TABLE, given PRED and POINT."
- (unless (and completion-flex-nospace (string-match-p " " string))
+ (unless (and completion-flex-nospace (string-search " " string))
(pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
(completion-substring--all-completions
string table pred point
diff --git a/lisp/mpc.el b/lisp/mpc.el
index e04ffa49747..029f0ca8f42 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -305,7 +305,7 @@ defaults to 6600 and HOST defaults to localhost."
(defun mpc--proc-quote-string (s)
(if (numberp s) (number-to-string s)
(setq s (replace-regexp-in-string "[\"\\]" "\\\\\\&" s))
- (if (string-match " " s) (concat "\"" s "\"") s)))
+ (if (string-search " " s) (concat "\"" s "\"") s)))
(defconst mpc--proc-alist-to-alists-starters '(file directory))
@@ -611,7 +611,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted."
(defun mpc-cmd-special-tag-p (tag)
(or (memq tag '(Playlist Search Directory))
- (string-match "|" (symbol-name tag))))
+ (string-search "|" (symbol-name tag))))
(defun mpc-cmd-find (tag value)
"Return a list of all songs whose tag TAG has value VALUE.
@@ -1438,7 +1438,7 @@ when constructing the set of constraints."
(let (res)
(dolist (constraint constraints)
(when (or (eq (car constraint) buffer-tag)
- (and (string-match "|" (symbol-name buffer-tag))
+ (and (string-search "|" (symbol-name buffer-tag))
(member (symbol-name (car constraint))
(split-string (symbol-name buffer-tag) "|"))))
(setq res (cdr constraint))))
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 3f3a3df8e55..e302aa89f30 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -2296,7 +2296,7 @@ and NOWAIT."
;; If the dir name contains a space, some ftp servers will
;; refuse to list it. We instead change directory to the
;; directory in question and ls ".".
- (when (string-match " " cmd1)
+ (when (string-search " " cmd1)
;; Keep the result. In case of failure, we will (see below)
;; short-circuit CMD and return this result directly.
(setq result (ange-ftp-cd host user (nth 1 cmd) 'noerror))
@@ -2881,13 +2881,13 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained."
(or
;; No dots in dir names in vms.
(and (eq host-type 'vms)
- (string-match "\\." efile))
+ (string-search "." efile))
;; No subdirs in mts of cms.
(and (memq host-type '(mts cms))
(not (string-equal "/" (nth 2 parsed))))
;; No dots in pseudo-dir names in bs2000.
(and (eq host-type 'bs2000)
- (string-match "\\." efile))))))
+ (string-search "." efile))))))
(defun ange-ftp-file-entry-p (name)
"Given NAME, return whether there is a file entry for it."
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index aeeb9bd8d3b..5473ba7e697 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -1075,7 +1075,7 @@ For instance, \"foo.png\" will result in \"image/png\"."
(dolist (data mailcap--computed-mime-data)
(dolist (info (cdr data))
(setq type (cdr (assq 'type (cdr info))))
- (unless (string-match-p "\\*" type)
+ (unless (string-search "*" type)
(push type res))))
(nreverse res)))))
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index e1d35c2a85a..727aa55de58 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -422,7 +422,7 @@ with m:msgid of the current article and enabled threads."
(while (string-match "[<>]" mid)
(setq mid (replace-match "" t t mid)))
;; mairix somehow does not like '$' in message-id
- (when (string-match "\\$" mid)
+ (when (string-search "$" mid)
(setq mid (concat mid "=")))
(while (string-match "\\$" mid)
(setq mid (replace-match "=," t t mid)))
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index cb49f75c81d..a267ac319b6 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -551,8 +551,8 @@ Returns the process associated with the connection."
(when result
(let ((response (plist-get (cdr result) :greeting)))
(setq pop3-timestamp
- (substring response (or (string-match "<" response) 0)
- (+ 1 (or (string-match ">" response) -1)))))
+ (substring response (or (string-search "<" response) 0)
+ (+ 1 (or (string-search ">" response) -1)))))
(set-process-query-on-exit-flag (car result) nil)
(erase-buffer)
(car result)))))
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index f5480afb698..de1cd9d320f 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -1938,7 +1938,7 @@ This is a specialization of `soap-decode-type' for
(e-name (soap-xs-element-name element))
;; Heuristic: guess if we need to decode using local
;; namespaces.
- (use-fq-names (string-match ":" (symbol-name (car node))))
+ (use-fq-names (string-search ":" (symbol-name (car node))))
(children (if e-name
(if use-fq-names
;; Find relevant children
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 1da1d31d678..78a261fd83e 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -277,7 +277,7 @@
(setq version (process-get proc 'socks-server-protocol))
(cond
((equal version 'http)
- (if (not (string-match "\r\n\r\n" string))
+ (if (not (string-search "\r\n\r\n" string))
nil ; Need to spin some more
(process-put proc 'socks-state socks-state-connected)
(process-put proc 'socks-reply 0)
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 6dca34a80f2..c265b19cf05 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -633,7 +633,7 @@ non-transparent child section."
tag-qnames))))
(defun nxml-highlighted-qname (qname)
- (let ((colon (string-match ":" qname)))
+ (let ((colon (string-search ":" qname)))
(if colon
(concat (propertize (substring qname 0 colon)
'face
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index d820d1b99b5..dd3000773fd 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -179,7 +179,7 @@ Return a pattern."
(setq rng-c-default-namespace rng-c-inherit-namespace)))
(defun rng-c-expand-name (prefixed-name)
- (let ((i (string-match ":" prefixed-name)))
+ (let ((i (string-search ":" prefixed-name)))
(rng-make-name (rng-c-lookup-prefix (substring prefixed-name
0
i))
@@ -222,7 +222,7 @@ and URI is a symbol.")
(cdr binding)))
(defun rng-c-expand-datatype (prefixed-name)
- (let ((i (string-match ":" prefixed-name)))
+ (let ((i (string-search ":" prefixed-name)))
(rng-make-datatype
(rng-c-lookup-datatype-prefix (substring prefixed-name 0 i))
(substring prefixed-name (+ i 1)))))
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index fda481fa281..24f4d2ec443 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -93,7 +93,7 @@ Signal an error if URI is not a valid file URL."
(rng-uri-error "`?' not escaped in file URI `%s'" uri))
(when fragment-id
(rng-uri-error "URI `%s' has a fragment identifier" uri))
- (when (string-match ";" path)
+ (when (string-search ";" path)
(rng-uri-error "`;' not escaped in URI `%s'" uri))
(when (string-match "%2[fF]" path) ;; 2f is hex code of slash
(rng-uri-error "Escaped slash in URI `%s'" uri))
@@ -110,7 +110,7 @@ Signal an error if URI is not a valid file URL."
(rng-uri-unescape-unibyte-replace path 2))
(t
(rng-uri-unescape-unibyte path))))
- (when (string-match "\000" path)
+ (when (string-search "\000" path)
(rng-uri-error "URI `%s' has NUL character in path" uri))
(when (eq pattern 'match)
(setq path
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index 1c1167db89b..2d3be2dd9a4 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -243,7 +243,7 @@ second TAB brings up the `*Completions*' buffer."
(when (and partial-completion-mode (null PC-env-vars-alist))
(setq PC-env-vars-alist
(mapcar (lambda (string)
- (let ((d (string-match "=" string)))
+ (let ((d (string-search "=" string)))
(cons (concat "$" (substring string 0 d))
(and d (substring string (1+ d))))))
process-environment))))
@@ -575,7 +575,7 @@ GOTO-END is non-nil, however, it instead replaces up to END."
p (+ p (length PC-ndelims-regex) 1)))))
(setq p 0)
(if filename
- (while (setq p (string-match "\\\\\\*" regex p))
+ (while (setq p (string-search "\\*" regex p))
(setq regex (concat (substring regex 0 p)
"[^/]*"
(substring regex (+ p 2))))))
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index 9676d6b28e9..9bf68456826 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -393,11 +393,11 @@ compatibility with `format-alist', and is ignored."
"Return a copy of STRING with each soft newline replaced by a space.
Hard newlines are left intact."
(let* ((str (copy-sequence string))
- (pos (string-match "\n" str)))
+ (pos (string-search "\n" str)))
(while pos
(if (null (get-text-property pos 'hard str))
(aset str pos ? ))
- (setq pos (string-match "\n" str (1+ pos))))
+ (setq pos (string-search "\n" str (1+ pos))))
str))
;;; Auto wrap
diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el
index caeca988810..9aab1e7c9f5 100644
--- a/lisp/obsolete/nnir.el
+++ b/lisp/obsolete/nnir.el
@@ -509,7 +509,7 @@ construct the vector entries."
(vector (gnus-group-full-name group server)
(if (string-match "\\`nnmaildir:" (gnus-group-server server))
(nnmaildir-base-name-to-article-number
- (substring article 0 (string-match ":" article))
+ (substring article 0 (string-search ":" article))
group nil)
(string-to-number article))
(string-to-number score)))))
diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el
index dbfc79bf913..0167a00066b 100644
--- a/lisp/obsolete/terminal.el
+++ b/lisp/obsolete/terminal.el
@@ -1222,7 +1222,7 @@ of the terminal-emulator"
(cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'"
string)
string)
- ((not (string-match "[$]" string))
+ ((not (string-search "$" string))
;; "[\"\\]" are special to sh and the lisp reader in the same way
(prin1-to-string string))
(t
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index 1340618f055..e0e89c390ea 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -1415,9 +1415,9 @@ If an argument is specified, don't set the search direction."
;; if using regexp, eliminate upper case forms (\B \W \S.)
(if tpu-regexp-p
(let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0))
- (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.))
- (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\\\" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\B" pat)) (aset pat (+ 1 pos) ?.))
+ (while (setq pos (string-search "\\W" pat)) (aset pat (+ 1 pos) ?.))
(while (setq pos (string-match "\\\\S." pat))
(aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.))
(string-equal pat (downcase pat)))
diff --git a/lisp/obsolete/url-ns.el b/lisp/obsolete/url-ns.el
index b62ad829990..6cd6693fc43 100644
--- a/lisp/obsolete/url-ns.el
+++ b/lisp/obsolete/url-ns.el
@@ -31,7 +31,7 @@
;;;###autoload
(defun isPlainHostName (host)
- (not (string-match "\\." host)))
+ (not (string-search "." host)))
;;;###autoload
(defun dnsDomainIs (host dom)
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index e1d104f74ff..49dc2d2fc6c 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -214,7 +214,7 @@ Includes files as well as host names followed by a colon."
(list string)
(completion-table-subvert (pcomplete-all-entries)
"" "/ssh:")))
- ((string-match "/" string) ; Local file name.
+ ((string-search "/" string) ; Local file name.
(pcomplete-all-entries))
(t ;Host name or local file name.
(append (all-completions string (pcomplete-all-entries))
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 3bb8bf0c82b..9d5ee261976 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -2170,7 +2170,7 @@ other words."
(let (pos ret-list end-pos)
(setq pos 0)
(setq ret-list nil)
- (while (setq end-pos (string-match " " (substring strin pos)))
+ (while (setq end-pos (string-search " " (substring strin pos)))
(setq end-pos (+ end-pos pos))
(if (not (= end-pos pos))
(setq ret-list (append ret-list (list
@@ -2269,7 +2269,7 @@ except for the verb."
startlist
(if (string= (substring dirstring 0 1) "/")
(dun-get-path (substring dirstring 1) (append startlist (list "/")))
- (if (not (setq slash (string-match "/" dirstring)))
+ (if (not (setq slash (string-search "/" dirstring)))
(append startlist (list dirstring))
(dun-get-path (substring dirstring (1+ slash))
(append startlist
@@ -2348,7 +2348,7 @@ Also prints current score to let user know he has scored."
(princ dun-line)
(if (eq (dun-parse2 nil dun-unix-verbs dun-line) -1)
(progn
- (if (setq esign (string-match "=" dun-line))
+ (if (setq esign (string-search "=" dun-line))
(dun-doassign dun-line esign)
(dun-mprinc (car dun-line-list))
(dun-mprincl ": not found.")))))
@@ -2380,21 +2380,21 @@ Also prints current score to let user know he has scored."
(dun-mprinc line)
(dun-mprincl " : not found."))
- (if (not (setq epoint (string-match ")" line)))
+ (if (not (setq epoint (string-search ")" line)))
(if (string= (substring line (1+ esign) (+ esign 2))
"\"")
(progn
(setq afterq (substring line (+ esign 2)))
(setq epoint (+
- (string-match "\"" afterq)
+ (string-search "\"" afterq)
(+ esign 3))))
- (if (not (setq epoint (string-match " " line)))
+ (if (not (setq epoint (string-search " " line)))
(setq epoint (length line))))
(setq epoint (1+ epoint))
(while (and
(not (= epoint (length line)))
- (setq i (string-match ")" (substring line epoint))))
+ (setq i (string-search ")" (substring line epoint))))
(setq epoint (+ epoint i 1))))
(setq value (substring line (1+ esign) epoint))
(dun-eval varname value)))))
@@ -2788,7 +2788,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
(cond
((null (setq args (car args)))
(dun-mprincl "Usage: cat <ascii-file-name>"))
- ((string-match-p "/" args)
+ ((string-search "/" args)
(dun-mprincl "cat: only files in current directory allowed."))
((and (> dun-cdroom 0) (string= args "description"))
(dun-mprincl (car (nth dun-cdroom dun-rooms))))
@@ -3110,7 +3110,7 @@ File not found")))
(setq dun-line (downcase (dun-read-line)))
(if (eq (dun-parse2 nil dun-unix-verbs dun-line) -1)
(let (esign)
- (if (setq esign (string-match "=" dun-line))
+ (if (setq esign (string-search "=" dun-line))
(dun-doassign dun-line esign)
(dun-mprinc (car dun-line-list))
(dun-mprincl ": not found.")))))
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index a00440d898c..884104a16f7 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -4337,7 +4337,7 @@ end
(let ((len (1- (length str)))
(index 0)
new start fmt)
- (while (setq start (string-match "%" str index))
+ (while (setq start (string-search "%" str index))
(setq fmt (if (< start len) (aref str (1+ start)) ?\?)
new (concat new
(substring str index start)
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 97596d0d278..67ad39b7f46 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1382,7 +1382,7 @@ With arg, enter name of variable to be watched in the minibuffer."
(string-match "\\(\\S-+\\)" text)
(let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list))
(varnum (car var)))
- (if (string-match "\\." (car var))
+ (if (string-search "." (car var))
(message-box "Can only delete a root expression")
(gdb-var-delete-1 var varnum)))))
@@ -1479,14 +1479,14 @@ With arg, enter name of variable to be watched in the minibuffer."
TEXT is the text of the button we clicked on, a + or - item.
TOKEN is data related to this node.
INDENT is the current indentation depth."
- (cond ((string-match "\\+" text) ;expand this node
+ (cond ((string-search "+" text) ;expand this node
(let* ((var (assoc token gdb-var-list))
(expr (nth 1 var)) (children (nth 2 var)))
(if (or (<= (string-to-number children) gdb-max-children)
(y-or-n-p
(format "%s has %s children. Continue? " expr children)))
(gdb-var-list-children token))))
- ((string-match "-" text) ;contract this node
+ ((string-search "-" text) ;contract this node
(dolist (var gdb-var-list)
(if (string-match (concat token "\\.") (car var))
(setq gdb-var-list (delq var gdb-var-list))))
@@ -2416,7 +2416,7 @@ rule from an incomplete data stream. The parser will stay in this state until
the end of the current result or async record is reached."
(when (< gdbmi-bnf-offset (length gud-marker-acc))
;; Search the data stream for the end of the current record:
- (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset))
+ (let* ((newline-pos (string-search "\n" gud-marker-acc gdbmi-bnf-offset))
(is-progressive (equal (cdr class-command) 'progressive))
(is-complete (not (null newline-pos)))
result-str)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 05ad82acc4a..08814ebcaaa 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3150,7 +3150,7 @@ Obeying it means displaying in another window the specified file and line."
(buffer-substring (region-beginning) (region-end))
(apply gud-find-expr-function args))))
(save-match-data
- (if (string-match "\n" expr)
+ (if (string-search "\n" expr)
(error "Expression must not include a newline"))
(with-current-buffer gud-comint-buffer
(save-excursion
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index db76df96a56..c53b9a4775c 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -495,7 +495,7 @@ It collects and prints the diagnostics messages."
((and (memq cw '(function-keyword procedure-keyword))
(stringp this-word)
(string-match "\\S-" this-word)
- (not (string-match "!" this-word)))
+ (not (string-search "!" this-word)))
(cond ((or (= (char-before beg) ?/)
(save-excursion (goto-char end)
(looking-at "[ \t]*=")))
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index ad8feb988f5..eb88f25dfd6 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -967,7 +967,7 @@ IDL has currently stepped.")
;; Strip those pesky ctrl-m's.
(add-hook 'comint-output-filter-functions
(lambda (string)
- (when (string-match "\r" string)
+ (when (string-search "\r" string)
(let ((pmark (process-mark (get-buffer-process
(current-buffer)))))
(save-excursion
@@ -1409,7 +1409,7 @@ Remove everything to the first newline, and all lines with % in front
of them, with optional follow-on lines starting with two spaces. This
works well enough, since any print output typically arrives before
error messages, etc."
- (setq output (substring output (string-match "\n" output)))
+ (setq output (substring output (string-search "\n" output)))
(while (string-match "\\(\n\\|\\`\\)%.*\\(\n .*\\)*" output)
(setq output (replace-match "" nil t output)))
(unless
@@ -1431,12 +1431,12 @@ and then calls `idlwave-shell-send-command' for any pending commands."
(unwind-protect
(progn
;; Ring the bell if necessary
- (while (setq p (string-match "\C-G" string))
+ (while (setq p (string-search "\C-G" string))
(ding)
(aset string p ?\C-j ))
(if idlwave-shell-hide-output
(save-excursion
- (while (setq p (string-match "\C-M" string))
+ (while (setq p (string-search "\C-M" string))
(aset string p ?\ ))
(set-buffer
(get-buffer-create idlwave-shell-hidden-output-buffer))
@@ -1445,7 +1445,7 @@ and then calls `idlwave-shell-send-command' for any pending commands."
(comint-output-filter proc string))
;; Watch for magic - need to accumulate the current line
;; since it may not be sent all at once.
- (if (string-match "\n" string)
+ (if (string-search "\n" string)
(progn
(if idlwave-shell-use-input-mode-magic
(idlwave-shell-input-mode-magic
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index b55a98af0b3..55e712dd77d 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -2547,7 +2547,7 @@ If there is no label point is not moved and nil is returned."
(end (idlwave-find-key ":" 1 'nomark eos)))
(if (and end
(= (nth 0 (parse-partial-sexp start end)) 0)
- (not (string-match "\\?" (buffer-substring start end)))
+ (not (string-search "?" (buffer-substring start end)))
(not (string-match "^::" (buffer-substring end eos))))
(progn
(forward-char)
@@ -7677,9 +7677,9 @@ arg, the class property is cleared out."
(interactive "P")
(idlwave-routines)
- (if (string-match "->" (buffer-substring
- (max (point-min) (1- (point)))
- (min (+ 2 (point)) (point-max))))
+ (if (string-search "->" (buffer-substring
+ (max (point-min) (1- (point)))
+ (min (+ 2 (point)) (point-max))))
;; Cursor is on an arrow
(if (get-text-property (point) 'idlwave-class)
;; arrow has class property
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index aff3066c698..b1a5f301587 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -895,7 +895,7 @@ startup file, `~/.emacs-octave'."
(defun inferior-octave-completion-at-point ()
"Return the data to complete the Octave symbol at point."
;; https://debbugs.gnu.org/14300
- (unless (string-match-p "/" (or (comint--match-partial-filename) ""))
+ (unless (string-search "/" (or (comint--match-partial-filename) ""))
(let ((beg (save-excursion
(skip-syntax-backward "w_" (comint-line-beginning-position))
(point)))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 91db4ae21cb..2f98b9c53c1 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -2672,7 +2672,7 @@ t means to return a list of all possible completions of STRING.
(or sh-shell-variables-initialized
(sh-shell-initialize-variables))
(nconc (mapcar (lambda (var)
- (substring var 0 (string-match "=" var)))
+ (substring var 0 (string-search "=" var)))
process-environment)
sh-shell-variables))))
(complete-with-action code vars string predicate)))
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index b9012166a52..d144d68b571 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -1573,7 +1573,7 @@ statement. The format of variable should be a valid
face)))
(defun sql-regexp-abbrev (keyword)
- (let ((brk (string-match "[~]" keyword))
+ (let ((brk (string-search "~" keyword))
(len (length keyword))
(sep "\\(?:")
re i)
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index 613863dd613..70763319840 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -936,7 +936,7 @@ the remaining input.")
(setq call-noexcursion nil)
(with-current-buffer (process-buffer proc)
(cond ((eq xscheme-process-filter-state 'idle)
- (let ((start (string-match "\e" xscheme-filter-input)))
+ (let ((start (string-search "\e" xscheme-filter-input)))
(if start
(progn
(xscheme-process-filter-output
@@ -960,7 +960,7 @@ the remaining input.")
(xscheme-process-filter-output ?\e char)
(setq xscheme-process-filter-state 'idle)))))))
((eq xscheme-process-filter-state 'reading-string)
- (let ((start (string-match "\e" xscheme-filter-input)))
+ (let ((start (string-search "\e" xscheme-filter-input)))
(if start
(let ((string
(concat xscheme-string-accumulator
diff --git a/lisp/replace.el b/lisp/replace.el
index c67877efd5d..1d6f091dc71 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -310,7 +310,7 @@ the original string if not."
;; but not after (quote foo).
(and (eq (car-safe (car pos)) 'quote)
(not (= ?\( (aref to 0)))))
- (eq (string-match " " to (cdr pos))
+ (eq (string-search " " to (cdr pos))
(cdr pos)))
(1+ (cdr pos))
(cdr pos))))
@@ -633,13 +633,13 @@ Arguments REGEXP, START, END, and REGION-NONCONTIGUOUS-P are passed to
(if (listp to-strings)
(setq replacements to-strings)
(while (/= (length to-strings) 0)
- (if (string-match " " to-strings)
+ (if (string-search " " to-strings)
(setq replacements
(append replacements
(list (substring to-strings 0
- (string-match " " to-strings))))
+ (string-search " " to-strings))))
to-strings (substring to-strings
- (1+ (string-match " " to-strings))))
+ (1+ (string-search " " to-strings))))
(setq replacements (append replacements (list to-strings))
to-strings ""))))
(perform-replace regexp replacements t t nil n nil start end nil region-noncontiguous-p)))
diff --git a/lisp/shell.el b/lisp/shell.el
index 5aab80d1031..292f267d2e1 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -1252,7 +1252,7 @@ Returns t if successful."
(list
start end
(lambda (string pred action)
- (if (string-match "/" string)
+ (if (string-search "/" string)
(completion-file-name-table string pred action)
(complete-with-action action completions string pred)))
:exit-function
@@ -1328,7 +1328,7 @@ Returns non-nil if successful."
(looking-at "\\$?[({]*")
(match-end 0)))
(variables (mapcar (lambda (x)
- (substring x 0 (string-match "=" x)))
+ (substring x 0 (string-search "=" x)))
process-environment))
(suffix (pcase (char-before start) (?\{ "}") (?\( ")") (_ ""))))
(list start end variables
diff --git a/lisp/simple.el b/lisp/simple.el
index 3ad8634975f..985beb06fc9 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4272,11 +4272,11 @@ the contents are inserted into the buffer anyway.
Optional arguments ACTION and FRAME are as for `display-buffer',
and are used only if a pop-up buffer is displayed."
- (cond ((and (stringp message) (not (string-match "\n" message)))
+ (cond ((and (stringp message) (not (string-search "\n" message)))
;; Trivial case where we can use the echo area
(message "%s" message))
((and (stringp message)
- (= (string-match "\n" message) (1- (length message))))
+ (= (string-search "\n" message) (1- (length message))))
;; Trivial case where we can just remove single trailing newline
(message "%s" (substring message 0 (1- (length message)))))
(t
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 34fbec9c218..3cc3e276067 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -3270,7 +3270,7 @@ Handles end-of-sublist smartly."
Clicking this button expands or contracts a directory. TEXT is the
button clicked which has either a + or -. TOKEN is the directory to be
expanded. INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this dir
+ (cond ((string-search "+" text) ;we have to expand this dir
(setq speedbar-shown-directories
(cons (expand-file-name
(concat (speedbar-line-directory indent) token "/"))
@@ -3283,7 +3283,7 @@ expanded. INDENT is the current indentation level."
(speedbar-default-directory-list
(concat (speedbar-line-directory indent) token "/")
(1+ indent)))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-reset-scanners)
(let ((oldl speedbar-shown-directories)
(newl nil)
@@ -3317,7 +3317,7 @@ INDENT is the current indentation level and is unused."
The parameter TEXT and TOKEN are required, where TEXT is the button
clicked, and TOKEN is the file to expand. INDENT is the current
indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(let* ((fn (expand-file-name (concat (speedbar-line-directory indent)
token)))
(lst (speedbar-fetch-dynamic-tags fn)))
@@ -3329,7 +3329,7 @@ indentation level."
(save-excursion
(end-of-line) (forward-char 1)
(funcall (car lst) indent (cdr lst)))))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
@@ -3358,14 +3358,14 @@ INDENT is the current indentation level."
"Expand a tag sublist. Imenu will return sub-lists of specialized tag types.
Etags does not support this feature. TEXT will be the button string.
TOKEN will be the list, and INDENT is the current indentation level."
- (cond ((string-match "\\+" text) ;we have to expand this file
+ (cond ((string-search "+" text) ;we have to expand this file
(speedbar-change-expand-button-char ?-)
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
(speedbar-insert-generic-list indent token 'speedbar-tag-expand
'speedbar-tag-find))))
- ((string-match "-" text) ;we have to contract this node
+ ((string-search "-" text) ;we have to contract this node
(speedbar-change-expand-button-char ?+)
(speedbar-delete-subblock indent))
(t (error "Ooops... not sure what to do")))
diff --git a/lisp/subr.el b/lisp/subr.el
index 87298b5cfde..1cae3ee1a60 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4808,7 +4808,7 @@ It understands Emacs Lisp quoting within STRING, such that
(split-string-and-unquote (combine-and-quote-strings strs)) == strs
The SEPARATOR regexp defaults to \"\\s-+\"."
(let ((sep (or separator "\\s-+"))
- (i (string-match "\"" string)))
+ (i (string-search "\"" string)))
(if (null i)
(split-string string sep t) ; no quoting: easy
(append (unless (eq i 0) (split-string (substring string 0 i) sep t))
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 3f0cca0ab7a..411c71cd8c4 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -962,7 +962,7 @@ return nil. Otherwise point is returned."
(new-buffer-file-name (expand-file-name
;; `:' is not allowed on Windows
(concat tarname "!"
- (if (string-match "/" name)
+ (if (string-search "/" name)
name
;; Make sure `name' contains a /
;; so set-auto-mode doesn't try
diff --git a/lisp/term.el b/lisp/term.el
index 27f0bb1be3b..b3870a814d2 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -3488,9 +3488,9 @@ The top-most line is line 0."
((= (aref string 0) ?\032)
;; gdb (when invoked with -fullname) prints:
;; \032\032FULLFILENAME:LINENUMBER:CHARPOS:BEG_OR_MIDDLE:PC\n
- (let* ((first-colon (string-match ":" string 1))
+ (let* ((first-colon (string-search ":" string 1))
(second-colon
- (string-match ":" string (1+ first-colon)))
+ (string-search ":" string (1+ first-colon)))
(filename (substring string 1 first-colon))
(fileline (string-to-number
(substring string (1+ first-colon) second-colon))))
@@ -4307,7 +4307,7 @@ well as the newer ports COM10 and higher."
(when (or (null x) (and (stringp x) (zerop (length x))))
(error "No serial port selected"))
(when (not (or (serial-port-is-file-p)
- (string-match "\\\\" x)))
+ (string-search "\\" x)))
(setq x (concat "\\\\.\\" x)))
x))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 31186fb4fac..5cece1aa3c6 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -3962,7 +3962,7 @@ Optional arg COMMA is as in `bibtex-enclosing-field'. It is t for
interactive calls."
(interactive (list nil t))
(unless field (setq field (car (bibtex-find-text-internal nil nil comma))))
- (if (string-match "@" field)
+ (if (string-search "@" field)
(cond ((bibtex-string= field "@string")
(message "String definition"))
((bibtex-string= field "@preamble")
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 4c64531ea35..67852998f42 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -2497,7 +2497,7 @@ if defined."
"Customize `ispell-alternate-dictionary' to set yours.")))
(let* ((process-connection-type ispell-use-ptys-p)
- (wild-p (string-match "\\*" word))
+ (wild-p (string-search "*" word))
(look-p (and ispell-look-p ; Only use look for an exact match.
(or ispell-have-new-look (not wild-p))))
(prog (if look-p ispell-look-command ispell-grep-command))
@@ -2560,7 +2560,7 @@ if defined."
(continue t)
end)
(while continue
- (setq end (string-match "\n" output start)) ; get text up to the newline.
+ (setq end (string-search "\n" output start)) ; get text up to the newline.
;; If we get out of sync and ispell-filter-continue is asserted when we
;; are not continuing, treat the next item as a separate list. When
;; ispell-filter-continue is asserted, ispell-filter *should* always be a
@@ -2732,11 +2732,11 @@ Optional third arg SHIFT is an offset to apply based on previous corrections."
(if (eq type ?#)
(setq count 0) ; no misses for type #
(setq count (string-to-number output) ; get number of misses.
- output (substring output (1+ (string-match " " output 1)))))
+ output (substring output (1+ (string-search " " output 1)))))
(setq offset (string-to-number output))
(setq output (if (eq type ?#) ; No miss or guess list.
nil
- (substring output (1+ (string-match " " output 1)))))
+ (substring output (1+ (string-search " " output 1)))))
(while output
(let ((end (string-match ", \\|\\($\\)" output))) ; end of miss/guess.
(setq cur-count (1+ cur-count))
@@ -4077,7 +4077,7 @@ Includes LaTeX/Nroff modes and extended character mode."
(ispell-send-string "+\n~tex\n"))
((string-match "nroff-mode" string)
(ispell-send-string "-\n~nroff\n"))
- ((string-match "~" string) ; Set extended character mode.
+ ((string-search "~" string) ; Set extended character mode.
(ispell-send-string (concat string "\n")))
(t (message "Invalid Ispell Parsing argument!")
(sit-for 2))))))))
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 650d11d4aca..895064b82f3 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -718,7 +718,7 @@ While entering the regexp, completion on knows citation keys is possible.
(insert string))
;; Reposition cursor?
- (when (string-match "\\?" string)
+ (when (string-search "?" string)
(search-backward "?")
(delete-char 1))
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index 0157f8443aa..9def10cee05 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -757,7 +757,7 @@ if the information is exact (t) or approximate (nil)."
(while (and (setq tail (memq (assq 'toc (cdr tail)) tail))
(setq entry (car tail))
(>= (nth 5 entry) level))
- (setq star (string-match "\\*" (nth 6 entry))
+ (setq star (string-search "*" (nth 6 entry))
context (nth 2 entry)
section-number
(reftex-section-number (nth 5 entry) star))
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index 611102ecbac..19081825931 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -798,7 +798,7 @@ When called with 2 C-u prefix args, disable magic word recognition."
(push (cons (current-buffer) buffer-invisibility-spec)
reftex-buffers-with-changed-invisibility)
(setq buffer-invisibility-spec nil))
- ((string-match "\r" (buffer-substring beg end))
+ ((string-search "\r" (buffer-substring beg end))
;; Invisible with selective display. We need to copy it.
(let ((string (buffer-substring-no-properties beg end)))
(switch-to-buffer "*RefTeX Context Copy*")
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index c732299361c..1cb2cf40c3b 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -813,7 +813,7 @@ This enforces rescanning the buffer on next use."
(setq wordlist (nthcdr 4 entry)))
(if (and (stringp fmt)
- (string-match "@" fmt))
+ (string-search "@" fmt))
;; Special syntax for specifying a label format
(setq fmt (split-string fmt "@+"))
(setq fmt (list "\\label{%s}" fmt)))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index d9d8059f960..5169377c136 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -2072,7 +2072,7 @@ Return the process in which TeX is running."
(let* ((cmd (eval command t))
(proc (tex-shell-proc))
(buf (process-buffer proc))
- (star (string-match "\\*" cmd))
+ (star (string-search "*" cmd))
(string
(concat
(if (null file)
@@ -2474,7 +2474,7 @@ Only applies the FSPEC to the args part of FORMAT."
(defun tex-start-tex (command file &optional dir)
"Start a TeX run, using COMMAND on FILE."
- (let* ((star (string-match "\\*" command))
+ (let* ((star (string-search "*" command))
(compile-command
(if star
(concat (substring command 0 star)
@@ -2773,7 +2773,7 @@ so normally SUFFIX starts with one."
;; Not found, so split on first period.
(concat (file-name-directory file-name)
(substring file 0
- (string-match "\\." file))
+ (string-search "." file))
suffix)))
" "))
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 5bbf1a85b36..66bbfb0f9f6 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -492,7 +492,7 @@ looks like an email address, \"ftp://\" if it starts with
(and (string-match "\\`[[:alnum:]]+\\'" str)
(eq (char-before (car bounds)) ?<)
(eq (char-after (cdr bounds)) ?>)
- (not (string-match "~" (expand-file-name (concat "~" str))))
+ (not (string-search "~" (expand-file-name (concat "~" str))))
(setq str (concat "mailto:" str)))
;; If it looks like news.example.com, treat it as news.
(if (thing-at-point-newsgroup-p str)
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 2040f522700..71082bd2f4b 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -268,7 +268,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
(cdr elt)))
(t
(let* ((str (car elt))
- (paren (string-match "(" str))
+ (paren (string-search "(" str))
(pos 0) (word 0) char)
(catch 'done ; ??? is this slow?
(while (and (or (not tmm-shortcut-words) ; no limit on words
diff --git a/lisp/transient.el b/lisp/transient.el
index 4087a0c68a6..5f441e80ddd 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -3073,7 +3073,7 @@ Optional support for popup buttons is also implemented here."
;; the definition, then we want to drop the space that
;; is reinserted above. False-positives are possible
;; for silly bindings like "-C-c C-c".
- (unless (string-match-p " " key)
+ (unless (string-search " " key)
(setq pre (string-replace " " "" pre))
(setq suf (string-replace " " "" suf)))
(concat (propertize pre 'face 'default)
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index f291414e81b..06cfacc99d6 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -102,10 +102,10 @@ instead of the filename inheritance method."
(byserv
(setq retval (cdr-safe (assoc file byserv)))
(if (and (not retval)
- (string-match "/" file))
+ (string-search "/" file))
(while (and byserv (not retval))
(setq data (car (car byserv)))
- (if (or (not (string-match "/" data)) ; It's a realm - take it!
+ (if (or (not (string-search "/" data)) ; It's a realm - take it!
(and
(>= (length file) (length data))
(string= data (substring file 0 (length data)))))
@@ -251,12 +251,12 @@ a match."
(assoc dirkey keylist)
;; No exact match found. Continue to look for partial match if
;; dirkey is not a realm.
- (and (string-match "/" dirkey)
+ (and (string-search "/" dirkey)
(let (match)
(while (and (null match) keylist)
(if (or
;; Any realm candidate matches. Why?
- (not (string-match "/" (caar keylist)))
+ (not (string-search "/" (caar keylist)))
;; Parent directory matches.
(string-prefix-p (caar keylist) dirkey))
(setq match (car keylist))
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 49cc587590e..4fe909cadbc 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -106,7 +106,7 @@
(article (url-unhex-string (url-filename url))))
(url-news-open-host host port (url-user url) (url-password url))
(cond
- ((string-match "@" article) ; Its a specific article
+ ((string-search "@" article) ; Its a specific article
(setq buf (url-news-fetch-message-id host article)))
((string= article "") ; List all newsgroups
(gnus))
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 8b79736d004..113ac2833bc 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -252,7 +252,7 @@ Will not do anything if `url-show-status' is nil."
(while pairs
(setq cur (car pairs)
pairs (cdr pairs))
- (unless (string-match "=" cur)
+ (unless (string-search "=" cur)
(setq cur (concat cur "=")))
(when (string-match "=" cur)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index ef607133e86..c8f36fb76ec 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -1173,7 +1173,7 @@ is non-nil."
(mtime (file-attribute-modification-time (file-attributes file)))
(parsed-time (progn (require 'parse-time)
(parse-time-string (concat time " +0000")))))
- (cond ((and (not (string-match "\\+" time))
+ (cond ((and (not (string-search "+" time))
(decoded-time-second parsed-time)
;; Compare just the seconds part of the file time,
;; since CVS file time stamp resolution is just 1 second.
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 54b71c9f9f6..7ce0633b40b 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -218,7 +218,7 @@ Nothing is assumed about value."
(error (prin1-to-string signal)))))
(when (string-match "\n\\'" pp)
(setq pp (substring pp 0 (1- (length pp)))))
- (if (cond ((string-match "\n" pp)
+ (if (cond ((string-search "\n" pp)
nil)
((> (length pp) (- (window-width) (current-column)))
nil)
diff --git a/lisp/woman.el b/lisp/woman.el
index 0bc992d8f7f..fe9f8969c3e 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -418,7 +418,7 @@ As a special case, if PATHS is nil then replace it by calling
(if (memq system-type '(windows-nt ms-dos))
(cond ((null paths)
(mapcar #'woman-Cyg-to-Win (woman-parse-man.conf)))
- ((string-match-p ";" paths)
+ ((string-search ";" paths)
;; Assume DOS-style path-list...
(mapcan ; splice list into list
(lambda (x)
@@ -1939,12 +1939,12 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
(setq symbol (car p)) ; 1. name
(if (functionp symbol) ; 2. command doc
(if (setq doc (documentation symbol t))
- (substring doc 0 (string-match "\n" doc))
+ (substring doc 0 (string-search "\n" doc))
"(not documented)"))
(if (custom-variable-p symbol) ; 3. variable doc
(if (setq doc (documentation-property
symbol 'variable-documentation t))
- (substring doc 0 (string-match "\n" doc))))))
+ (substring doc 0 (string-search "\n" doc))))))
(setq p (cdr p))))
;; Output the result:
(and (apropos-print t nil)
@@ -1955,7 +1955,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
(defun WoMan-getpage-in-background (topic)
"Use TOPIC to start WoMan from `Man-follow-manual-reference'."
;; topic is a string, generally of the form "section topic"
- (let ((s (string-match " " topic)))
+ (let ((s (string-search " " topic)))
(if s (setq topic (substring topic (1+ s))))
(woman topic)))
@@ -3840,7 +3840,7 @@ Leave 1 blank line. Format paragraphs upto TO."
((eolp) ; extend line
;; Insert character INCLUDING TEXT PROPERTIES:
;; (insert (substring overlap i (1+ i)))
- (let ((eol (string-match "\n" overlap i)))
+ (let ((eol (string-search "\n" overlap i)))
(insert (substring overlap i eol))
(setq i (or eol imax)))
)
diff --git a/lisp/xml.el b/lisp/xml.el
index 4e2dd13ecbd..1b2d6557388 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -922,11 +922,11 @@ references and parameter-entity references."
(progn
(setq elem (match-string-no-properties 1 string)
modifier (match-string-no-properties 2 string))
- (if (string-match-p "|" elem)
+ (if (string-search "|" elem)
(setq elem (cons 'choice
(mapcar 'xml-parse-elem-type
(split-string elem "|"))))
- (if (string-match-p "," elem)
+ (if (string-search "," elem)
(setq elem (cons 'seq
(mapcar 'xml-parse-elem-type
(split-string elem ",")))))))
diff --git a/test/lisp/emacs-lisp/check-declare-tests.el b/test/lisp/emacs-lisp/check-declare-tests.el
index 9552bf0e397..276530fb4d3 100644
--- a/test/lisp/emacs-lisp/check-declare-tests.el
+++ b/test/lisp/emacs-lisp/check-declare-tests.el
@@ -106,11 +106,11 @@
(let ((res (buffer-string)))
;; Don't care too much about the format of the output, but
;; check that key information is present.
- (should (string-match-p "foo-file" res))
- (should (string-match-p "foo-fun" res))
- (should (string-match-p "bar-file" res))
- (should (string-match-p "it wasn't" res))
- (should (string-match-p "999" res))))))
+ (should (string-search "foo-file" res))
+ (should (string-search "foo-fun" res))
+ (should (string-search "bar-file" res))
+ (should (string-search "it wasn't" res))
+ (should (string-search "999" res))))))
(provide 'check-declare-tests)
;;; check-declare-tests.el ends here
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index db93250b17b..fb24b98595b 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -610,7 +610,7 @@ unquoted file names."
(ert-deftest files-tests-file-name-non-special-dired-compress-handler ()
;; `dired-compress-file' can get confused by filenames with ":" in
;; them, which causes this to fail on `windows-nt' systems.
- (when (string-match-p ":" (expand-file-name temporary-file-directory))
+ (when (string-search ":" (expand-file-name temporary-file-directory))
(ert-skip "FIXME: `dired-compress-file' unreliable when filenames contain `:'."))
(files-tests--with-temp-non-special (tmpfile nospecial)
(let ((compressed (dired-compress-file nospecial)))
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index 1a4cc744f0c..4a0b23dd26f 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -128,7 +128,7 @@
(when prev
(setq string (concat prev string))
(process-put proc 'previous-string nil)))
- (if (and (not (string-match "\n" string))
+ (if (and (not (string-search "\n" string))
(> (length string) 0))
(process-put proc 'previous-string string))
(let ((command (split-string string)))
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 0309b2b1ad6..134f5676709 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -56,7 +56,7 @@
(set-buffer-multibyte nil)
(insert (encode-coding-string "ă" 'euc-jp) "\xd" "\n")
(decode-coding-region (point-min) (point-max) 'euc-jp-dos)
- (should-not (string-match-p "\^M" (buffer-string)))))
+ (should-not (string-search "\^M" (buffer-string)))))
;; Return the contents (specified by CONTENT-TYPE; ascii, latin, or
;; binary) of a test file.
--
cgit v1.2.3
From 681faf9f0bc41972932b72ef34c026419b6eb54d Mon Sep 17 00:00:00 2001
From: Tino Calancha <ccalancha@suse.com>
Date: Fri, 20 Aug 2021 18:07:19 +0200
Subject: ; * test/lisp/files-tests.el: Add tests for save-some-buffers
(Bug#46374)
---
test/lisp/files-tests.el | 214 +++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 214 insertions(+)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index fb24b98595b..d50a1f19c2e 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1560,5 +1560,219 @@ The door of all subtleties!
(find-file (ert-resource-file "auto-test.zot3"))
(should (eq major-mode 'fundamental-mode)))
+(defun files-tests--save-some-buffers (pred def-pred-bind exp-1 exp-2)
+ "Helper function to test `save-some-buffers'.
+
+This function creates two visiting-file buffers, BUF-1, BUF-2 in
+ different directories at the same level, i.e., none of them is a
+ subdir of the other; then, it modifies both buffers; finally, it calls
+ `save-some-buffers' from BUF-1 with first arg t, second arg PRED
+ and `save-some-buffers-default-predicate' let-bound to
+ DEF-PRED-BIND.
+
+EXP-1 and EXP-2 are the expected values of calling `buffer-modified-p'
+on BUF-1 and BUF-2 after the `save-some-buffers' call.
+
+The test is repeated with `save-some-buffers-default-predicate'
+let-bound to PRED and passing nil as second arg of
+`save-some-buffers'."
+ (let* ((dir (make-temp-file "testdir" 'dir))
+ (file-1 (expand-file-name "subdir-1/file.foo" dir))
+ (file-2 (expand-file-name "subdir-2/file.bar" dir))
+ (inhibit-message t)
+ buf-1 buf-2)
+ (unwind-protect
+ (progn
+ (make-empty-file file-1 'parens)
+ (make-empty-file file-2 'parens)
+ (setq buf-1 (find-file file-1)
+ buf-2 (find-file file-2))
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf (insert "foobar\n")))
+ ;; Run the test.
+ (with-current-buffer buf-1
+ (let ((save-some-buffers-default-predicate def-pred-bind))
+ (save-some-buffers t pred))
+ (should (eq exp-1 (buffer-modified-p buf-1)))
+ (should (eq exp-2 (buffer-modified-p buf-2))))
+ ;; Set both buffers as modified to run another test.
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf (set-buffer-modified-p t)))
+ ;; The result of this test must be identical as the previous one.
+ (with-current-buffer buf-1
+ (let ((save-some-buffers-default-predicate (or pred def-pred-bind)))
+ (save-some-buffers t nil))
+ (should (eq exp-1 (buffer-modified-p buf-1)))
+ (should (eq exp-2 (buffer-modified-p buf-2)))))
+ ;; Clean up.
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))
+ (delete-directory dir 'recursive))))
+
+(ert-deftest files-tests-save-some-buffers ()
+ "Test `save-some-buffers'.
+Test the 3 cases for the second argument PRED, i.e., nil, t or
+predicate.
+The value of `save-some-buffers-default-predicate' is ignored unless
+PRED is nil."
+ (let* ((foo-file-p (lambda () (string-suffix-p ".foo" buffer-file-name)))
+ (bar-file-p (lambda () (string-suffix-p ".bar" buffer-file-name)))
+ (args-results `((nil nil nil nil)
+ (nil ,foo-file-p nil t)
+ (nil ,bar-file-p t nil)
+ (,foo-file-p nil nil t)
+ (,bar-file-p nil t nil)
+
+ (buffer-modified-p nil nil nil)
+ (t nil nil nil)
+ (t ,foo-file-p nil nil)
+
+ (,foo-file-p save-some-buffers-root nil t)
+ (nil save-some-buffers-root nil t)
+ (,bar-file-p save-some-buffers-root t nil)
+ (t save-some-buffers-root nil nil))))
+ (pcase-dolist (`(,pred ,def-pred-bind ,exp-1 ,exp-2) args-results)
+ (files-tests--save-some-buffers pred def-pred-bind exp-1 exp-2))))
+
+(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results)
+ "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'.
+
+This macro creates several non-visiting-file buffers in different
+ directories at the same level, i.e., none of them is a subdir of the
+ other; then, it modifies the buffers and sets their `buffer-offer-save'
+ as specified by BUFFERS-OFFER, a list of elements
+ (BUFFER OFFER-SAVE). Finally, it calls FN-TEST from the first
+ buffer.
+
+FN-TEST is the function to test: either `save-some-buffers' or
+`save-buffers-kill-emacs'. This function is called with
+`save-some-buffers-default-predicate' let-bound to a value
+specified inside ARGS-RESULTS.
+
+FN-BINDERS is a list of elements (FUNCTION . BINDING), where FUNCTION
+is a function symbol that this macro temporary binds to BINDING during
+the FN-TEST call.
+
+ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where
+ FN-ARGS are the arguments for FN-TEST;
+ CALLERS-DIR specifies the value to let-bind
+`save-some-buffers-default-predicate';
+ EXPECTED is the expected result of the test."
+ (declare (debug (form symbol form form)))
+ (let ((dir (gensym "dir"))
+ (buffers (gensym "buffers")))
+ `(let* ((,dir (make-temp-file "testdir" 'dir))
+ (inhibit-message t)
+ (use-dialog-box nil)
+ ,buffers)
+ (pcase-dolist (`(,bufsym ,offer-save) ,buffers-offer)
+ (let* ((buf (generate-new-buffer (symbol-name bufsym)))
+ (subdir (expand-file-name
+ (format "subdir-%s" (buffer-name buf))
+ ,dir)))
+ (make-directory subdir 'parens)
+ (push buf ,buffers)
+ (with-current-buffer buf
+ (cd subdir)
+ (setq buffer-offer-save offer-save)
+ (insert "foobar\n"))))
+ (setq ,buffers (nreverse ,buffers))
+ (let ((nb-saved-buffers 0))
+ (unwind-protect
+ (pcase-dolist (`(,fn-test-args ,callers-dir ,expected)
+ ,args-results)
+ (setq nb-saved-buffers 0)
+ (with-current-buffer (car ,buffers)
+ (cl-letf
+ (,@(mapcar (lambda (pair) `((symbol-function ,(car pair)) ,(cdr pair)))
+ fn-binders)
+ (save-some-buffers-default-predicate callers-dir))
+ (apply #',fn-test fn-test-args)
+ (should (equal nb-saved-buffers expected)))))
+ ;; Clean up.
+ (dolist (buf ,buffers)
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))
+ (delete-directory ,dir 'recursive))))))
+
+(defmacro files-tests-with-all-permutations (permutation list &rest body)
+ "Execute BODY forms for all permutations of LIST.
+Execute the forms with the symbol PERMUTATION bound to the current
+permutation."
+ (declare (indent 2) (debug (symbol form body)))
+ (let ((vec (gensym "vec")))
+ `(let ((,vec (vconcat ,list)))
+ (cl-labels ((swap (,vec i j)
+ (let ((tmp (aref ,vec j)))
+ (aset ,vec j (aref ,vec i))
+ (aset ,vec i tmp)))
+ (permute (,vec l r)
+ (if (= l r)
+ (let ((,permutation (append ,vec nil)))
+ ,@body)
+ (cl-loop for idx from l below (1+ r) do
+ (swap ,vec idx l)
+ (permute ,vec (1+ l) r)
+ (swap ,vec idx l)))))
+ (permute ,vec 0 (1- (length ,vec)))))))
+
+(ert-deftest files-tests-buffer-offer-save ()
+ "Test `save-some-buffers' for non-visiting buffers.
+Check the behavior of `save-some-buffers' for non-visiting-file
+buffers under several values of `buffer-offer-save'.
+The value of `save-some-buffers-default-predicate' is ignored unless
+PRED is nil."
+ (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil)))
+ (nb-might-save
+ (length
+ (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init)))
+ (nb-always-save
+ (length
+ (cl-remove-if-not (lambda (l) (eq 'always (cadr l))) buffers-offer-init))))
+ (files-tests-with-all-permutations
+ buffers-offer
+ buffers-offer-init
+ (dolist (pred `(nil t save-some-buffers-root))
+ (dolist (callers-dir `(nil save-some-buffers-root))
+ (let* ((head-offer (cadar buffers-offer))
+ (res (cond ((null pred)
+ (if (null callers-dir) nb-always-save (or (and head-offer 1) 0)))
+ (t
+ ;; Save any buffer with `buffer-offer-save' non-nil.
+ (if (eq pred t) nb-might-save
+ ;; Restrict to caller's dir.
+ (or (and head-offer 1) 0)))))
+ (args-res `(((nil ,pred) ,callers-dir ,res))))
+ (files-tests--with-buffer-offer-save
+ buffers-offer
+ save-some-buffers
+ ;; Increase counter and answer 'n' when prompted to save a buffer.
+ (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n)))
+ args-res)))))))
+
+(ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers ()
+ "Test that `save-buffers-kill-emacs' asks to save buffers as expected.
+Prompt users for any modified buffer with `buffer-offer-save' non-nil."
+ (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil)))
+ (nb-might-save
+ (length
+ (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init))))
+ (files-tests-with-all-permutations
+ buffers-offer
+ buffers-offer-init
+ (files-tests--with-buffer-offer-save
+ buffers-offer
+ save-buffers-kill-emacs
+ ;; Increase counter and answer 'n' when prompted to save a buffer.
+ (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n))
+ ('kill-emacs . #'ignore)) ; Do not kill Emacs.
+ `((nil nil ,nb-might-save)
+ ;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored.
+ (nil save-some-buffers-root ,nb-might-save))))))
+
+
(provide 'files-tests)
;;; files-tests.el ends here
--
cgit v1.2.3
From 9191d127425ea305ca33918efed80cbcdcf101fa Mon Sep 17 00:00:00 2001
From: Eli Zaretskii <eliz@gnu.org>
Date: Sat, 21 Aug 2021 10:22:45 +0300
Subject: Fix documentation of recently-added tests for files.el
* test/lisp/files-tests.el (files-tests--save-some-buffers)
(files-tests-save-some-buffers)
(files-tests--with-buffer-offer-save)
(files-tests-buffer-offer-save): Doc fixes.
---
test/lisp/files-tests.el | 35 +++++++++++++++++------------------
1 file changed, 17 insertions(+), 18 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index d50a1f19c2e..174ec5b074d 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1563,12 +1563,12 @@ The door of all subtleties!
(defun files-tests--save-some-buffers (pred def-pred-bind exp-1 exp-2)
"Helper function to test `save-some-buffers'.
-This function creates two visiting-file buffers, BUF-1, BUF-2 in
- different directories at the same level, i.e., none of them is a
- subdir of the other; then, it modifies both buffers; finally, it calls
- `save-some-buffers' from BUF-1 with first arg t, second arg PRED
- and `save-some-buffers-default-predicate' let-bound to
- DEF-PRED-BIND.
+This function creates two file-visiting buffers, BUF-1, BUF-2 in
+different directories at the same level, i.e., none of them is a
+subdir of the other; then it modifies both buffers; finally, it
+calls `save-some-buffers' from BUF-1 with first arg t, second
+arg PRED and `save-some-buffers-default-predicate' let-bound to
+DEF-PRED-BIND.
EXP-1 and EXP-2 are the expected values of calling `buffer-modified-p'
on BUF-1 and BUF-2 after the `save-some-buffers' call.
@@ -1613,7 +1613,7 @@ let-bound to PRED and passing nil as second arg of
(ert-deftest files-tests-save-some-buffers ()
"Test `save-some-buffers'.
-Test the 3 cases for the second argument PRED, i.e., nil, t or
+Test the 3 cases for the second argument PRED, i.e., nil, t, or
predicate.
The value of `save-some-buffers-default-predicate' is ignored unless
PRED is nil."
@@ -1639,12 +1639,11 @@ PRED is nil."
(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results)
"Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'.
-This macro creates several non-visiting-file buffers in different
- directories at the same level, i.e., none of them is a subdir of the
- other; then, it modifies the buffers and sets their `buffer-offer-save'
- as specified by BUFFERS-OFFER, a list of elements
- (BUFFER OFFER-SAVE). Finally, it calls FN-TEST from the first
- buffer.
+This macro creates several non-file-visiting buffers in different
+directories at the same level, i.e., none of them is a subdir of the
+other. Then it modifies the buffers and sets their `buffer-offer-save'
+as specified by BUFFERS-OFFER, a list of elements (BUFFER OFFER-SAVE).
+Finally, it calls FN-TEST from the first buffer.
FN-TEST is the function to test: either `save-some-buffers' or
`save-buffers-kill-emacs'. This function is called with
@@ -1656,9 +1655,9 @@ is a function symbol that this macro temporary binds to BINDING during
the FN-TEST call.
ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR EXPECTED), where
- FN-ARGS are the arguments for FN-TEST;
- CALLERS-DIR specifies the value to let-bind
-`save-some-buffers-default-predicate';
+FN-ARGS are the arguments for FN-TEST;
+CALLERS-DIR specifies the value to let-bind
+\`save-some-buffers-default-predicate';
EXPECTED is the expected result of the test."
(declare (debug (form symbol form form)))
(let ((dir (gensym "dir"))
@@ -1720,8 +1719,8 @@ permutation."
(permute ,vec 0 (1- (length ,vec)))))))
(ert-deftest files-tests-buffer-offer-save ()
- "Test `save-some-buffers' for non-visiting buffers.
-Check the behavior of `save-some-buffers' for non-visiting-file
+ "Test `save-some-buffers' for non-file-visiting buffers.
+Check the behavior of `save-some-buffers' for non-file-visiting
buffers under several values of `buffer-offer-save'.
The value of `save-some-buffers-default-predicate' is ignored unless
PRED is nil."
--
cgit v1.2.3
From efe30626e605e1b8a8601305d17596a120001640 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sat, 21 Aug 2021 17:45:24 +0200
Subject: Fix failures in recent files tests
* test/lisp/files-tests.el (files-tests-buffer-offer-save)
(files-tests-save-buffers-kill-emacs--asks-to-save-buffers):
`read-event' is called with arguments.
---
test/lisp/files-tests.el | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 174ec5b074d..aa5150b4b73 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1749,7 +1749,7 @@ PRED is nil."
buffers-offer
save-some-buffers
;; Increase counter and answer 'n' when prompted to save a buffer.
- (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n)))
+ (('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n)))
args-res)))))))
(ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers ()
@@ -1766,7 +1766,7 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil."
buffers-offer
save-buffers-kill-emacs
;; Increase counter and answer 'n' when prompted to save a buffer.
- (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n))
+ (('read-event . (lambda (&rest _) (cl-incf nb-saved-buffers) ?n))
('kill-emacs . #'ignore)) ; Do not kill Emacs.
`((nil nil ,nb-might-save)
;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored.
--
cgit v1.2.3
From 6ad77d36fd3f1a0080157c2064932e100ba6ad88 Mon Sep 17 00:00:00 2001
From: Mattias EngdegÄrd <mattiase@acm.org>
Date: Wed, 22 Sep 2021 15:40:29 +0200
Subject: Don't rely on lexical-binding being nil in tests
* test/lisp/button-tests.el (button--help-echo-form):
* test/lisp/files-tests.el (files-tests-permanent-local-variables):
Remove assumption that `with-temp-buffer` creates a buffer
where `lexical-binding` is nil.
---
test/lisp/button-tests.el | 1 +
test/lisp/files-tests.el | 2 ++
2 files changed, 3 insertions(+)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el
index e0944afa344..2f5ad795df2 100644
--- a/test/lisp/button-tests.el
+++ b/test/lisp/button-tests.el
@@ -59,6 +59,7 @@
"Test `button--help-echo' with forms."
(with-temp-buffer
;; Test text property buttons with dynamic scoping.
+ (setq lexical-binding nil)
(let* ((help (make-symbol "help"))
(form `(funcall (let ((,help "lexical form"))
(lambda () ,help))))
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index aa5150b4b73..b283a512a42 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -154,12 +154,14 @@ form.")
(ert-deftest files-tests-permanent-local-variables ()
(let ((enable-local-variables nil))
(with-temp-buffer
+ (setq lexical-binding nil)
(insert ";;; test-test.el --- tests -*- lexical-binding: t; -*-\n\n")
(hack-local-variables)
(should (eq lexical-binding t))))
(let ((enable-local-variables nil)
(permanently-enabled-local-variables nil))
(with-temp-buffer
+ (setq lexical-binding nil)
(insert ";;; test-test.el --- tests -*- lexical-binding: t; -*-\n\n")
(hack-local-variables)
(should (eq lexical-binding nil)))))
--
cgit v1.2.3
From e89b94f46d8a0ef3a270c31f3129eb8b4c8da646 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Wed, 27 Oct 2021 05:34:52 +0200
Subject: Add test for file-name-base
* test/lisp/files-tests.el (files-tests-file-name-base): New test.
---
test/lisp/files-tests.el | 9 +++++++++
1 file changed, 9 insertions(+)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index b283a512a42..c8b80e36601 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1551,6 +1551,15 @@ The door of all subtleties!
(should-error (file-name-with-extension "Jack" "."))
(should-error (file-name-with-extension "/is/a/directory/" "css")))
+(ert-deftest files-tests-file-name-base ()
+ (should (equal (file-name-base) "files-tests"))
+ (should (equal (file-name-base "") ""))
+ (should (equal (file-name-base "/foo/") ""))
+ (should (equal (file-name-base "/foo") "foo"))
+ (should (equal (file-name-base "/foo/bar") "bar"))
+ (should (equal (file-name-base "foo") "foo"))
+ (should (equal (file-name-base "foo/bar") "bar")))
+
(ert-deftest files-test-dir-locals-auto-mode-alist ()
"Test an `auto-mode-alist' entry in `.dir-locals.el'"
(find-file (ert-resource-file "whatever.quux"))
--
cgit v1.2.3
From 4febba2c61722817ed2da0c775ac8b6acc4d1afa Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Wed, 27 Oct 2021 07:05:33 +0200
Subject: ; * test/lisp/files-tests.el: Fix last commit.
---
test/lisp/files-tests.el | 1 -
1 file changed, 1 deletion(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index c8b80e36601..4b9d4e45164 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1552,7 +1552,6 @@ The door of all subtleties!
(should-error (file-name-with-extension "/is/a/directory/" "css")))
(ert-deftest files-tests-file-name-base ()
- (should (equal (file-name-base) "files-tests"))
(should (equal (file-name-base "") ""))
(should (equal (file-name-base "/foo/") ""))
(should (equal (file-name-base "/foo") "foo"))
--
cgit v1.2.3
From 83422370c87000f3d6d89320d4947c24325c9ad2 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Sat, 6 Nov 2021 16:05:02 +0100
Subject: Replace some macros with ert-with-temp-(file|directory)
* test/lisp/custom-tests.el (custom-tests--with-temp-dir):
* test/lisp/files-tests.el (files-tests--with-temp-file):
* test/lisp/progmodes/project-tests.el
(project-tests--with-temporary-directory):
* test/src/emacs-module-tests.el (module--with-temp-directory):
* test/src/emacs-tests.el (emacs-tests--with-temp-file):
* test/src/lread-tests.el (lread-tests--with-temp-file):
* test/src/process-tests.el (process-tests--with-temp-directory):
Replace macros with 'ert-with-temp-(file|directory)'. Update callers.
---
test/lisp/custom-tests.el | 15 ++-------------
test/lisp/files-tests.el | 16 ++++------------
test/lisp/progmodes/project-tests.el | 20 ++++----------------
test/src/emacs-module-tests.el | 16 +---------------
test/src/emacs-tests.el | 30 ++++++++----------------------
test/src/lread-tests.el | 10 +---------
test/src/process-tests.el | 15 ++-------------
7 files changed, 22 insertions(+), 100 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index f4c43b0a148..6ebf2d53bad 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -25,20 +25,9 @@
(require 'wid-edit)
(require 'cus-edit)
-(defmacro custom-tests--with-temp-dir (&rest body)
- "Eval BODY with `temporary-file-directory' bound to a fresh directory.
-Ensure the directory is recursively deleted after the fact."
- (declare (debug t) (indent 0))
- (let ((dir (make-symbol "dir")))
- `(let ((,dir (file-name-as-directory (make-temp-file "custom-tests-" t))))
- (unwind-protect
- (let ((temporary-file-directory ,dir))
- ,@body)
- (delete-directory ,dir t)))))
-
(ert-deftest custom-theme--load-path ()
"Test `custom-theme--load-path' behavior."
- (custom-tests--with-temp-dir
+ (ert-with-temp-directory temporary-file-directory
;; Path is empty.
(let ((custom-theme-load-path ()))
(should (null (custom-theme--load-path))))
@@ -97,7 +86,7 @@ Ensure the directory is recursively deleted after the fact."
(ert-deftest custom-tests-require-theme ()
"Test `require-theme'."
(require 'warnings)
- (custom-tests--with-temp-dir
+ (ert-with-temp-directory temporary-file-directory
(let* ((default-directory temporary-file-directory)
(custom-theme-load-path (list default-directory))
(load-path ()))
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 4b9d4e45164..f2a6e062acc 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -341,14 +341,6 @@ be $HOME."
(progn ,@body)
(advice-remove #',symbol ,function)))))
-(defmacro files-tests--with-temp-file (name &rest body)
- (declare (indent 1) (debug (symbolp body)))
- (cl-check-type name symbol)
- `(let ((,name (make-temp-file "emacs")))
- (unwind-protect
- (progn ,@body)
- (delete-file ,name))))
-
(ert-deftest files-tests-file-name-non-special--buffers ()
"Check that Bug#25951 is fixed.
We call `verify-visited-file-modtime' on a buffer visiting a file
@@ -357,7 +349,7 @@ the buffer current and a nil argument, second passing the buffer
object explicitly. In both cases no error should be raised and
the `file-name-non-special' handler for quoted file names should
be invoked with the right arguments."
- (files-tests--with-temp-file temp-file-name
+ (ert-with-temp-file temp-file-name
(with-temp-buffer
(let* ((buffer-visiting-file (current-buffer))
(actual-args ())
@@ -1318,7 +1310,7 @@ name (Bug#28412)."
(set-buffer-modified-p t)
(should-error (save-buffer) :type 'error))
;; Then a buffer visiting a file: should save normally.
- (files-tests--with-temp-file temp-file-name
+ (ert-with-temp-file temp-file-name
(with-current-buffer (find-file-noselect temp-file-name)
(setq write-contents-functions nil)
(insert "p")
@@ -1509,7 +1501,7 @@ The door of all subtleties!
(ert-deftest files-tests-revert-buffer ()
"Test that revert-buffer is successful."
- (files-tests--with-temp-file temp-file-name
+ (ert-with-temp-file temp-file-name
(with-temp-buffer
(insert files-tests-lao)
(write-file temp-file-name)
@@ -1522,7 +1514,7 @@ The door of all subtleties!
(ert-deftest files-tests-revert-buffer-with-fine-grain ()
"Test that revert-buffer-with-fine-grain is successful."
- (files-tests--with-temp-file temp-file-name
+ (ert-with-temp-file temp-file-name
(with-temp-buffer
(insert files-tests-lao)
(write-file temp-file-name)
diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el
index 1e3f258ac2a..a469414a743 100644
--- a/test/lisp/progmodes/project-tests.el
+++ b/test/lisp/progmodes/project-tests.el
@@ -29,29 +29,17 @@
(require 'cl-lib)
(require 'ert)
+(require 'ert-x) ; ert-with-temp-directory
(require 'grep)
(require 'xref)
-(defmacro project-tests--with-temporary-directory (var &rest body)
- "Create a new temporary directory.
-Bind VAR to the name of the directory, and evaluate BODY. Delete
-the directory after BODY exits."
- (declare (debug (symbolp body)) (indent 1))
- (cl-check-type var symbol)
- (let ((directory (make-symbol "directory")))
- `(let ((,directory (make-temp-file "project-tests-" :directory)))
- (unwind-protect
- (let ((,var ,directory))
- ,@body)
- (delete-directory ,directory :recursive)))))
-
(ert-deftest project/quoted-directory ()
"Check that `project-files' and `project-find-regexp' deal with
quoted directory names (Bug#47799)."
(skip-unless (executable-find find-program))
(skip-unless (executable-find "xargs"))
(skip-unless (executable-find "grep"))
- (project-tests--with-temporary-directory directory
+ (ert-with-temp-directory directory
(let ((default-directory directory)
(project-current-inhibit-prompt t)
(project-find-functions nil)
@@ -95,7 +83,7 @@ quoted directory names (Bug#47799)."
returned by `project-ignores' if the root directory is a
directory name (Bug#48471)."
(skip-unless (executable-find find-program))
- (project-tests--with-temporary-directory dir
+ (ert-with-temp-directory dir
(make-empty-file (expand-file-name "some-file" dir))
(make-empty-file (expand-file-name "ignored-file" dir))
(let* ((project (make-project-tests--trivial
@@ -111,7 +99,7 @@ directory name (Bug#48471)."
"Check that `project-files' does not ignore all files.
When `project-ignores' includes a name matching project dir."
(skip-unless (executable-find find-program))
- (project-tests--with-temporary-directory dir
+ (ert-with-temp-directory dir
(make-empty-file (expand-file-name "some-file" dir))
(let* ((project (make-project-tests--trivial
:root (file-name-as-directory dir)
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 9765bb109f6..442bca5facb 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -211,20 +211,6 @@ changes."
(should (equal (help-function-arglist #'mod-test-sum)
'(arg1 arg2))))
-(defmacro module--with-temp-directory (name &rest body)
- "Bind NAME to the name of a temporary directory and evaluate BODY.
-NAME must be a symbol. Delete the temporary directory after BODY
-exits normally or non-locally. NAME will be bound to the
-directory name (not the directory file name) of the temporary
-directory."
- (declare (indent 1))
- (cl-check-type name symbol)
- `(let ((,name (file-name-as-directory
- (make-temp-file "emacs-module-test" :directory))))
- (unwind-protect
- (progn ,@body)
- (delete-directory ,name :recursive))))
-
(defmacro module--test-assertion (pattern &rest body)
"Test that PATTERN matches the assertion triggered by BODY.
Run Emacs as a subprocess, load the test module `mod-test-file',
@@ -233,7 +219,7 @@ assertion message that matches PATTERN. PATTERN is evaluated and
must evaluate to a regular expression string."
(declare (indent 1))
;; To contain any core dumps.
- `(module--with-temp-directory tempdir
+ `(ert-with-temp-directory tempdir
(with-temp-buffer
(let* ((default-directory tempdir)
(status (call-process mod-test-emacs nil t nil
diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el
index ac08e055b55..a1a412423cb 100644
--- a/test/src/emacs-tests.el
+++ b/test/src/emacs-tests.el
@@ -25,6 +25,7 @@
(require 'cl-lib)
(require 'ert)
+(require 'ert-x) ; ert-with-temp-file
(require 'rx)
(require 'subr-x)
@@ -46,22 +47,6 @@
"--seccomp=/does-not-exist.bpf")
0))))
-(cl-defmacro emacs-tests--with-temp-file
- (var (prefix &optional suffix text) &rest body)
- "Evaluate BODY while a new temporary file exists.
-Bind VAR to the name of the file. Pass PREFIX, SUFFIX, and TEXT
-to `make-temp-file', which see."
- (declare (indent 2) (debug (symbolp (form form form) body)))
- (cl-check-type var symbol)
- ;; Use an uninterned symbol so that the code still works if BODY
- ;; changes VAR.
- (let ((filename (make-symbol "filename")))
- `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text)))
- (unwind-protect
- (let ((,var ,filename))
- ,@body)
- (delete-file ,filename)))))
-
(ert-deftest emacs-tests/seccomp/empty-file ()
(skip-unless (string-match-p (rx bow "SECCOMP" eow)
system-configuration-features))
@@ -69,7 +54,8 @@ to `make-temp-file', which see."
(expand-file-name invocation-name invocation-directory))
(process-environment nil))
(skip-unless (file-executable-p emacs))
- (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf")
+ (ert-with-temp-file filter
+ :prefix "seccomp-invalid-" :suffix ".bpf"
;; The --seccomp option is processed early, without filename
;; handlers. Therefore remote or quoted filenames wouldn't
;; work.
@@ -94,9 +80,9 @@ to `make-temp-file', which see."
;; Either 8 or 16, but 16 should be large enough in all cases.
(filter-size 16))
(skip-unless (file-executable-p emacs))
- (emacs-tests--with-temp-file
- filter ("seccomp-too-large-" ".bpf"
- (make-string (* (1+ ushort-max) filter-size) ?a))
+ (ert-with-temp-file filter
+ :prefix "seccomp-too-large-" :suffix ".bpf"
+ :text (make-string (* (1+ ushort-max) filter-size) ?a)
;; The --seccomp option is processed early, without filename
;; handlers. Therefore remote or quoted filenames wouldn't
;; work.
@@ -117,8 +103,8 @@ to `make-temp-file', which see."
(expand-file-name invocation-name invocation-directory))
(process-environment nil))
(skip-unless (file-executable-p emacs))
- (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf"
- "123456")
+ (ert-with-temp-file filter
+ :prefix "seccomp-invalid-" :suffix ".bpf" :text "123456"
;; The --seccomp option is processed early, without filename
;; handlers. Therefore remote or quoted filenames wouldn't
;; work.
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index dac8f95bc4d..be685fe999f 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -119,14 +119,6 @@
(should (equal '(#s(foo) #s(foo))
(read "(#1=#s(foo) #1#)"))))
-(defmacro lread-tests--with-temp-file (file-name-var &rest body)
- (declare (indent 1))
- (cl-check-type file-name-var symbol)
- `(let ((,file-name-var (make-temp-file "emacs")))
- (unwind-protect
- (progn ,@body)
- (delete-file ,file-name-var))))
-
(defun lread-tests--last-message ()
(with-current-buffer "*Messages*"
(save-excursion
@@ -137,7 +129,7 @@
(ert-deftest lread-tests--unescaped-char-literals ()
"Check that loading warns about unescaped character
literals (Bug#20852)."
- (lread-tests--with-temp-file file-name
+ (ert-with-temp-file file-name
(write-region "?) ?( ?; ?\" ?[ ?]" nil file-name)
(should (equal (load file-name nil :nomessage :nosuffix) t))
(should (equal (lread-tests--last-message)
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 44f3ea2fbb4..785194b3ff4 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -25,6 +25,7 @@
(require 'cl-lib)
(require 'ert)
+(require 'ert-x) ; ert-with-temp-directory
(require 'puny)
(require 'subr-x)
(require 'dns)
@@ -531,18 +532,6 @@ FD_SETSIZE."
(delete-process (pop ,processes))
,@body)))))
-(defmacro process-tests--with-temp-directory (var &rest body)
- "Bind VAR to the name of a new directory and evaluate BODY.
-Afterwards, delete the directory."
- (declare (indent 1) (debug (symbolp body)))
- (cl-check-type var symbol)
- (let ((dir (make-symbol "dir")))
- `(let ((,dir (make-temp-file "emacs-test-" :dir)))
- (unwind-protect
- (let ((,var ,dir))
- ,@body)
- (delete-directory ,dir :recursive)))))
-
;; Tests for FD_SETSIZE overflow (Bug#24325). The following tests
;; generate lots of process objects of the various kinds. Running the
;; tests with assertions enabled should not result in any crashes due
@@ -630,7 +619,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
;; Avoid hang due to connect/accept handshake on Cygwin (bug#49496).
(skip-unless (not (eq system-type 'cygwin)))
(with-timeout (60 (ert-fail "Test timed out"))
- (process-tests--with-temp-directory directory
+ (ert-with-temp-directory directory
(process-tests--with-processes processes
(let* ((num-clients 10)
(socket-name (expand-file-name "socket" directory))
--
cgit v1.2.3
From 385741fae276c7cfe2975e8a64cf084e0f63cf3d Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Sat, 6 Nov 2021 23:20:59 +0100
Subject: Prefer ert-with-temp-(directory|file)
* test/lisp/abbrev-tests.el (read-write-abbrev-file-test)
(read-write-abbrev-file-test-with-props)
(abbrev-edit-save-to-file-test):
* test/lisp/auth-source-tests.el (auth-source-test-netrc-create-secret)
(auth-source-delete):
* test/lisp/autoinsert-tests.el (autoinsert-tests-auto-insert-file):
* test/lisp/bookmark-tests.el (with-bookmark-test-save-load):
* test/lisp/buff-menu-tests.el (buff-menu-24962):
* test/lisp/calendar/icalendar-tests.el (icalendar-tests--do-test-export):
* test/lisp/calendar/todo-mode-tests.el (with-todo-test):
* test/lisp/dired-tests.el
(dired-test-bug27243-01, dired-test-bug27243-02)
(dired-test-bug27243-03, dired-test-bug27631)
(dired-test-bug27968, dired-test-with-temp-dirs):
* test/lisp/dired-x-tests.el (dired-test-bug25942):
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file):
* test/lisp/emacs-lisp/check-declare-tests.el (check-declare-tests-scan)
(check-declare-tests-verify-mismatch):
* test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-with-normal-env):
* test/lisp/emacs-lisp/package-tests.el (with-package-test)
(package-test-signed):
* test/lisp/emacs-lisp/testcover-tests.el (testcover-tests-markup-region)
(testcover-tests-run-test-case):
* test/lisp/emulation/viper-tests.el (viper-test-undo-kmacro):
* test/lisp/epg-tests.el (with-epg-tests):
* test/lisp/eshell/em-hist-tests.el (eshell-write-readonly-history):
* test/lisp/eshell/em-ls-tests.el (em-ls-test-bug27631):
* test/lisp/ffap-tests.el (ffap-tests-25243):
* test/lisp/files-tests.el (files-tests-bug-18141)
(files-tests-read-file-in-~, files-tests-make-directory)
(files-tests-copy-directory, files-tests-executable-find)
(files-tests-dont-rewrite-precious-files)
(files-tests--save-some-buffers):
* test/lisp/ls-lisp-tests.el (ls-lisp-test-bug27631):
* test/lisp/mail/uudecode-tests.el (uudecode-tests-decode-region-internal)
(uudecode-tests-decode-region-external):
* test/lisp/net/browse-url-tests.el (browse-url-tests-delete-temp-file):
* test/lisp/progmodes/elisp-mode-tests.el (xref--case-insensitive):
* test/lisp/progmodes/etags-tests.el (etags-buffer-local-tags-table-list):
* test/lisp/progmodes/flymake-tests.el (ruby-backend):
* test/lisp/progmodes/python-tests.el (python-tests-with-temp-file):
* test/lisp/progmodes/sql-tests.el (with-sql-test-connect-harness):
* test/lisp/saveplace-tests.el (saveplace-test-save-place-to-alist/file)
(saveplace-test-forget-unreadable-files)
(saveplace-test-place-alist-to-file):
* test/lisp/so-long-tests/spelling-tests.el:
* test/lisp/textmodes/reftex-tests.el (reftex-locate-bibliography-files)
(reftex-parse-from-file-test):
* test/lisp/thumbs-tests.el (thumbs-tests-thumbsdir/create-if-missing):
* test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-bug9726)
(vc-bzr-test-bug9781, vc-bzr-test-faulty-bzr-autoloads):
* test/lisp/vc/diff-mode-tests.el (diff-mode-test-ignore-trailing-dashes):
* test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
* test/lisp/wdired-tests.el (wdired-test-bug32173-01)
(wdired-test-bug32173-02, wdired-test-symlink-name)
(wdired-test-unfinished-edit-01, wdired-test-bug34915)
(wdired-test-bug39280):
* test/src/buffer-tests.el (test-kill-buffer-auto-save-default):
* test/src/filelock-tests.el (filelock-tests--fixture):
* test/src/inotify-tests.el (inotify-file-watch-simple):
* test/src/undo-tests.el (undo-test-file-modified): Prefer
'ert-with-temp-(directory|file)' to using 'make-temp-file' directly.
In some cases, this is just cleanup, but in several cases this fixes
bugs where an error would have lead to us not cleaning up.
---
test/lisp/abbrev-tests.el | 60 +++--
test/lisp/auth-source-tests.el | 131 +++++------
test/lisp/autoinsert-tests.el | 19 +-
test/lisp/bookmark-tests.el | 18 +-
test/lisp/buff-menu-tests.el | 21 +-
test/lisp/calendar/icalendar-tests.el | 50 ++--
test/lisp/calendar/todo-mode-tests.el | 37 ++-
test/lisp/dired-aux-tests.el | 1 +
test/lisp/dired-tests.el | 352 ++++++++++++++--------------
test/lisp/dired-x-tests.el | 30 ++-
test/lisp/emacs-lisp/bytecomp-tests.el | 3 +-
test/lisp/emacs-lisp/check-declare-tests.el | 96 ++++----
test/lisp/emacs-lisp/edebug-tests.el | 42 ++--
test/lisp/emacs-lisp/package-tests.el | 136 ++++++-----
test/lisp/emacs-lisp/testcover-tests.el | 108 ++++-----
test/lisp/emulation/viper-tests.el | 80 +++----
test/lisp/epg-tests.el | 77 +++---
test/lisp/eshell/em-hist-tests.el | 17 +-
test/lisp/eshell/em-ls-tests.el | 38 +--
test/lisp/ffap-tests.el | 29 ++-
test/lisp/files-tests.el | 248 ++++++++++----------
test/lisp/ls-lisp-tests.el | 33 +--
test/lisp/mail/uudecode-tests.el | 26 +-
test/lisp/net/browse-url-tests.el | 6 +-
test/lisp/progmodes/elisp-mode-tests.el | 9 +-
test/lisp/progmodes/etags-tests.el | 31 ++-
test/lisp/progmodes/flymake-tests.el | 32 +--
test/lisp/progmodes/python-tests.el | 23 +-
test/lisp/progmodes/sql-tests.el | 90 ++++---
test/lisp/saveplace-tests.el | 67 +++---
test/lisp/so-long-tests/spelling-tests.el | 30 +--
test/lisp/textmodes/reftex-tests.el | 101 ++++----
test/lisp/thumbs-tests.el | 10 +-
test/lisp/vc/diff-mode-tests.el | 56 +++--
test/lisp/vc/ediff-ptch-tests.el | 60 +++--
test/lisp/vc/vc-bzr-tests.el | 172 +++++++-------
test/lisp/wdired-tests.el | 267 +++++++++++----------
test/src/buffer-tests.el | 38 +--
test/src/filelock-tests.el | 31 ++-
test/src/inotify-tests.el | 31 ++-
test/src/undo-tests.el | 20 +-
41 files changed, 1321 insertions(+), 1405 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index 2dcfb1c309e..863806af7b3 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -28,6 +28,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'abbrev)
(require 'seq)
@@ -236,44 +237,41 @@
(ert-deftest read-write-abbrev-file-test ()
"Test reading and writing abbrevs from file."
- (let ((temp-test-file (make-temp-file "ert-abbrev-test"))
- (ert-test-abbrevs (setup-test-abbrev-table)))
- (write-abbrev-file temp-test-file)
- (clear-abbrev-table ert-test-abbrevs)
- (should (abbrev-table-empty-p ert-test-abbrevs))
- (read-abbrev-file temp-test-file)
- (should (equal "abbrev-ert-test" (abbrev-expansion "a-e-t" ert-test-abbrevs)))
- (delete-file temp-test-file)))
+ (ert-with-temp-file temp-test-file
+ (let ((ert-test-abbrevs (setup-test-abbrev-table)))
+ (write-abbrev-file temp-test-file)
+ (clear-abbrev-table ert-test-abbrevs)
+ (should (abbrev-table-empty-p ert-test-abbrevs))
+ (read-abbrev-file temp-test-file)
+ (should (equal "abbrev-ert-test" (abbrev-expansion "a-e-t" ert-test-abbrevs))))))
(ert-deftest read-write-abbrev-file-test-with-props ()
"Test reading and writing abbrevs from file."
- (let ((temp-test-file (make-temp-file "ert-abbrev-test"))
- (ert-test-abbrevs (setup-test-abbrev-table-with-props)))
- (write-abbrev-file temp-test-file)
- (clear-abbrev-table ert-test-abbrevs)
- (should (abbrev-table-empty-p ert-test-abbrevs))
- (read-abbrev-file temp-test-file)
- (should (equal "fooBar" (abbrev-expansion "fb" ert-test-abbrevs)))
- (delete-file temp-test-file)))
+ (ert-with-temp-file temp-test-file
+ (let ((ert-test-abbrevs (setup-test-abbrev-table-with-props)))
+ (write-abbrev-file temp-test-file)
+ (clear-abbrev-table ert-test-abbrevs)
+ (should (abbrev-table-empty-p ert-test-abbrevs))
+ (read-abbrev-file temp-test-file)
+ (should (equal "fooBar" (abbrev-expansion "fb" ert-test-abbrevs))))))
(ert-deftest abbrev-edit-save-to-file-test ()
"Test saving abbrev definitions in buffer to file."
(defvar ert-save-test-table nil)
- (let ((temp-test-file (make-temp-file "ert-abbrev-test"))
- (ert-test-abbrevs (setup-test-abbrev-table)))
- (with-temp-buffer
- (goto-char (point-min))
- (insert "(ert-save-test-table)\n")
- (insert "\n" "\"s-a-t\"\t" "0\t" "\"save-abbrevs-test\"\n")
- (should (equal "abbrev-ert-test"
- (abbrev-expansion "a-e-t" ert-test-abbrevs)))
- ;; clears abbrev tables
- (abbrev-edit-save-to-file temp-test-file)
- (should-not (abbrev-expansion "a-e-t" ert-test-abbrevs))
- (read-abbrev-file temp-test-file)
- (should (equal "save-abbrevs-test"
- (abbrev-expansion "s-a-t" ert-save-test-table)))
- (delete-file temp-test-file))))
+ (ert-with-temp-file temp-test-file
+ (let ((ert-test-abbrevs (setup-test-abbrev-table)))
+ (with-temp-buffer
+ (goto-char (point-min))
+ (insert "(ert-save-test-table)\n")
+ (insert "\n" "\"s-a-t\"\t" "0\t" "\"save-abbrevs-test\"\n")
+ (should (equal "abbrev-ert-test"
+ (abbrev-expansion "a-e-t" ert-test-abbrevs)))
+ ;; clears abbrev tables
+ (abbrev-edit-save-to-file temp-test-file)
+ (should-not (abbrev-expansion "a-e-t" ert-test-abbrevs))
+ (read-abbrev-file temp-test-file)
+ (should (equal "save-abbrevs-test"
+ (abbrev-expansion "s-a-t" ert-save-test-table)))))))
(ert-deftest inverse-add-abbrev-skips-trailing-nonword ()
"Test that adding an inverse abbrev skips trailing nonword characters."
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 5140970b0b6..0d2143f9d5a 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -27,6 +27,7 @@
;;; Code:
(require 'ert)
+(eval-when-compile (require 'ert-x))
(require 'cl-lib)
(require 'auth-source)
(require 'secrets)
@@ -360,77 +361,73 @@
(format "%s@%s" (plist-get auth-info :user) (plist-get auth-info :host))))))
(ert-deftest auth-source-test-netrc-create-secret ()
- (let* ((netrc-file (make-temp-file "auth-source-test"))
- (auth-sources (list netrc-file))
- (auth-source-save-behavior t)
- host auth-info auth-passwd)
- (unwind-protect
- (dolist (passwd '("foo" "" nil))
- ;; Redefine `read-*' in order to avoid interactive input.
- (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
- ((symbol-function 'read-string)
- (lambda (_prompt &optional _initial _history default
- _inherit-input-method)
- default)))
- (setq host
- (md5 (concat (prin1-to-string process-environment) passwd))
- auth-info
- (car (auth-source-search
- :max 1 :host host :require '(:user :secret) :create t))
- auth-passwd (plist-get auth-info :secret)
- auth-passwd (if (functionp auth-passwd)
- (funcall auth-passwd)
- auth-passwd))
- (should (string-equal (plist-get auth-info :user) (user-login-name)))
- (should (string-equal (plist-get auth-info :host) host))
- (should (equal auth-passwd passwd))
- (when (functionp (plist-get auth-info :save-function))
- (funcall (plist-get auth-info :save-function)))
-
- ;; Check, that the item has been created indeed.
- (auth-source-forget+ :host t)
- (setq auth-source-netrc-cache nil)
- (setq auth-info (car (auth-source-search :host host))
- auth-passwd (plist-get auth-info :secret)
- auth-passwd (if (functionp auth-passwd)
- (funcall auth-passwd)
- auth-passwd))
- (with-temp-buffer
- (insert-file-contents netrc-file)
- (if (zerop (length passwd))
- (progn
- (should-not (plist-get auth-info :user))
- (should-not (plist-get auth-info :host))
- (should-not auth-passwd)
- (should-not (search-forward host nil 'noerror)))
- (should
- (string-equal (plist-get auth-info :user) (user-login-name)))
- (should (string-equal (plist-get auth-info :host) host))
- (should (string-equal auth-passwd passwd))
- (should (search-forward host nil 'noerror))))))
-
- ;; Cleanup.
- (delete-file netrc-file))))
+ (ert-with-temp-file netrc-file
+ :suffix "auth-source-test"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-save-behavior t)
+ host auth-info auth-passwd)
+ (dolist (passwd '("foo" "" nil))
+ ;; Redefine `read-*' in order to avoid interactive input.
+ (cl-letf (((symbol-function 'read-passwd) (lambda (_) passwd))
+ ((symbol-function 'read-string)
+ (lambda (_prompt &optional _initial _history default
+ _inherit-input-method)
+ default)))
+ (setq host
+ (md5 (concat (prin1-to-string process-environment) passwd))
+ auth-info
+ (car (auth-source-search
+ :max 1 :host host :require '(:user :secret) :create t))
+ auth-passwd (plist-get auth-info :secret)
+ auth-passwd (if (functionp auth-passwd)
+ (funcall auth-passwd)
+ auth-passwd))
+ (should (string-equal (plist-get auth-info :user) (user-login-name)))
+ (should (string-equal (plist-get auth-info :host) host))
+ (should (equal auth-passwd passwd))
+ (when (functionp (plist-get auth-info :save-function))
+ (funcall (plist-get auth-info :save-function)))
+
+ ;; Check, that the item has been created indeed.
+ (auth-source-forget+ :host t)
+ (setq auth-source-netrc-cache nil)
+ (setq auth-info (car (auth-source-search :host host))
+ auth-passwd (plist-get auth-info :secret)
+ auth-passwd (if (functionp auth-passwd)
+ (funcall auth-passwd)
+ auth-passwd))
+ (with-temp-buffer
+ (insert-file-contents netrc-file)
+ (if (zerop (length passwd))
+ (progn
+ (should-not (plist-get auth-info :user))
+ (should-not (plist-get auth-info :host))
+ (should-not auth-passwd)
+ (should-not (search-forward host nil 'noerror)))
+ (should
+ (string-equal (plist-get auth-info :user) (user-login-name)))
+ (should (string-equal (plist-get auth-info :host) host))
+ (should (string-equal auth-passwd passwd))
+ (should (search-forward host nil 'noerror)))))))))
(ert-deftest auth-source-delete ()
- (let* ((netrc-file (make-temp-file "auth-source-test" nil nil "\
+ (ert-with-temp-file netrc-file
+ :suffix "auth-source-test" :text "\
machine a1 port a2 user a3 password a4
machine b1 port b2 user b3 password b4
-machine c1 port c2 user c3 password c4\n"))
- (auth-sources (list netrc-file))
- (auth-source-do-cache nil)
- (expected '((:host "a1" :port "a2" :user "a3" :secret "a4")))
- (parameters '(:max 1 :host t)))
- (unwind-protect
- (let ((found (apply #'auth-source-delete parameters)))
- (dolist (f found)
- (let ((s (plist-get f :secret)))
- (setf f (plist-put f :secret
- (if (functionp s) (funcall s) s)))))
- ;; Note: The netrc backend doesn't delete anything, so
- ;; this is actually the same as `auth-source-search'.
- (should (equal found expected)))
- (delete-file netrc-file))))
+machine c1 port c2 user c3 password c4\n"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (expected '((:host "a1" :port "a2" :user "a3" :secret "a4")))
+ (parameters '(:max 1 :host t))
+ (found (apply #'auth-source-delete parameters)))
+ (dolist (f found)
+ (let ((s (plist-get f :secret)))
+ (setf f (plist-put f :secret
+ (if (functionp s) (funcall s) s)))))
+ ;; Note: The netrc backend doesn't delete anything, so
+ ;; this is actually the same as `auth-source-search'.
+ (should (equal found expected)))))
(provide 'auth-source-tests)
;;; auth-source-tests.el ends here
diff --git a/test/lisp/autoinsert-tests.el b/test/lisp/autoinsert-tests.el
index 7ec4bf63791..b264323ca15 100644
--- a/test/lisp/autoinsert-tests.el
+++ b/test/lisp/autoinsert-tests.el
@@ -28,6 +28,7 @@
(require 'autoinsert)
(require 'ert)
+(require 'ert-x)
(ert-deftest autoinsert-tests-auto-insert-skeleton ()
(let ((auto-insert-alist '((text-mode nil "f" _ "oo")))
@@ -39,16 +40,14 @@
(should (equal (point) (+ (point-min) 1))))))
(ert-deftest autoinsert-tests-auto-insert-file ()
- (let ((temp-file (make-temp-file "autoinsert-tests" nil nil "foo")))
- (unwind-protect
- (let ((auto-insert-alist `((text-mode . ,temp-file)))
- (auto-insert-query nil))
- (with-temp-buffer
- (text-mode)
- (auto-insert)
- (should (equal (buffer-string) "foo"))))
- (when (file-exists-p temp-file)
- (delete-file temp-file)))))
+ (ert-with-temp-file temp-file
+ :text "foo"
+ (let ((auto-insert-alist `((text-mode . ,temp-file)))
+ (auto-insert-query nil))
+ (with-temp-buffer
+ (text-mode)
+ (auto-insert)
+ (should (equal (buffer-string) "foo"))))))
(ert-deftest autoinsert-tests-auto-insert-function ()
(let ((auto-insert-alist '((text-mode . (lambda () (insert "foo")))))
diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el
index 9c33a27288a..dc2dec68ee3 100644
--- a/test/lisp/bookmark-tests.el
+++ b/test/lisp/bookmark-tests.el
@@ -371,16 +371,14 @@ Same as `with-bookmark-test' but also sets a temporary
`bookmark-default-file', evaluates BODY, and then runs the test
that saves and then loads the bookmark file."
`(with-bookmark-test
- (let ((file (make-temp-file "bookmark-tests-")))
- (unwind-protect
- (let ((bookmark-default-file file)
- (old-alist bookmark-alist))
- ,@body
- (bookmark-save nil file t)
- (setq bookmark-alist nil)
- (bookmark-load file nil t)
- (should (equal bookmark-alist old-alist)))
- (delete-file file)))))
+ (ert-with-temp-file file
+ (let ((bookmark-default-file file)
+ (old-alist bookmark-alist))
+ ,@body
+ (bookmark-save nil file t)
+ (setq bookmark-alist nil)
+ (bookmark-load file nil t)
+ (should (equal bookmark-alist old-alist))))))
(defvar bookmark-tests-non-ascii-data
(concat "ĐĐŽŃĐ°ÌĐČŃŃĐČŃĐčŃĐ”!" "äžæ,æźéèŻ,æ±èŻ" "ÄÀöÞñ"
diff --git a/test/lisp/buff-menu-tests.el b/test/lisp/buff-menu-tests.el
index 18c988656d3..b223a643083 100644
--- a/test/lisp/buff-menu-tests.el
+++ b/test/lisp/buff-menu-tests.el
@@ -24,19 +24,20 @@
;;; Code:
(require 'ert)
+(eval-when-compile (require 'ert-x))
(ert-deftest buff-menu-24962 ()
"Test for https://debbugs.gnu.org/24962 ."
- (let* ((file (make-temp-file "foo"))
- (buf (find-file file)))
- (unwind-protect
- (progn
- (rename-buffer " foo")
- (list-buffers)
- (with-current-buffer "*Buffer List*"
- (should (string= " foo" (buffer-name (Buffer-menu-buffer))))))
- (and (buffer-live-p buf) (kill-buffer buf))
- (and (file-exists-p file) (delete-file file)))))
+ (ert-with-temp-file file
+ :suffix "foo"
+ (let ((buf (find-file file)))
+ (unwind-protect
+ (progn
+ (rename-buffer " foo")
+ (list-buffers)
+ (with-current-buffer "*Buffer List*"
+ (should (string= " foo" (buffer-name (Buffer-menu-buffer))))))
+ (and (buffer-live-p buf) (kill-buffer buf))))))
(provide 'buff-menu-tests)
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el
index a1853ff3d4e..264da3ce57d 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -698,17 +698,18 @@ and ISO style input data must use english month names."
"Actually perform export test.
Argument INPUT input diary string.
Argument EXPECTED-OUTPUT expected iCalendar result string."
- (let ((temp-file (make-temp-file "icalendar-tests-ics")))
+ (ert-with-temp-file temp-file
+ :suffix "icalendar-tests-ics"
(unwind-protect
- (progn
- (with-temp-buffer
- (insert input)
- (icalendar-export-region (point-min) (point-max) temp-file))
- (save-excursion
- (find-file temp-file)
- (goto-char (point-min))
- (cond (expected-output
- (should (re-search-forward "^\\s-*BEGIN:VCALENDAR
+ (progn
+ (with-temp-buffer
+ (insert input)
+ (icalendar-export-region (point-min) (point-max) temp-file))
+ (save-excursion
+ (find-file temp-file)
+ (goto-char (point-min))
+ (cond (expected-output
+ (should (re-search-forward "^\\s-*BEGIN:VCALENDAR
PRODID:-//Emacs//NONSGML icalendar.el//EN
VERSION:2.0
BEGIN:VEVENT
@@ -717,23 +718,22 @@ UID:emacs[0-9]+
END:VEVENT
END:VCALENDAR
\\s-*$"
- nil t))
- (should (string-match
- (concat "^\\s-*"
- (regexp-quote (buffer-substring-no-properties
- (match-beginning 1) (match-end 1)))
- "\\s-*$")
- expected-output)))
- (t
- (should (re-search-forward "^\\s-*BEGIN:VCALENDAR
+ nil t))
+ (should (string-match
+ (concat "^\\s-*"
+ (regexp-quote (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1)))
+ "\\s-*$")
+ expected-output)))
+ (t
+ (should (re-search-forward "^\\s-*BEGIN:VCALENDAR
PRODID:-//Emacs//NONSGML icalendar.el//EN
VERSION:2.0
END:VCALENDAR
\\s-*$"
- nil t))))))
+ nil t))))))
;; cleanup!!
- (kill-buffer (find-buffer-visiting temp-file))
- (delete-file temp-file))))
+ (kill-buffer (find-buffer-visiting temp-file)))))
(ert-deftest icalendar-export-ordinary-no-time ()
"Perform export test."
@@ -1031,7 +1031,8 @@ During import test the timezone is set to Central European Time."
(defun icalendar-tests--do-test-import (expected-output)
"Actually perform import test.
Argument EXPECTED-OUTPUT file containing expected diary string."
- (let ((temp-file (make-temp-file "icalendar-test-diary")))
+ (ert-with-temp-file temp-file
+ :suffix "icalendar-test-diary"
;; Test the Catch-the-mysterious-coding-header logic below.
;; Ruby-mode adds an after-save-hook which inserts the header!
;; (save-excursion
@@ -1061,8 +1062,7 @@ Argument EXPECTED-OUTPUT file containing expected diary string."
(let ((result (buffer-substring-no-properties (point-min) (point-max))))
(should (string= expected-output result)))
- (kill-buffer (find-buffer-visiting temp-file))
- (delete-file temp-file))))
+ (kill-buffer (find-buffer-visiting temp-file)))))
(ert-deftest icalendar-import-non-recurring ()
"Perform standard import tests."
diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el
index 9b5d990b9bd..79978a2041f 100644
--- a/test/lisp/calendar/todo-mode-tests.el
+++ b/test/lisp/calendar/todo-mode-tests.el
@@ -37,25 +37,24 @@
(defmacro with-todo-test (&rest body)
"Set up an isolated `todo-mode' test environment."
(declare (debug (body)))
- `(let* ((todo-test-home (make-temp-file "todo-test-home-" t))
- ;; Since we change HOME, clear this to avoid a conflict
- ;; e.g. if Emacs runs within the user's home directory.
- (abbreviated-home-dir nil)
- (process-environment (cons (format "HOME=%s" todo-test-home)
- process-environment))
- (todo-directory (ert-resource-directory))
- (todo-default-todo-file (todo-short-file-name
- (car (funcall todo-files-function)))))
- (unwind-protect
- (progn ,@body)
- ;; Restore pre-test-run state of test files.
- (dolist (f (directory-files todo-directory))
- (let ((buf (get-file-buffer f)))
- (when buf
- (with-current-buffer buf
- (restore-buffer-modified-p nil)
- (kill-buffer)))))
- (delete-directory todo-test-home t))))
+ `(ert-with-temp-directory todo-test-home
+ (let* (;; Since we change HOME, clear this to avoid a conflict
+ ;; e.g. if Emacs runs within the user's home directory.
+ (abbreviated-home-dir nil)
+ (process-environment (cons (format "HOME=%s" todo-test-home)
+ process-environment))
+ (todo-directory (ert-resource-directory))
+ (todo-default-todo-file (todo-short-file-name
+ (car (funcall todo-files-function)))))
+ (unwind-protect
+ (progn ,@body)
+ ;; Restore pre-test-run state of test files.
+ (dolist (f (directory-files todo-directory))
+ (let ((buf (get-file-buffer f)))
+ (when buf
+ (with-current-buffer buf
+ (restore-buffer-modified-p nil)
+ (kill-buffer)))))))))
(defun todo-test--show (num &optional archive)
"Display category NUM of test todo file.
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index d5940ed8ca7..88a2c9f92c5 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -19,6 +19,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'dired-aux)
(eval-when-compile (require 'cl-lib))
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 83f7dc3cac7..ad1bca923d9 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -19,6 +19,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'dired)
(ert-deftest dired-autoload ()
@@ -141,116 +142,113 @@
(ert-deftest dired-test-bug27243-01 ()
"Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ."
- (let* ((test-dir (file-name-as-directory (make-temp-file "test-dir-" t)))
- (save-pos (lambda ()
- (with-current-buffer (car (dired-buffers-for-dir test-dir))
- (dired-save-positions))))
- (dired-auto-revert-buffer t) buffers)
- ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
- ;; corresponding long file names exist, otherwise such names trip
- ;; dired-buffers-for-dir.
- (if (eq system-type 'windows-nt)
- (setq test-dir (file-truename test-dir)))
- (should-not (dired-buffers-for-dir test-dir))
- (with-current-buffer (find-file-noselect test-dir)
- (make-directory "test-subdir"))
- (message "Saved pos: %S" (funcall save-pos))
- ;; Point must be at end-of-buffer.
- (with-current-buffer (car (dired-buffers-for-dir test-dir))
- (should (eobp)))
- (push (dired test-dir) buffers)
- (message "Saved pos: %S" (funcall save-pos))
- ;; Previous dired call shouldn't create a new buffer: must visit the one
- ;; created by `find-file-noselect' above.
- (should (eq 1 (length (dired-buffers-for-dir test-dir))))
- (unwind-protect
- (let ((buf (current-buffer))
- (pt1 (point))
- (test-file (concat (file-name-as-directory "test-subdir")
- "test-file")))
- (message "Saved pos: %S" (funcall save-pos))
- (write-region "Test" nil test-file nil 'silent nil 'excl)
- (message "Saved pos: %S" (funcall save-pos))
- ;; Sanity check: point should now be on the subdirectory.
- (should (equal (dired-file-name-at-point)
- (concat test-dir (file-name-as-directory "test-subdir"))))
- (message "Saved pos: %S" (funcall save-pos))
- (push (dired-find-file) buffers)
- (let ((pt2 (point))) ; Point is on test-file.
- (pop-to-buffer-same-window buf)
- ;; Sanity check: point should now be back on the subdirectory.
- (should (eq (point) pt1))
+ (ert-with-temp-directory test-dir
+ (let* ((save-pos (lambda ()
+ (with-current-buffer (car (dired-buffers-for-dir test-dir))
+ (dired-save-positions))))
+ (dired-auto-revert-buffer t) buffers)
+ ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
+ ;; corresponding long file names exist, otherwise such names trip
+ ;; dired-buffers-for-dir.
+ (if (eq system-type 'windows-nt)
+ (setq test-dir (file-truename test-dir)))
+ (should-not (dired-buffers-for-dir test-dir))
+ (with-current-buffer (find-file-noselect test-dir)
+ (make-directory "test-subdir"))
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Point must be at end-of-buffer.
+ (with-current-buffer (car (dired-buffers-for-dir test-dir))
+ (should (eobp)))
+ (push (dired test-dir) buffers)
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Previous dired call shouldn't create a new buffer: must visit the one
+ ;; created by `find-file-noselect' above.
+ (should (eq 1 (length (dired-buffers-for-dir test-dir))))
+ (unwind-protect
+ (let ((buf (current-buffer))
+ (pt1 (point))
+ (test-file (concat (file-name-as-directory "test-subdir")
+ "test-file")))
+ (message "Saved pos: %S" (funcall save-pos))
+ (write-region "Test" nil test-file nil 'silent nil 'excl)
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Sanity check: point should now be on the subdirectory.
+ (should (equal (dired-file-name-at-point)
+ (concat test-dir (file-name-as-directory "test-subdir"))))
+ (message "Saved pos: %S" (funcall save-pos))
(push (dired-find-file) buffers)
- (should (eq (point) pt2))))
- (dolist (buf buffers)
- (when (buffer-live-p buf) (kill-buffer buf)))
- (delete-directory test-dir t))))
+ (let ((pt2 (point))) ; Point is on test-file.
+ (pop-to-buffer-same-window buf)
+ ;; Sanity check: point should now be back on the subdirectory.
+ (should (eq (point) pt1))
+ (push (dired-find-file) buffers)
+ (should (eq (point) pt2))))
+ (dolist (buf buffers)
+ (when (buffer-live-p buf) (kill-buffer buf)))))))
(ert-deftest dired-test-bug27243-02 ()
"Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 ."
- (let ((test-dir (make-temp-file "test-dir-" t))
- (dired-auto-revert-buffer t) buffers)
- ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
- ;; corresponding long file names exist, otherwise such names trip
- ;; string comparisons below.
- (if (eq system-type 'windows-nt)
- (setq test-dir (file-truename test-dir)))
- (with-current-buffer (find-file-noselect test-dir)
- (make-directory "test-subdir"))
- (push (dired test-dir) buffers)
- (unwind-protect
- (let ((buf (current-buffer))
- (pt1 (point))
- (test-file (concat (file-name-as-directory "test-subdir")
- "test-file")))
- (write-region "Test" nil test-file nil 'silent nil 'excl)
- ;; Sanity check: point should now be on the subdirectory.
- (should (equal (dired-file-name-at-point)
- (concat (file-name-as-directory test-dir)
- (file-name-as-directory "test-subdir"))))
- (push (dired-find-file) buffers)
- ;; Point is on test-file.
- (switch-to-buffer buf)
- ;; Sanity check: point should now be back on the subdirectory.
- (should (eq (point) pt1))
- (push (dired test-dir) buffers)
- (should (eq (point) pt1)))
- (dolist (buf buffers)
- (when (buffer-live-p buf) (kill-buffer buf)))
- (delete-directory test-dir t))))
+ (ert-with-temp-directory test-dir
+ (let ((dired-auto-revert-buffer t) buffers)
+ ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
+ ;; corresponding long file names exist, otherwise such names trip
+ ;; string comparisons below.
+ (if (eq system-type 'windows-nt)
+ (setq test-dir (file-truename test-dir)))
+ (with-current-buffer (find-file-noselect test-dir)
+ (make-directory "test-subdir"))
+ (push (dired test-dir) buffers)
+ (unwind-protect
+ (let ((buf (current-buffer))
+ (pt1 (point))
+ (test-file (concat (file-name-as-directory "test-subdir")
+ "test-file")))
+ (write-region "Test" nil test-file nil 'silent nil 'excl)
+ ;; Sanity check: point should now be on the subdirectory.
+ (should (equal (dired-file-name-at-point)
+ (concat (file-name-as-directory test-dir)
+ (file-name-as-directory "test-subdir"))))
+ (push (dired-find-file) buffers)
+ ;; Point is on test-file.
+ (switch-to-buffer buf)
+ ;; Sanity check: point should now be back on the subdirectory.
+ (should (eq (point) pt1))
+ (push (dired test-dir) buffers)
+ (should (eq (point) pt1)))
+ (dolist (buf buffers)
+ (when (buffer-live-p buf) (kill-buffer buf)))))))
(ert-deftest dired-test-bug27243-03 ()
"Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#61 ."
- (let ((test-dir (make-temp-file "test-dir-" t))
- (dired-auto-revert-buffer t)
- allbufs)
- (unwind-protect
- (progn
- (with-current-buffer (find-file-noselect test-dir)
- (push (current-buffer) allbufs)
- (make-directory "test-subdir1")
- (make-directory "test-subdir2")
- (let ((test-file1 "test-file1")
- (test-file2 "test-file2"))
- (with-current-buffer (find-file-noselect "test-subdir1")
- (push (current-buffer) allbufs)
- (write-region "Test1" nil test-file1 nil 'silent nil 'excl))
- (with-current-buffer (find-file-noselect "test-subdir2")
- (push (current-buffer) allbufs)
- (write-region "Test2" nil test-file2 nil 'silent nil 'excl))))
- ;; Call find-file with a wild card and test point in each file.
- (let ((buffers (find-file (concat (file-name-as-directory test-dir)
- "*")
- t)))
- (dolist (buf buffers)
- (let ((pt (with-current-buffer buf (point))))
- (switch-to-buffer (find-file-noselect test-dir))
- (find-file (buffer-name buf))
- (should (equal (point) pt))))
- (append buffers allbufs)))
- (dolist (buf allbufs)
- (when (buffer-live-p buf) (kill-buffer buf)))
- (delete-directory test-dir t))))
+ (ert-with-temp-directory test-dir
+ (let ((dired-auto-revert-buffer t)
+ allbufs)
+ (unwind-protect
+ (progn
+ (with-current-buffer (find-file-noselect test-dir)
+ (push (current-buffer) allbufs)
+ (make-directory "test-subdir1")
+ (make-directory "test-subdir2")
+ (let ((test-file1 "test-file1")
+ (test-file2 "test-file2"))
+ (with-current-buffer (find-file-noselect "test-subdir1")
+ (push (current-buffer) allbufs)
+ (write-region "Test1" nil test-file1 nil 'silent nil 'excl))
+ (with-current-buffer (find-file-noselect "test-subdir2")
+ (push (current-buffer) allbufs)
+ (write-region "Test2" nil test-file2 nil 'silent nil 'excl))))
+ ;; Call find-file with a wild card and test point in each file.
+ (let ((buffers (find-file (concat (file-name-as-directory test-dir)
+ "*")
+ t)))
+ (dolist (buf buffers)
+ (let ((pt (with-current-buffer buf (point))))
+ (switch-to-buffer (find-file-noselect test-dir))
+ (find-file (buffer-name buf))
+ (should (equal (point) pt))))
+ (append buffers allbufs)))
+ (dolist (buf allbufs)
+ (when (buffer-live-p buf) (kill-buffer buf)))))))
(ert-deftest dired-test-bug7131 ()
"Test for https://debbugs.gnu.org/7131 ."
@@ -274,22 +272,21 @@
;; ls-lisp-tests.el and em-ls-tests.el.
(skip-unless (and (not (featurep 'ls-lisp))
(not (featurep 'eshell))))
- (let* ((dir (make-temp-file "bug27631" 'dir))
- (dir1 (expand-file-name "dir1" dir))
- (dir2 (expand-file-name "dir2" dir))
- (default-directory dir)
- buf)
- (unwind-protect
- (progn
- (make-directory dir1)
- (make-directory dir2)
- (with-temp-file (expand-file-name "a.txt" dir1))
- (with-temp-file (expand-file-name "b.txt" dir2))
- (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
- (dired-toggle-marks)
- (should (cdr (dired-get-marked-files))))
- (delete-directory dir 'recursive)
- (when (buffer-live-p buf) (kill-buffer buf)))))
+ (ert-with-temp-directory dir
+ (let* ((dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
+ (default-directory dir)
+ buf)
+ (unwind-protect
+ (progn
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (when (buffer-live-p buf) (kill-buffer buf))))))
(ert-deftest dired-test-bug27899 ()
"Test for https://debbugs.gnu.org/27899 ."
@@ -310,72 +307,69 @@
(ert-deftest dired-test-bug27968 ()
"Test for https://debbugs.gnu.org/27968 ."
- (let* ((top-dir (make-temp-file "top-dir" t))
- (subdir (expand-file-name "subdir" top-dir))
- (header-len-fn (lambda ()
- (save-excursion
- (goto-char 1)
- (forward-line 1)
- (- (point-at-eol) (point)))))
- orig-len len diff pos line-nb)
- (make-directory subdir 'parents)
- (unwind-protect
- (with-current-buffer (dired-noselect subdir)
- (setq orig-len (funcall header-len-fn)
- pos (point)
- line-nb (line-number-at-pos))
- ;; Bug arises when the header line changes its length; this may
- ;; happen if the used space has changed: for instance, with the
- ;; creation of additional files.
- (make-directory "subdir" t)
- (dired-revert)
- ;; Change the header line.
- (save-excursion
- (goto-char 1)
- (forward-line 1)
- (let ((inhibit-read-only t)
- (new-header " test-bug27968"))
- (delete-region (point) (point-at-eol))
- (when (= orig-len (length new-header))
- ;; Wow lucky guy! I must buy lottery today.
- (setq new-header (concat new-header " :-)")))
- (insert new-header)))
- (setq len (funcall header-len-fn)
- diff (- len orig-len))
- (should-not (zerop diff)) ; Header length has changed.
- ;; If diff > 0, then the point moves back.
- ;; If diff < 0, then the point moves forward.
- ;; If diff = 0, then the point doesn't move.
- ;; Sometimes this point movement causes
- ;; line-nb != (line-number-at-pos pos), so that we get
- ;; an unexpected file at point if we store buffer points.
- ;; Note that the line number before/after revert
- ;; doesn't change.
- (should (= line-nb
- (line-number-at-pos)
- (line-number-at-pos (+ pos diff))))
- ;; After revert, the point must be in 'subdir' line.
- (should (equal "subdir" (dired-get-filename 'local t))))
- (delete-directory top-dir t))))
+ (ert-with-temp-directory top-dir
+ (let* ((subdir (expand-file-name "subdir" top-dir))
+ (header-len-fn (lambda ()
+ (save-excursion
+ (goto-char 1)
+ (forward-line 1)
+ (- (point-at-eol) (point)))))
+ orig-len len diff pos line-nb)
+ (make-directory subdir 'parents)
+ (with-current-buffer (dired-noselect subdir)
+ (setq orig-len (funcall header-len-fn)
+ pos (point)
+ line-nb (line-number-at-pos))
+ ;; Bug arises when the header line changes its length; this may
+ ;; happen if the used space has changed: for instance, with the
+ ;; creation of additional files.
+ (make-directory "subdir" t)
+ (dired-revert)
+ ;; Change the header line.
+ (save-excursion
+ (goto-char 1)
+ (forward-line 1)
+ (let ((inhibit-read-only t)
+ (new-header " test-bug27968"))
+ (delete-region (point) (point-at-eol))
+ (when (= orig-len (length new-header))
+ ;; Wow lucky guy! I must buy lottery today.
+ (setq new-header (concat new-header " :-)")))
+ (insert new-header)))
+ (setq len (funcall header-len-fn)
+ diff (- len orig-len))
+ (should-not (zerop diff)) ; Header length has changed.
+ ;; If diff > 0, then the point moves back.
+ ;; If diff < 0, then the point moves forward.
+ ;; If diff = 0, then the point doesn't move.
+ ;; Sometimes this point movement causes
+ ;; line-nb != (line-number-at-pos pos), so that we get
+ ;; an unexpected file at point if we store buffer points.
+ ;; Note that the line number before/after revert
+ ;; doesn't change.
+ (should (= line-nb
+ (line-number-at-pos)
+ (line-number-at-pos (+ pos diff))))
+ ;; After revert, the point must be in 'subdir' line.
+ (should (equal "subdir" (dired-get-filename 'local t)))))))
(defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body)
"Helper macro for Bug#27940 test."
(declare (indent 1) (debug body))
(let ((dir (make-symbol "dir")))
- `(let* ((,dir (make-temp-file "bug27940" t))
- (dired-deletion-confirmer (lambda (_) "yes")) ; Suppress prompts.
- (inhibit-message t)
- (default-directory ,dir))
- (dotimes (i 5) (make-directory (format "empty-dir-%d" i)))
- (unless ,just-empty-dirs
- (dotimes (i 5) (make-directory (format "non-empty-%d/foo" i) 'parents)))
- (make-directory "zeta-empty-dir")
- (unwind-protect
- (progn
- ,@body)
- (delete-directory ,dir t)
- (kill-buffer (current-buffer))))))
+ `(ert-with-temp-directory ,dir
+ (let* ((dired-deletion-confirmer (lambda (_) "yes")) ; Suppress prompts.
+ (inhibit-message t)
+ (default-directory ,dir))
+ (dotimes (i 5) (make-directory (format "empty-dir-%d" i)))
+ (unless ,just-empty-dirs
+ (dotimes (i 5) (make-directory (format "non-empty-%d/foo" i) 'parents)))
+ (make-directory "zeta-empty-dir")
+ (unwind-protect
+ (progn
+ ,@body)
+ (kill-buffer (current-buffer)))))))
(ert-deftest dired-test-bug27940 ()
"Test for https://debbugs.gnu.org/27940 ."
diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el
index d00815e543c..fe4b9711d49 100644
--- a/test/lisp/dired-x-tests.el
+++ b/test/lisp/dired-x-tests.el
@@ -19,6 +19,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'dired-x)
@@ -31,23 +32,20 @@
(append (copy-sequence dirs)
(delete "c" (copy-sequence files)))
#'string<))
- (dir (make-temp-file "Bug25942" 'dir))
(extension "c"))
- (unwind-protect
- (progn
- (dolist (d dirs)
- (make-directory (expand-file-name d dir)))
- (dolist (f files)
- (write-region nil nil (expand-file-name f dir)))
- (dired dir)
- (dired-mark-extension extension)
- (should (equal '("bar.c" "foo.c")
- (sort (dired-get-marked-files 'local) #'string<)))
- (dired-unmark-all-marks)
- (dired-mark-suffix extension)
- (should (equal all-but-c
- (sort (dired-get-marked-files 'local) #'string<))))
- (delete-directory dir 'recursive))))
+ (ert-with-temp-directory dir
+ (dolist (d dirs)
+ (make-directory (expand-file-name d dir)))
+ (dolist (f files)
+ (write-region nil nil (expand-file-name f dir)))
+ (dired dir)
+ (dired-mark-extension extension)
+ (should (equal '("bar.c" "foo.c")
+ (sort (dired-get-marked-files 'local) #'string<)))
+ (dired-unmark-all-marks)
+ (dired-mark-suffix extension)
+ (should (equal all-but-c
+ (sort (dired-get-marked-files 'local) #'string<))))))
(ert-deftest dired-guess-default ()
(let ((dired-guess-shell-alist-user nil)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 41edc1f8289..cc6455bb2ee 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1016,10 +1016,9 @@ byte-compiled. Run with dynamic binding."
(defmacro bytecomp-tests--with-temp-file (file-name-var &rest body)
(declare (indent 1))
(cl-check-type file-name-var symbol)
- `(let ((,file-name-var (make-temp-file "emacs")))
+ `(ert-with-temp-file ,file-name-var
(unwind-protect
(progn ,@body)
- (delete-file ,file-name-var)
(let ((elc (concat ,file-name-var ".elc")))
(if (file-exists-p elc) (delete-file elc))))))
diff --git a/test/lisp/emacs-lisp/check-declare-tests.el b/test/lisp/emacs-lisp/check-declare-tests.el
index 276530fb4d3..5c9d847e34a 100644
--- a/test/lisp/emacs-lisp/check-declare-tests.el
+++ b/test/lisp/emacs-lisp/check-declare-tests.el
@@ -28,6 +28,7 @@
(require 'check-declare)
(require 'ert)
+(require 'ert-x)
(eval-when-compile (require 'subr-x))
(ert-deftest check-declare-tests-locate ()
@@ -36,62 +37,53 @@
(string-prefix-p "ext:" (check-declare-locate "ext:foo" ""))))
(ert-deftest check-declare-tests-scan ()
- (let ((file (make-temp-file "check-declare-tests-")))
- (unwind-protect
- (progn
- (with-temp-file file
- (insert
- (string-join
- '(";; foo comment"
- "(declare-function ring-insert \"ring\" (ring item))"
- "(let ((foo 'code)) foo)")
- "\n")))
- (let ((res (check-declare-scan file)))
- (should (= (length res) 1))
- (pcase-let ((`((,fnfile ,fn ,arglist ,fileonly)) res))
- (should (string-match-p "ring" fnfile))
- (should (equal "ring-insert" fn))
- (should (equal '(ring item) arglist))
- (should-not fileonly))))
- (delete-file file))))
+ (ert-with-temp-file file
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(declare-function ring-insert \"ring\" (ring item))"
+ "(let ((foo 'code)) foo)")
+ "\n")))
+ (let ((res (check-declare-scan file)))
+ (should (= (length res) 1))
+ (pcase-let ((`((,fnfile ,fn ,arglist ,fileonly)) res))
+ (should (string-match-p "ring" fnfile))
+ (should (equal "ring-insert" fn))
+ (should (equal '(ring item) arglist))
+ (should-not fileonly)))))
(ert-deftest check-declare-tests-verify ()
- (let ((file (make-temp-file "check-declare-tests-")))
- (unwind-protect
- (progn
- (with-temp-file file
- (insert
- (string-join
- '(";; foo comment"
- "(defun foo-fun ())"
- "(defun ring-insert (ring item)"
- "\"Insert onto ring RING the item ITEM.\""
- "nil)")
- "\n")))
- (should-not
- (check-declare-verify
- file '(("foo.el" "ring-insert" (ring item))))))
- (delete-file file))))
+ (ert-with-temp-file file
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(defun foo-fun ())"
+ "(defun ring-insert (ring item)"
+ "\"Insert onto ring RING the item ITEM.\""
+ "nil)")
+ "\n")))
+ (should-not
+ (check-declare-verify
+ file '(("foo.el" "ring-insert" (ring item)))))))
(ert-deftest check-declare-tests-verify-mismatch ()
- (let ((file (make-temp-file "check-declare-tests-")))
- (unwind-protect
- (progn
- (with-temp-file file
- (insert
- (string-join
- '(";; foo comment"
- "(defun foo-fun ())"
- "(defun ring-insert (ring)"
- "\"Insert onto ring RING the item ITEM.\""
- "nil)")
- "\n")))
- (should
- (equal
- (check-declare-verify
- file '(("foo.el" "ring-insert" (ring item))))
- '(("foo.el" "ring-insert" "arglist mismatch")))))
- (delete-file file))))
+ (ert-with-temp-file file
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(defun foo-fun ())"
+ "(defun ring-insert (ring)"
+ "\"Insert onto ring RING the item ITEM.\""
+ "nil)")
+ "\n")))
+ (should
+ (equal
+ (check-declare-verify
+ file '(("foo.el" "ring-insert" (ring item))))
+ '(("foo.el" "ring-insert" "arglist mismatch"))))))
(ert-deftest check-declare-tests-sort ()
(should-not (check-declare-sort '()))
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
index f8fa223da4c..9285b2c945c 100644
--- a/test/lisp/emacs-lisp/edebug-tests.el
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -107,27 +107,27 @@ back to the top level.")
"Set up the environment for an Edebug test BODY, run it, and clean up."
(declare (debug (body)))
`(edebug-tests-with-default-config
- (let ((edebug-tests-failure-in-post-command nil)
- (edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el"))
- (find-file-suppress-same-file-warnings t))
- (edebug-tests-setup-code-file edebug-tests-temp-file)
- (ert-with-message-capture
- edebug-tests-messages
- (unwind-protect
- (with-current-buffer (find-file edebug-tests-temp-file)
- (read-only-mode)
- (setq lexical-binding t)
- (eval-buffer)
- ,@body
- (when edebug-tests-failure-in-post-command
- (signal (car edebug-tests-failure-in-post-command)
- (cdr edebug-tests-failure-in-post-command))))
- (unload-feature 'edebug-test-code)
- (with-current-buffer (find-file-noselect edebug-tests-temp-file)
- (set-buffer-modified-p nil))
- (ignore-errors (kill-buffer (find-file-noselect
- edebug-tests-temp-file)))
- (ignore-errors (delete-file edebug-tests-temp-file)))))))
+ (ert-with-temp-file edebug-tests-temp-file
+ :suffix ".el"
+ (let ((edebug-tests-failure-in-post-command nil)
+ (find-file-suppress-same-file-warnings t))
+ (edebug-tests-setup-code-file edebug-tests-temp-file)
+ (ert-with-message-capture
+ edebug-tests-messages
+ (unwind-protect
+ (with-current-buffer (find-file edebug-tests-temp-file)
+ (read-only-mode)
+ (setq lexical-binding t)
+ (eval-buffer)
+ ,@body
+ (when edebug-tests-failure-in-post-command
+ (signal (car edebug-tests-failure-in-post-command)
+ (cdr edebug-tests-failure-in-post-command))))
+ (unload-feature 'edebug-test-code)
+ (with-current-buffer (find-file-noselect edebug-tests-temp-file)
+ (set-buffer-modified-p nil))
+ (ignore-errors (kill-buffer (find-file-noselect
+ edebug-tests-temp-file)))))))))
;; The following macro and its support functions implement an extension
;; to keyboard macros to allow interleaving of keyboard macro
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el
index c038c91e6a9..0f0ed029c3b 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -115,57 +115,55 @@
&rest body)
"Set up temporary locations and variables for testing."
(declare (indent 1) (debug (([&rest form]) body)))
- `(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t))
- (process-environment (cons (format "HOME=%s" package-test-user-dir)
- process-environment))
- (package-user-dir package-test-user-dir)
- (package-gnupghome-dir (expand-file-name "gnupg" package-user-dir))
- (package-archives `(("gnu" . ,(or ,location package-test-data-dir))))
- (default-directory package-test-file-dir)
- abbreviated-home-dir
- package--initialized
- package-alist
- ,@(if update-news
- '(package-update-news-on-upload t)
- (list (cl-gensym)))
- ,@(if upload-base
- '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t))
- (package-archive-upload-base package-test-archive-upload-base))
- (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind nil
- (let ((buf (get-buffer "*Packages*")))
- (when (buffer-live-p buf)
- (kill-buffer buf)))
- (unwind-protect
- (progn
- ,(if basedir `(cd ,basedir))
- (unless (file-directory-p package-user-dir)
- (mkdir package-user-dir))
- (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
- ((symbol-function 'y-or-n-p) (lambda (&rest _) t)))
- ,@(when install
- `((package-initialize)
- (package-refresh-contents)
- (mapc 'package-install ,install)))
- (with-temp-buffer
- ,(if file
- `(insert-file-contents ,file))
- ,@body)))
-
- (when ,upload-base
- (dolist (f '("archive-contents"
- "simple-single-1.3.el"
- "simple-single-1.4.el"
- "simple-single-readme.txt"))
- (ignore-errors
- (delete-file
- (expand-file-name f package-test-archive-upload-base))))
- (delete-directory package-test-archive-upload-base))
- (when (file-directory-p package-test-user-dir)
- (delete-directory package-test-user-dir t))
-
- (when (and (boundp 'package-test-archive-upload-base)
- (file-directory-p package-test-archive-upload-base))
- (delete-directory package-test-archive-upload-base t)))))
+ `(ert-with-temp-directory package-test-user-dir
+ (let* ((process-environment (cons (format "HOME=%s" package-test-user-dir)
+ process-environment))
+ (package-user-dir package-test-user-dir)
+ (package-gnupghome-dir (expand-file-name "gnupg" package-user-dir))
+ (package-archives `(("gnu" . ,(or ,location package-test-data-dir))))
+ (default-directory package-test-file-dir)
+ abbreviated-home-dir
+ package--initialized
+ package-alist
+ ,@(if update-news
+ '(package-update-news-on-upload t)
+ (list (cl-gensym)))
+ ,@(if upload-base
+ '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t))
+ (package-archive-upload-base package-test-archive-upload-base))
+ (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind nil
+ (let ((buf (get-buffer "*Packages*")))
+ (when (buffer-live-p buf)
+ (kill-buffer buf)))
+ (unwind-protect
+ (progn
+ ,(if basedir `(cd ,basedir))
+ (unless (file-directory-p package-user-dir)
+ (mkdir package-user-dir))
+ (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
+ ((symbol-function 'y-or-n-p) (lambda (&rest _) t)))
+ ,@(when install
+ `((package-initialize)
+ (package-refresh-contents)
+ (mapc 'package-install ,install)))
+ (with-temp-buffer
+ ,(if file
+ `(insert-file-contents ,file))
+ ,@body)))
+
+ (when ,upload-base
+ (dolist (f '("archive-contents"
+ "simple-single-1.3.el"
+ "simple-single-1.4.el"
+ "simple-single-readme.txt"))
+ (ignore-errors
+ (delete-file
+ (expand-file-name f package-test-archive-upload-base))))
+ (delete-directory package-test-archive-upload-base))
+
+ (when (and (boundp 'package-test-archive-upload-base)
+ (file-directory-p package-test-archive-upload-base))
+ (delete-directory package-test-archive-upload-base t))))))
(defmacro with-fake-help-buffer (&rest body)
"Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer."
@@ -715,25 +713,23 @@ but with a different end of line convention (bug#48137)."
(defvar epg-config--program-alist) ; Silence byte-compiler.
(ert-deftest package-test-signed ()
"Test verifying package signature."
- (skip-unless (let ((homedir (make-temp-file "package-test" t)))
- (unwind-protect
- (let ((process-environment
- (cons (concat "HOME=" homedir)
- process-environment)))
- (require 'epg-config)
- (defvar epg-config--program-alist)
- (epg-find-configuration
- 'OpenPGP nil
- ;; By default we require gpg2 2.1+ due to some
- ;; practical problems with pinentry. But this
- ;; test works fine with 2.0 as well.
- (let ((prog-alist (copy-tree epg-config--program-alist)))
- (setf (alist-get "gpg2"
- (alist-get 'OpenPGP prog-alist)
- nil nil #'equal)
- "2.0")
- prog-alist)))
- (delete-directory homedir t))))
+ (skip-unless (ert-with-temp-directory homedir
+ (let ((process-environment
+ (cons (concat "HOME=" homedir)
+ process-environment)))
+ (require 'epg-config)
+ (defvar epg-config--program-alist)
+ (epg-find-configuration
+ 'OpenPGP nil
+ ;; By default we require gpg2 2.1+ due to some
+ ;; practical problems with pinentry. But this
+ ;; test works fine with 2.0 as well.
+ (let ((prog-alist (copy-tree epg-config--program-alist)))
+ (setf (alist-get "gpg2"
+ (alist-get 'OpenPGP prog-alist)
+ nil nil #'equal)
+ "2.0")
+ prog-alist)))))
(let* ((keyring (expand-file-name "key.pub" package-test-data-dir))
(package-test-data-dir (ert-resource-file "signed")))
(with-package-test ()
diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el
index 7854e33e77d..a7e055a28b1 100644
--- a/test/lisp/emacs-lisp/testcover-tests.el
+++ b/test/lisp/emacs-lisp/testcover-tests.el
@@ -45,34 +45,34 @@ testcases.el. This can be used to create test cases if Testcover
is working correctly on a code sample. OPTARGS are optional
arguments for `testcover-start'."
(interactive "r")
- (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))
- (find-file-suppress-same-file-warnings t)
- (code (buffer-substring beg end))
- (marked-up-code))
- (unwind-protect
- (progn
- (with-temp-file tempfile
- (insert code))
- (save-current-buffer
- (let ((buf (find-file-noselect tempfile)))
- (set-buffer buf)
- (apply 'testcover-start (cons tempfile optargs))
- (testcover-mark-all buf)
- (dolist (overlay (overlays-in (point-min) (point-max)))
- (let ((ov-face (overlay-get overlay 'face)))
- (goto-char (overlay-end overlay))
- (cond
- ((eq ov-face 'testcover-nohits) (insert "!!!"))
- ((eq ov-face 'testcover-1value) (insert "%%%"))
- (t nil))))
- (setq marked-up-code (buffer-string)))
- (set-buffer-modified-p nil)))
- (ignore-errors (kill-buffer (find-file-noselect tempfile)))
- (ignore-errors (delete-file tempfile)))
-
- ;; Now replace the original code with the marked up code.
- (delete-region beg end)
- (insert marked-up-code))))
+ (ert-with-temp-file tempfile
+ :suffix ".el"
+ (let ((find-file-suppress-same-file-warnings t)
+ (code (buffer-substring beg end))
+ (marked-up-code))
+ (unwind-protect
+ (progn
+ (with-temp-file tempfile
+ (insert code))
+ (save-current-buffer
+ (let ((buf (find-file-noselect tempfile)))
+ (set-buffer buf)
+ (apply 'testcover-start (cons tempfile optargs))
+ (testcover-mark-all buf)
+ (dolist (overlay (overlays-in (point-min) (point-max)))
+ (let ((ov-face (overlay-get overlay 'face)))
+ (goto-char (overlay-end overlay))
+ (cond
+ ((eq ov-face 'testcover-nohits) (insert "!!!"))
+ ((eq ov-face 'testcover-1value) (insert "%%%"))
+ (t nil))))
+ (setq marked-up-code (buffer-string)))
+ (set-buffer-modified-p nil)))
+ (ignore-errors (kill-buffer (find-file-noselect tempfile))))
+
+ ;; Now replace the original code with the marked up code.
+ (delete-region beg end)
+ (insert marked-up-code)))))
(eval-and-compile
(defun testcover-tests-unmarkup-region (beg end)
@@ -99,32 +99,32 @@ arguments for `testcover-start'."
(eval-and-compile
(defun testcover-tests-run-test-case (marked-up-code)
"Test the operation of Testcover on the string MARKED-UP-CODE."
- (let ((tempfile (make-temp-file "testcover-tests-" nil ".el"))
- (find-file-suppress-same-file-warnings t))
- (unwind-protect
- (progn
- (with-temp-file tempfile
- (insert marked-up-code))
- ;; Remove the marks and mark the code up again. The original
- ;; and recreated versions should match.
- (save-current-buffer
- (set-buffer (find-file-noselect tempfile))
- ;; Fail the test if the debugger tries to become active,
- ;; which can happen if Testcover fails to attach itself
- ;; correctly. Note that this will prevent debugging
- ;; these tests using Edebug.
- (cl-letf (((symbol-function #'edebug-default-enter)
- (lambda (&rest _args)
- (ert-fail "Debugger invoked during test run"))))
- (dolist (byte-compile '(t nil))
- (testcover-tests-unmarkup-region (point-min) (point-max))
- (unwind-protect
- (testcover-tests-markup-region (point-min) (point-max) byte-compile)
- (set-buffer-modified-p nil))
- (should (string= marked-up-code
- (buffer-string)))))))
- (ignore-errors (kill-buffer (find-file-noselect tempfile)))
- (ignore-errors (delete-file tempfile))))))
+ (ert-with-temp-file tempfile
+ :suffix ".el"
+ (let ((find-file-suppress-same-file-warnings t))
+ (unwind-protect
+ (progn
+ (with-temp-file tempfile
+ (insert marked-up-code))
+ ;; Remove the marks and mark the code up again. The original
+ ;; and recreated versions should match.
+ (save-current-buffer
+ (set-buffer (find-file-noselect tempfile))
+ ;; Fail the test if the debugger tries to become active,
+ ;; which can happen if Testcover fails to attach itself
+ ;; correctly. Note that this will prevent debugging
+ ;; these tests using Edebug.
+ (cl-letf (((symbol-function #'edebug-default-enter)
+ (lambda (&rest _args)
+ (ert-fail "Debugger invoked during test run"))))
+ (dolist (byte-compile '(t nil))
+ (testcover-tests-unmarkup-region (point-min) (point-max))
+ (unwind-protect
+ (testcover-tests-markup-region (point-min) (point-max) byte-compile)
+ (set-buffer-modified-p nil))
+ (should (string= marked-up-code
+ (buffer-string)))))))
+ (ignore-errors (kill-buffer (find-file-noselect tempfile))))))))
;; Convert test case file to ert-defmethod.
diff --git a/test/lisp/emulation/viper-tests.el b/test/lisp/emulation/viper-tests.el
index 0d999763b61..b8efc87ab70 100644
--- a/test/lisp/emulation/viper-tests.el
+++ b/test/lisp/emulation/viper-tests.el
@@ -21,7 +21,8 @@
;;; Code:
-
+(require 'ert)
+(require 'ert-x)
(require 'viper)
(defun viper-test-undo-kmacro (kmacro)
@@ -30,47 +31,42 @@
This function makes as many attempts as possible to clean up
after itself, although it will leave a buffer called
*viper-test-buffer* if it fails (this is deliberate!)."
- (let (
- ;; Viper just turns itself off during batch use.
- (noninteractive nil)
- ;; Switch off start up message or it will chew the key presses.
- (viper-inhibit-startup-message 't)
- ;; Select an expert-level for the same reason.
- (viper-expert-level 5)
- ;; viper loads this even with -q so make sure it's empty!
- (viper-custom-file-name (make-temp-file "viper-tests" nil ".elc"))
- (before-buffer (current-buffer)))
- (unwind-protect
- (progn
- ;; viper-mode is essentially global, so set it here.
- (viper-mode)
- ;; We must switch to buffer because we are using a keyboard macro
- ;; which appears to not go to the current-buffer but what ever is
- ;; currently taking keyboard events. We use a named buffer because
- ;; then we can see what it in it if it all goes wrong.
- (switch-to-buffer
- (get-buffer-create
- "*viper-test-buffer*"))
- (erase-buffer)
- ;; The new buffer fails to enter vi state so set it.
- (viper-change-state-to-vi)
- ;; Run the macro.
- (execute-kbd-macro kmacro)
- (let ((rtn
- (buffer-substring-no-properties
- (point-min)
- (point-max))))
- ;; Kill the buffer iff the macro succeeds.
- (kill-buffer)
- rtn))
- ;; Switch everything off and restore the buffer.
- (toggle-viper-mode)
- (delete-file viper-custom-file-name)
- (switch-to-buffer before-buffer))))
-
-(ert-deftest viper-test-go ()
- "Test that this file is running."
- (should t))
+ (ert-with-temp-file viper-custom-file-name
+ ;; viper loads this even with -q so make sure it's empty!
+ :prefix "emacs-viper-tests" :suffix ".elc"
+ (let (;; Viper just turns itself off during batch use.
+ (noninteractive nil)
+ ;; Switch off start up message or it will chew the key presses.
+ (viper-inhibit-startup-message 't)
+ ;; Select an expert-level for the same reason.
+ (viper-expert-level 5)
+ (before-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ ;; viper-mode is essentially global, so set it here.
+ (viper-mode)
+ ;; We must switch to buffer because we are using a keyboard macro
+ ;; which appears to not go to the current-buffer but what ever is
+ ;; currently taking keyboard events. We use a named buffer because
+ ;; then we can see what it in it if it all goes wrong.
+ (switch-to-buffer
+ (get-buffer-create
+ "*viper-test-buffer*"))
+ (erase-buffer)
+ ;; The new buffer fails to enter vi state so set it.
+ (viper-change-state-to-vi)
+ ;; Run the macro.
+ (execute-kbd-macro kmacro)
+ (let ((rtn
+ (buffer-substring-no-properties
+ (point-min)
+ (point-max))))
+ ;; Kill the buffer iff the macro succeeds.
+ (kill-buffer)
+ rtn))
+ ;; Switch everything off and restore the buffer.
+ (toggle-viper-mode)
+ (switch-to-buffer before-buffer)))))
(ert-deftest viper-test-fix ()
"Test that the viper kmacro fixture is working."
diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el
index 741574f0adf..1384221c491 100644
--- a/test/lisp/epg-tests.el
+++ b/test/lisp/epg-tests.el
@@ -58,48 +58,45 @@
(cl-defmacro with-epg-tests ((&optional &key require-passphrase
require-public-key
require-secret-key)
- &rest body)
+ &rest body)
"Set up temporary locations and variables for testing."
(declare (indent 1) (debug (sexp body)))
- `(let* ((epg-tests-home-directory (make-temp-file "epg-tests-homedir" t))
- (process-environment
- (append
- (list "GPG_AGENT_INFO"
- (format "GNUPGHOME=%s" epg-tests-home-directory))
- process-environment)))
- (unwind-protect
- ;; GNUPGHOME is needed to find a usable gpg, so we can't
- ;; check whether to skip any earlier (Bug#23561).
- (let ((epg-config (or (epg-tests-find-usable-gpg-configuration
- ,require-passphrase ,require-public-key)
- (ert-skip "No usable gpg config")))
- (context (epg-make-context 'OpenPGP)))
- (setf (epg-context-program context)
- (alist-get 'program epg-config))
- (setf (epg-context-home-directory context)
- epg-tests-home-directory)
- ,(if require-passphrase
- '(with-temp-file (expand-file-name
- "gpg-agent.conf" epg-tests-home-directory)
- (insert "pinentry-program "
- (ert-resource-file "dummy-pinentry")
- "\n")
- (epg-context-set-passphrase-callback
- context
- #'epg-tests-passphrase-callback)))
- ,(if require-public-key
- '(epg-import-keys-from-file
- context
- (ert-resource-file "pubkey.asc")))
- ,(if require-secret-key
- '(epg-import-keys-from-file
- context
- (ert-resource-file "seckey.asc")))
- (with-temp-buffer
- (setq-local epg-tests-context context)
- ,@body))
- (when (file-directory-p epg-tests-home-directory)
- (delete-directory epg-tests-home-directory t)))))
+ `(ert-with-temp-directory epg-tests-home-directory
+ (let* ((process-environment
+ (append
+ (list "GPG_AGENT_INFO"
+ (format "GNUPGHOME=%s" epg-tests-home-directory))
+ process-environment)))
+ ;; GNUPGHOME is needed to find a usable gpg, so we can't
+ ;; check whether to skip any earlier (Bug#23561).
+ (let ((epg-config (or (epg-tests-find-usable-gpg-configuration
+ ,require-passphrase ,require-public-key)
+ (ert-skip "No usable gpg config")))
+ (context (epg-make-context 'OpenPGP)))
+ (setf (epg-context-program context)
+ (alist-get 'program epg-config))
+ (setf (epg-context-home-directory context)
+ epg-tests-home-directory)
+ ,(if require-passphrase
+ '(with-temp-file (expand-file-name
+ "gpg-agent.conf" epg-tests-home-directory)
+ (insert "pinentry-program "
+ (ert-resource-file "dummy-pinentry")
+ "\n")
+ (epg-context-set-passphrase-callback
+ context
+ #'epg-tests-passphrase-callback)))
+ ,(if require-public-key
+ '(epg-import-keys-from-file
+ context
+ (ert-resource-file "pubkey.asc")))
+ ,(if require-secret-key
+ '(epg-import-keys-from-file
+ context
+ (ert-resource-file "seckey.asc")))
+ (with-temp-buffer
+ (setq-local epg-tests-context context)
+ ,@body)))))
(ert-deftest epg-decrypt-1 ()
:expected-result (if (getenv "EMACS_HYDRA_CI") :failed :passed) ; fixme
diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el
index 31967a61c3c..5bc5690675d 100644
--- a/test/lisp/eshell/em-hist-tests.el
+++ b/test/lisp/eshell/em-hist-tests.el
@@ -20,19 +20,18 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'em-hist)
(ert-deftest eshell-write-readonly-history ()
"Test that having read-only strings in history is okay."
- (let ((histfile (make-temp-file "eshell-history"))
- (eshell-history-ring (make-ring 2)))
- (ring-insert eshell-history-ring
- (propertize "echo foo" 'read-only t))
- (ring-insert eshell-history-ring
- (propertize "echo bar" 'read-only t))
- (unwind-protect
- (eshell-write-history histfile)
- (delete-file histfile))))
+ (ert-with-temp-file histfile
+ (let ((eshell-history-ring (make-ring 2)))
+ (ring-insert eshell-history-ring
+ (propertize "echo foo" 'read-only t))
+ (ring-insert eshell-history-ring
+ (propertize "echo bar" 'read-only t))
+ (eshell-write-history histfile))))
(provide 'em-hist-test)
diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el
index 5d1742b76fd..3ea11ab2de1 100644
--- a/test/lisp/eshell/em-ls-tests.el
+++ b/test/lisp/eshell/em-ls-tests.el
@@ -25,30 +25,30 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'em-ls)
(require 'dired)
(ert-deftest em-ls-test-bug27631 ()
"Test for https://debbugs.gnu.org/27631 ."
- (let* ((dir (make-temp-file "bug27631" 'dir))
- (dir1 (expand-file-name "dir1" dir))
- (dir2 (expand-file-name "dir2" dir))
- (default-directory dir)
- (orig eshell-ls-use-in-dired)
- buf)
- (unwind-protect
- (progn
- (customize-set-value 'eshell-ls-use-in-dired t)
- (make-directory dir1)
- (make-directory dir2)
- (with-temp-file (expand-file-name "a.txt" dir1))
- (with-temp-file (expand-file-name "b.txt" dir2))
- (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
- (dired-toggle-marks)
- (should (cdr (dired-get-marked-files))))
- (customize-set-variable 'eshell-ls-use-in-dired orig)
- (delete-directory dir 'recursive)
- (when (buffer-live-p buf) (kill-buffer buf)))))
+ (ert-with-temp-directory dir
+ (let* ((dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
+ (default-directory dir)
+ (orig eshell-ls-use-in-dired)
+ buf)
+ (unwind-protect
+ (progn
+ (customize-set-value 'eshell-ls-use-in-dired t)
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (when (buffer-live-p buf) (kill-buffer buf))))))
(ert-deftest em-ls-test-bug27817 ()
"Test for https://debbugs.gnu.org/27817 ."
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index f8113bffc1a..84b9cea6c12 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -25,30 +25,29 @@
(require 'cl-lib)
(require 'ert)
+(require 'ert-x)
(require 'ffap)
(ert-deftest ffap-tests-25243 ()
"Test for https://debbugs.gnu.org/25243 ."
- (let ((file (make-temp-file "test-Bug#25243")))
- (unwind-protect
- (with-temp-file file
- (let ((str "diff --git b/lisp/ffap.el a/lisp/ffap.el
+ (ert-with-temp-file file
+ :suffix "-bug25243"
+ (let ((str "diff --git b/lisp/ffap.el a/lisp/ffap.el
index 3d7cebadcf..ad4b70d737 100644
--- b/lisp/ffap.el
+++ a/lisp/ffap.el
@@ -203,6 +203,9 @@ ffap-foo-at-bar-prefix
"))
- (transient-mark-mode 1)
- (when (natnump ffap-max-region-length)
- (insert
- (concat
- str
- (make-string ffap-max-region-length #xa)
- (format "%s ENDS HERE" file)))
- (call-interactively 'mark-whole-buffer)
- (should (equal "" (ffap-string-at-point)))
- (should (equal '(1 1) ffap-string-at-point-region)))))
- (and (file-exists-p file) (delete-file file)))))
+ (transient-mark-mode 1)
+ (when (natnump ffap-max-region-length)
+ (insert
+ (concat
+ str
+ (make-string ffap-max-region-length #xa)
+ (format "%s ENDS HERE" file)))
+ (call-interactively 'mark-whole-buffer)
+ (should (equal "" (ffap-string-at-point)))
+ (should (equal '(1 1) ffap-string-at-point-region))))))
(ert-deftest ffap-gopher-at-point ()
(with-temp-buffer
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index f2a6e062acc..c641851261d 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -176,15 +176,14 @@ form.")
;; If called interactively, environment variable
;; $EMACS_TEST_DIRECTORY does not exist.
(skip-unless (file-exists-p files-test-bug-18141-file))
- (let ((tempfile (make-temp-file "files-test-bug-18141" nil ".gz")))
- (unwind-protect
- (progn
- (copy-file files-test-bug-18141-file tempfile t)
- (with-current-buffer (find-file-noselect tempfile)
- (set-buffer-modified-p t)
- (save-buffer)
- (should (eq buffer-file-coding-system 'iso-2022-7bit-unix))))
- (delete-file tempfile))))
+ (ert-with-temp-file tempfile
+ :prefix "emacs-test-files-bug-18141"
+ :suffix ".gz"
+ (copy-file files-test-bug-18141-file tempfile t)
+ (with-current-buffer (find-file-noselect tempfile)
+ (set-buffer-modified-p t)
+ (save-buffer)
+ (should (eq buffer-file-coding-system 'iso-2022-7bit-unix)))))
(ert-deftest files-tests-make-temp-file-empty-prefix ()
"Test make-temp-file with an empty prefix."
@@ -283,22 +282,20 @@ If we are in a directory named `~', the default value should not
be $HOME."
(cl-letf (((symbol-function 'completing-read)
(lambda (_prompt _coll &optional _pred _req init _hist def _)
- (or def init)))
- (dir (make-temp-file "read-file-name-test" t)))
- (unwind-protect
- (let ((subdir (expand-file-name "./~/" dir)))
- (make-directory subdir t)
- (with-temp-buffer
- (setq default-directory subdir)
- (should-not (equal
- (expand-file-name (read-file-name "File: "))
- (expand-file-name "~/")))
- ;; Don't overquote either!
- (setq default-directory (concat "/:" subdir))
- (should-not (equal
- (expand-file-name (read-file-name "File: "))
- (concat "/:/:" subdir)))))
- (delete-directory dir 'recursive))))
+ (or def init))))
+ (ert-with-temp-directory dir
+ (let ((subdir (expand-file-name "./~/" dir)))
+ (make-directory subdir t)
+ (with-temp-buffer
+ (setq default-directory subdir)
+ (should-not (equal
+ (expand-file-name (read-file-name "File: "))
+ (expand-file-name "~/")))
+ ;; Don't overquote either!
+ (setq default-directory (concat "/:" subdir))
+ (should-not (equal
+ (expand-file-name (read-file-name "File: "))
+ (concat "/:/:" subdir))))))))
(ert-deftest files-tests-file-name-non-special-quote-unquote ()
(let (;; Just in case it is quoted, who knows.
@@ -1231,26 +1228,26 @@ works as expected if the default directory is quoted."
(insert-directory-wildcard-in-dir-p (car path-res)))))))
(ert-deftest files-tests-make-directory ()
- (let* ((dir (make-temp-file "files-mkdir-test" t))
- (dirname (file-name-as-directory dir))
- (file (concat dirname "file"))
- (subdir1 (concat dirname "subdir1"))
- (subdir2 (concat dirname "subdir2"))
- (a/b (concat dirname "a/b")))
- (write-region "" nil file)
- (should-error (make-directory "/"))
- (should-not (make-directory "/" t))
- (should-error (make-directory dir))
- (should-not (make-directory dir t))
- (should-error (make-directory dirname))
- (should-not (make-directory dirname t))
- (should-error (make-directory file))
- (should-error (make-directory file t))
- (should-not (make-directory subdir1))
- (should-not (make-directory subdir2 t))
- (should-error (make-directory a/b))
- (should-not (make-directory a/b t))
- (delete-directory dir 'recursive)))
+ (ert-with-temp-directory dir
+ (let* ((dirname (file-name-as-directory dir))
+ (file (concat dirname "file"))
+ (subdir1 (concat dirname "subdir1"))
+ (subdir2 (concat dirname "subdir2"))
+ (a/b (concat dirname "a/b")))
+ (write-region "" nil file)
+ (should-error (make-directory "/"))
+ (should-not (make-directory "/" t))
+ (should-error (make-directory dir))
+ (should-not (make-directory dir t))
+ (should-error (make-directory dirname))
+ (should-not (make-directory dirname t))
+ (should-error (make-directory file))
+ (should-error (make-directory file t))
+ (should-not (make-directory subdir1))
+ (should-not (make-directory subdir2 t))
+ (should-error (make-directory a/b))
+ (should-not (make-directory a/b t))
+ (delete-directory dir 'recursive))))
(ert-deftest files-tests-file-modes-symbolic-to-number ()
(let ((alist (list (cons "a=rwx" #o777)
@@ -1318,21 +1315,21 @@ name (Bug#28412)."
(should (eq (buffer-size) 1))))))
(ert-deftest files-tests-copy-directory ()
- (let* ((dir (make-temp-file "files-mkdir-test" t))
- (dirname (file-name-as-directory dir))
- (source (concat dirname "source"))
- (dest (concat dirname "dest/new/directory/"))
- (file (concat (file-name-as-directory source) "file"))
- (source2 (concat dirname "source2"))
- (dest2 (concat dirname "dest/new2")))
- (make-directory source)
- (write-region "" nil file)
- (copy-directory source dest t t t)
- (should (file-exists-p (concat dest "file")))
- (make-directory (concat (file-name-as-directory source2) "a") t)
- (copy-directory source2 dest2)
- (should (file-directory-p (concat (file-name-as-directory dest2) "a")))
- (delete-directory dir 'recursive)))
+ (ert-with-temp-directory dir
+ (let* ((dirname (file-name-as-directory dir))
+ (source (concat dirname "source"))
+ (dest (concat dirname "dest/new/directory/"))
+ (file (concat (file-name-as-directory source) "file"))
+ (source2 (concat dirname "source2"))
+ (dest2 (concat dirname "dest/new2")))
+ (make-directory source)
+ (write-region "" nil file)
+ (copy-directory source dest t t t)
+ (should (file-exists-p (concat dest "file")))
+ (make-directory (concat (file-name-as-directory source2) "a") t)
+ (copy-directory source2 dest2)
+ (should (file-directory-p (concat (file-name-as-directory dest2) "a")))
+ (delete-directory dir 'recursive))))
(ert-deftest files-tests-abbreviated-home-dir ()
"Test that changing HOME does not confuse `abbreviate-file-name'.
@@ -1351,43 +1348,41 @@ See <https://debbugs.gnu.org/19657#20>."
(ert-deftest files-tests-executable-find ()
"Test that `executable-find' works also with a relative or remote PATH.
See <https://debbugs.gnu.org/35241>."
- (let ((tmpfile (make-temp-file "files-test" nil (car exec-suffixes))))
- (unwind-protect
- (progn
- (set-file-modes tmpfile #o777)
- (let ((exec-path `(,temporary-file-directory)))
- (should
- (equal tmpfile
- (executable-find (file-name-nondirectory tmpfile)))))
- ;; An empty element of `exec-path' means `default-directory'.
- (let ((default-directory temporary-file-directory)
- (exec-path nil))
- (should
- (equal tmpfile
- (executable-find (file-name-nondirectory tmpfile)))))
- ;; The remote file name shall be quoted, and handled like a
- ;; non-existing directory.
- (let ((default-directory "/ssh::")
- (exec-path (append exec-path `("." ,temporary-file-directory))))
- (should
- (equal tmpfile
- (executable-find (file-name-nondirectory tmpfile))))))
- (delete-file tmpfile))))
+ (ert-with-temp-file tmpfile
+ :suffix (car exec-suffixes)
+ (let ((tmpfile (make-temp-file "files-test" nil )))
+ (set-file-modes tmpfile #o777)
+ (let ((exec-path `(,temporary-file-directory)))
+ (should
+ (equal tmpfile
+ (executable-find (file-name-nondirectory tmpfile)))))
+ ;; An empty element of `exec-path' means `default-directory'.
+ (let ((default-directory temporary-file-directory)
+ (exec-path nil))
+ (should
+ (equal tmpfile
+ (executable-find (file-name-nondirectory tmpfile)))))
+ ;; The remote file name shall be quoted, and handled like a
+ ;; non-existing directory.
+ (let ((default-directory "/ssh::")
+ (exec-path (append exec-path `("." ,temporary-file-directory))))
+ (should
+ (equal tmpfile
+ (executable-find (file-name-nondirectory tmpfile))))))))
(ert-deftest files-tests-dont-rewrite-precious-files ()
"Test that `file-precious-flag' forces files to be saved by
renaming only, rather than modified in-place."
- (let* ((temp-file-name (make-temp-file "files-tests"))
- (advice (lambda (_start _end filename &rest _r)
- (should-not (string= filename temp-file-name)))))
- (unwind-protect
- (with-current-buffer (find-file-noselect temp-file-name)
- (advice-add #'write-region :before advice)
- (setq-local file-precious-flag t)
- (insert "foobar")
- (should (null (save-buffer))))
- (ignore-errors (advice-remove #'write-region advice))
- (ignore-errors (delete-file temp-file-name)))))
+ (ert-with-temp-file temp-file-name
+ (let* ((advice (lambda (_start _end filename &rest _r)
+ (should-not (string= filename temp-file-name)))))
+ (unwind-protect
+ (with-current-buffer (find-file-noselect temp-file-name)
+ (advice-add #'write-region :before advice)
+ (setq-local file-precious-flag t)
+ (insert "foobar")
+ (should (null (save-buffer))))
+ (ignore-errors (advice-remove #'write-region advice))))))
(ert-deftest files-test-file-size-human-readable ()
(should (equal (file-size-human-readable 13) "13"))
@@ -1578,40 +1573,39 @@ on BUF-1 and BUF-2 after the `save-some-buffers' call.
The test is repeated with `save-some-buffers-default-predicate'
let-bound to PRED and passing nil as second arg of
`save-some-buffers'."
- (let* ((dir (make-temp-file "testdir" 'dir))
- (file-1 (expand-file-name "subdir-1/file.foo" dir))
- (file-2 (expand-file-name "subdir-2/file.bar" dir))
- (inhibit-message t)
- buf-1 buf-2)
- (unwind-protect
- (progn
- (make-empty-file file-1 'parens)
- (make-empty-file file-2 'parens)
- (setq buf-1 (find-file file-1)
- buf-2 (find-file file-2))
- (dolist (buf (list buf-1 buf-2))
- (with-current-buffer buf (insert "foobar\n")))
- ;; Run the test.
- (with-current-buffer buf-1
- (let ((save-some-buffers-default-predicate def-pred-bind))
- (save-some-buffers t pred))
- (should (eq exp-1 (buffer-modified-p buf-1)))
- (should (eq exp-2 (buffer-modified-p buf-2))))
- ;; Set both buffers as modified to run another test.
- (dolist (buf (list buf-1 buf-2))
- (with-current-buffer buf (set-buffer-modified-p t)))
- ;; The result of this test must be identical as the previous one.
- (with-current-buffer buf-1
- (let ((save-some-buffers-default-predicate (or pred def-pred-bind)))
- (save-some-buffers t nil))
- (should (eq exp-1 (buffer-modified-p buf-1)))
- (should (eq exp-2 (buffer-modified-p buf-2)))))
- ;; Clean up.
- (dolist (buf (list buf-1 buf-2))
- (with-current-buffer buf
- (set-buffer-modified-p nil)
- (kill-buffer buf)))
- (delete-directory dir 'recursive))))
+ (ert-with-temp-directory dir
+ (let* ((file-1 (expand-file-name "subdir-1/file.foo" dir))
+ (file-2 (expand-file-name "subdir-2/file.bar" dir))
+ (inhibit-message t)
+ buf-1 buf-2)
+ (unwind-protect
+ (progn
+ (make-empty-file file-1 'parens)
+ (make-empty-file file-2 'parens)
+ (setq buf-1 (find-file file-1)
+ buf-2 (find-file file-2))
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf (insert "foobar\n")))
+ ;; Run the test.
+ (with-current-buffer buf-1
+ (let ((save-some-buffers-default-predicate def-pred-bind))
+ (save-some-buffers t pred))
+ (should (eq exp-1 (buffer-modified-p buf-1)))
+ (should (eq exp-2 (buffer-modified-p buf-2))))
+ ;; Set both buffers as modified to run another test.
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf (set-buffer-modified-p t)))
+ ;; The result of this test must be identical as the previous one.
+ (with-current-buffer buf-1
+ (let ((save-some-buffers-default-predicate (or pred def-pred-bind)))
+ (save-some-buffers t nil))
+ (should (eq exp-1 (buffer-modified-p buf-1)))
+ (should (eq exp-2 (buffer-modified-p buf-2)))))
+ ;; Clean up.
+ (dolist (buf (list buf-1 buf-2))
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))))))
(ert-deftest files-tests-save-some-buffers ()
"Test `save-some-buffers'.
diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el
index e386398eea2..e3a75bed41d 100644
--- a/test/lisp/ls-lisp-tests.el
+++ b/test/lisp/ls-lisp-tests.el
@@ -25,6 +25,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'ls-lisp)
(require 'dired)
@@ -59,22 +60,22 @@
(ert-deftest ls-lisp-test-bug27631 ()
"Test for https://debbugs.gnu.org/27631 ."
- (let* ((dir (make-temp-file "bug27631" 'dir))
- (dir1 (expand-file-name "dir1" dir))
- (dir2 (expand-file-name "dir2" dir))
- (default-directory dir)
- ls-lisp-use-insert-directory-program buf)
- (unwind-protect
- (progn
- (make-directory dir1)
- (make-directory dir2)
- (with-temp-file (expand-file-name "a.txt" dir1))
- (with-temp-file (expand-file-name "b.txt" dir2))
- (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
- (dired-toggle-marks)
- (should (cdr (dired-get-marked-files))))
- (delete-directory dir 'recursive)
- (when (buffer-live-p buf) (kill-buffer buf)))))
+ (ert-with-temp-directory dir
+ :suffix "bug27631"
+ (let* ((dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
+ (default-directory dir)
+ ls-lisp-use-insert-directory-program buf)
+ (unwind-protect
+ (progn
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (when (buffer-live-p buf) (kill-buffer buf))))))
(ert-deftest ls-lisp-test-bug27693 ()
"Test for https://debbugs.gnu.org/27693 ."
diff --git a/test/lisp/mail/uudecode-tests.el b/test/lisp/mail/uudecode-tests.el
index 981ce1c4ae0..1899ff50f69 100644
--- a/test/lisp/mail/uudecode-tests.el
+++ b/test/lisp/mail/uudecode-tests.el
@@ -50,14 +50,11 @@ Same as `uudecode-tests-encoded-str' but plain text.")
(should (equal (buffer-string) uudecode-tests-decoded-str)))
;; Write to file
(with-temp-buffer
- (let ((tmpfile (make-temp-file "uudecode-tests-")))
- (unwind-protect
- (progn
- (insert uudecode-tests-encoded-str)
- (uudecode-decode-region-internal (point-min) (point-max) tmpfile)
- (should (equal (uudecode-tests-read-file tmpfile)
- uudecode-tests-decoded-str)))
- (delete-file tmpfile)))))
+ (ert-with-temp-file tmpfile
+ (insert uudecode-tests-encoded-str)
+ (uudecode-decode-region-internal (point-min) (point-max) tmpfile)
+ (should (equal (uudecode-tests-read-file tmpfile)
+ uudecode-tests-decoded-str)))))
(ert-deftest uudecode-tests-decode-region-external ()
;; Write to buffer
@@ -68,14 +65,11 @@ Same as `uudecode-tests-encoded-str' but plain text.")
(should (equal (buffer-string) uudecode-tests-decoded-str)))
;; Write to file
(with-temp-buffer
- (let ((tmpfile (make-temp-file "uudecode-tests-")))
- (unwind-protect
- (progn
- (insert uudecode-tests-encoded-str)
- (uudecode-decode-region-external (point-min) (point-max) tmpfile)
- (should (equal (uudecode-tests-read-file tmpfile)
- uudecode-tests-decoded-str)))
- (delete-file tmpfile))))))
+ (ert-with-temp-file tmpfile
+ (insert uudecode-tests-encoded-str)
+ (uudecode-decode-region-external (point-min) (point-max) tmpfile)
+ (should (equal (uudecode-tests-read-file tmpfile)
+ uudecode-tests-decoded-str))))))
(provide 'uudecode-tests)
;;; uudecode-tests.el ends here
diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el
index 4264e03d912..68c7c349013 100644
--- a/test/lisp/net/browse-url-tests.el
+++ b/test/lisp/net/browse-url-tests.el
@@ -28,6 +28,7 @@
(require 'browse-url)
(require 'ert)
+(require 'ert-x)
(ert-deftest browse-url-tests-browser-kind ()
(should (eq (browse-url--browser-kind #'browse-url-w3 "gnu.org")
@@ -87,11 +88,10 @@
"ftp://foo/")))
(ert-deftest browse-url-tests-delete-temp-file ()
- (let ((browse-url-temp-file-name
- (make-temp-file "browse-url-tests-")))
+ (ert-with-temp-file browse-url-temp-file-name
(browse-url-delete-temp-file)
(should-not (file-exists-p browse-url-temp-file-name)))
- (let ((file (make-temp-file "browse-url-tests-")))
+ (ert-with-temp-file file
(browse-url-delete-temp-file file)
(should-not (file-exists-p file))))
diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index 9516687f5b0..7f1cd6795ef 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -302,12 +302,9 @@
;; tmp may be on a different filesystem to the tests, but, ehh.
(defvar xref--case-insensitive
- (let ((dir (make-temp-file "xref-test" t)))
- (unwind-protect
- (progn
- (with-temp-file (expand-file-name "hElLo" dir) "hello")
- (file-exists-p (expand-file-name "HELLO" dir)))
- (delete-directory dir t)))
+ (ert-with-temp-directory dir
+ (with-temp-file (expand-file-name "hElLo" dir) "hello")
+ (file-exists-p (expand-file-name "HELLO" dir)))
"Non-nil if file system seems to be case-insensitive.")
(defun xref-elisp-test-run (xrefs expected-xrefs)
diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el
index 9b14a3ae860..32b73f101e1 100644
--- a/test/lisp/progmodes/etags-tests.el
+++ b/test/lisp/progmodes/etags-tests.el
@@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'etags)
(eval-when-compile (require 'cl-lib))
@@ -95,21 +96,19 @@
(ert-deftest etags-buffer-local-tags-table-list ()
"Test that a buffer-local value of `tags-table-list' is used."
- (let ((file (make-temp-file "etag-test-tmpfile")))
- (unwind-protect
- (progn
- (set-buffer (find-file-noselect file))
- (fundamental-mode)
- (setq-local tags-table-list
- (list (expand-file-name "manual/etags/ETAGS.good_3"
- etags-tests--test-dir)))
- (cl-letf ((tag-tables tags-table-list)
- (tags-file-name nil)
- ((symbol-function 'read-file-name)
- (lambda (&rest _)
- (error "We should not prompt the user"))))
- (should (visit-tags-table-buffer))
- (should (equal tags-file-name (car tag-tables)))))
- (delete-file file))))
+ (ert-with-temp-file file
+ :suffix "etag-test-tmpfile"
+ (set-buffer (find-file-noselect file))
+ (fundamental-mode)
+ (setq-local tags-table-list
+ (list (expand-file-name "manual/etags/ETAGS.good_3"
+ etags-tests--test-dir)))
+ (cl-letf ((tag-tables tags-table-list)
+ (tags-file-name nil)
+ ((symbol-function 'read-file-name)
+ (lambda (&rest _)
+ (error "We should not prompt the user"))))
+ (should (visit-tags-table-buffer))
+ (should (equal tags-file-name (car tag-tables))))))
;;; etags-tests.el ends here
diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el
index 4c0d15d1e1b..4840018236a 100644
--- a/test/lisp/progmodes/flymake-tests.el
+++ b/test/lisp/progmodes/flymake-tests.el
@@ -23,6 +23,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'flymake)
(eval-when-compile (require 'subr-x)) ; string-trim
@@ -123,22 +124,21 @@ SEVERITY-PREDICATE is used to setup
"Test the ruby backend."
(skip-unless (executable-find "ruby"))
;; Some versions of ruby fail if HOME doesn't exist (bug#29187).
- (let* ((tempdir (make-temp-file "flymake-tests-ruby" t))
- (process-environment (cons (format "HOME=%s" tempdir)
- process-environment))
- ;; And see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19657#20
- ;; for this particular yuckiness
- (abbreviated-home-dir nil))
- (unwind-protect
- (let ((ruby-mode-hook
- (lambda ()
- (setq flymake-diagnostic-functions '(ruby-flymake-simple)))))
- (flymake-tests--with-flymake ("test.rb")
- (flymake-goto-next-error)
- (should (eq 'flymake-warning (face-at-point)))
- (flymake-goto-next-error)
- (should (eq 'flymake-error (face-at-point)))))
- (delete-directory tempdir t))))
+ (ert-with-temp-directory tempdir
+ :suffix "flymake-tests-ruby"
+ (let* ((process-environment (cons (format "HOME=%s" tempdir)
+ process-environment))
+ ;; And see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19657#20
+ ;; for this particular yuckiness
+ (abbreviated-home-dir nil)
+ (ruby-mode-hook
+ (lambda ()
+ (setq flymake-diagnostic-functions '(ruby-flymake-simple)))))
+ (flymake-tests--with-flymake ("test.rb")
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point)))))))
(ert-deftest different-diagnostic-types ()
"Test GCC warning via function predicate."
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index 6ab9c62746e..15bda5c197a 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'python)
;; Dependencies for testing:
@@ -48,17 +49,17 @@ BODY is code to be executed within the temp buffer. Point is
always located at the beginning of buffer."
(declare (indent 1) (debug t))
;; temp-file never actually used for anything?
- `(let* ((temp-file (make-temp-file "python-tests" nil ".py"))
- (buffer (find-file-noselect temp-file))
- (python-indent-guess-indent-offset nil))
- (unwind-protect
- (with-current-buffer buffer
- (python-mode)
- (insert ,contents)
- (goto-char (point-min))
- ,@body)
- (and buffer (kill-buffer buffer))
- (delete-file temp-file))))
+ `(ert-with-temp-file temp-file
+ :suffix "-python.py"
+ (let ((buffer (find-file-noselect temp-file))
+ (python-indent-guess-indent-offset nil))
+ (unwind-protect
+ (with-current-buffer buffer
+ (python-mode)
+ (insert ,contents)
+ (goto-char (point-min))
+ ,@body)
+ (and buffer (kill-buffer buffer))))))
(defun python-tests-look-at (string &optional num restore-point)
"Move point at beginning of STRING in the current buffer.
diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el
index aed82b18825..1bbe3a95e90 100644
--- a/test/lisp/progmodes/sql-tests.el
+++ b/test/lisp/progmodes/sql-tests.el
@@ -28,6 +28,7 @@
(require 'cl-lib)
(require 'ert)
+(require 'ert-x)
(require 'sql)
(ert-deftest sql-tests-postgres-list-databases ()
@@ -63,52 +64,49 @@ Identify tests by ID. Set :sql-login dialect attribute to
LOGIN-PARAMS. Provide the CONNECTION parameters and the EXPECTED
string of values passed to the comint function for validation."
(declare (indent 2))
- `(cl-letf
- ((sql-test-login-params ' ,login-params)
- ((symbol-function 'sql-comint-test)
- (lambda (product options &optional buf-name)
- (with-current-buffer (get-buffer-create buf-name)
- (insert (pp-to-string (list product options sql-user sql-password sql-server sql-database))))))
- ((symbol-function 'sql-run-test)
- (lambda (&optional buffer)
- (interactive "P")
- (sql-product-interactive 'sqltest buffer)))
- (sql-user nil)
- (sql-server nil)
- (sql-database nil)
- (sql-product-alist
- '((ansi)
- (sqltest
- :name "SqlTest"
- :sqli-login sql-test-login-params
- :sqli-comint-func sql-comint-test)))
- (sql-connection-alist
- '((,(format "test-%s" id)
- ,@connection)))
- (sql-password-wallet
- (list
- (make-temp-file
- "sql-test-netrc" nil nil
- (mapconcat #'identity
- '("machine aMachine user aUserName password \"netrc-A aPassword\""
- "machine aServer user aUserName password \"netrc-B aPassword\""
- "machine aMachine server aServer user aUserName password \"netrc-C aPassword\""
- "machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\""
- "machine aDatabase user aUserName password \"netrc-E aPassword\""
- "machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\""
- "machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\""
- ) "\n")))))
-
- (let* ((connection ,(format "test-%s" id))
- (buffername (format "*SQL: ERT TEST <%s>*" connection)))
- (when (get-buffer buffername)
- (kill-buffer buffername))
- (sql-connect connection buffername)
- (should (get-buffer buffername))
- (should (string-equal (with-current-buffer buffername (buffer-string)) ,expected))
- (when (get-buffer buffername)
- (kill-buffer buffername))
- (delete-file (car sql-password-wallet)))))
+ `(ert-with-temp-file tempfile
+ :suffix "sql-test-netrc"
+ :text (concat
+ "machine aMachine user aUserName password \"netrc-A aPassword\""
+ "machine aServer user aUserName password \"netrc-B aPassword\""
+ "machine aMachine server aServer user aUserName password \"netrc-C aPassword\""
+ "machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\""
+ "machine aDatabase user aUserName password \"netrc-E aPassword\""
+ "machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\""
+ "machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\""
+ "\n")
+ (cl-letf
+ ((sql-test-login-params ' ,login-params)
+ ((symbol-function 'sql-comint-test)
+ (lambda (product options &optional buf-name)
+ (with-current-buffer (get-buffer-create buf-name)
+ (insert (pp-to-string (list product options sql-user sql-password sql-server sql-database))))))
+ ((symbol-function 'sql-run-test)
+ (lambda (&optional buffer)
+ (interactive "P")
+ (sql-product-interactive 'sqltest buffer)))
+ (sql-user nil)
+ (sql-server nil)
+ (sql-database nil)
+ (sql-product-alist
+ '((ansi)
+ (sqltest
+ :name "SqlTest"
+ :sqli-login sql-test-login-params
+ :sqli-comint-func sql-comint-test)))
+ (sql-connection-alist
+ '((,(format "test-%s" id)
+ ,@connection)))
+ (sql-password-wallet (list tempfile)))
+ (let* ((connection ,(format "test-%s" id))
+ (buffername (format "*SQL: ERT TEST <%s>*" connection)))
+ (when (get-buffer buffername)
+ (kill-buffer buffername))
+ (sql-connect connection buffername)
+ (should (get-buffer buffername))
+ (should (string-equal (with-current-buffer buffername (buffer-string)) ,expected))
+ (when (get-buffer buffername)
+ (kill-buffer buffername))))))
(ert-deftest sql-test-connect ()
"Test of basic `sql-connect'."
diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el
index 63577fdd167..190ffb78288 100644
--- a/test/lisp/saveplace-tests.el
+++ b/test/lisp/saveplace-tests.el
@@ -41,49 +41,42 @@
(ert-deftest saveplace-test-save-place-to-alist/file ()
(save-place-mode)
- (let* ((tmpfile (make-temp-file "emacs-test-saveplace-"))
- (tmpfile (file-truename tmpfile))
- (save-place-alist nil)
- (save-place-loaded t)
- (loc tmpfile)
- (pos 4))
- (unwind-protect
- (save-window-excursion
- (find-file loc)
- (insert "abc") ; must insert something
- (save-place-to-alist)
- (should (equal save-place-alist (list (cons tmpfile pos)))))
- (delete-file tmpfile))))
+ (ert-with-temp-file tmpfile
+ (let* ((tmpfile (file-truename tmpfile))
+ (save-place-alist nil)
+ (save-place-loaded t)
+ (loc tmpfile)
+ (pos 4))
+ (save-window-excursion
+ (find-file loc)
+ (insert "abc") ; must insert something
+ (save-place-to-alist)
+ (should (equal save-place-alist (list (cons tmpfile pos))))))))
(ert-deftest saveplace-test-forget-unreadable-files ()
(save-place-mode)
- (let* ((save-place-loaded t)
- (tmpfile (make-temp-file "emacs-test-saveplace-"))
- (alist-orig (list (cons "/this/file/does/not/exist" 10)
- (cons tmpfile 1917)))
- (save-place-alist alist-orig))
- (unwind-protect
- (progn
- (save-place-forget-unreadable-files)
- (should (equal save-place-alist (cdr alist-orig))))
- (delete-file tmpfile))))
+ (ert-with-temp-file tmpfile
+ :suffix "-saveplace"
+ (let* ((save-place-loaded t)
+ (alist-orig (list (cons "/this/file/does/not/exist" 10)
+ (cons tmpfile 1917)))
+ (save-place-alist alist-orig))
+ (save-place-forget-unreadable-files)
+ (should (equal save-place-alist (cdr alist-orig))))))
(ert-deftest saveplace-test-place-alist-to-file ()
(save-place-mode)
- (let* ((tmpfile (make-temp-file "emacs-test-saveplace-"))
- (tmpfile2 (make-temp-file "emacs-test-saveplace-"))
- (save-place-file tmpfile)
- (save-place-alist (list (cons tmpfile2 99))))
- (unwind-protect
- (progn (save-place-alist-to-file)
- (setq save-place-alist nil)
- (save-window-excursion
- (find-file save-place-file)
- (unwind-protect
- (should (string-match tmpfile2 (buffer-string)))
- (kill-buffer))))
- (delete-file tmpfile)
- (delete-file tmpfile2))))
+ (ert-with-temp-file tmpfile
+ (ert-with-temp-file tmpfile2
+ (let* ((save-place-file tmpfile)
+ (save-place-alist (list (cons tmpfile2 99))))
+ (save-place-alist-to-file)
+ (setq save-place-alist nil)
+ (save-window-excursion
+ (find-file save-place-file)
+ (unwind-protect
+ (should (string-match tmpfile2 (buffer-string)))
+ (kill-buffer)))))))
(ert-deftest saveplace-test-load-alist-from-file ()
(save-place-mode)
diff --git a/test/lisp/so-long-tests/spelling-tests.el b/test/lisp/so-long-tests/spelling-tests.el
index f778b646635..b598366ba7a 100644
--- a/test/lisp/so-long-tests/spelling-tests.el
+++ b/test/lisp/so-long-tests/spelling-tests.el
@@ -23,6 +23,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'ispell)
(require 'cl-lib)
@@ -50,20 +51,19 @@
;; The Emacs test Makefile's use of HOME=/nonexistent triggers an error
;; when starting the inferior ispell process, so we set HOME to a valid
;; (but empty) temporary directory for this test.
- (let* ((tmpdir (make-temp-file "so-long." :dir ".ispell"))
- (process-environment (cons (format "HOME=%s" tmpdir)
- process-environment))
- (find-spelling-mistake
- (unwind-protect
- (cl-letf (((symbol-function 'ispell-command-loop)
- (lambda (_miss _guess word _start _end)
- (message "Unrecognised word: %s." word)
- (throw 'mistake t))))
- (catch 'mistake
- (find-library "so-long")
- (ispell-buffer)
- nil))
- (delete-directory tmpdir))))
- (should (not find-spelling-mistake)))))
+ (ert-with-temp-file tmpdir
+ :suffix "so-long.ispell"
+ (let* ((process-environment (cons (format "HOME=%s" tmpdir)
+ process-environment))
+ (find-spelling-mistake
+ (cl-letf (((symbol-function 'ispell-command-loop)
+ (lambda (_miss _guess word _start _end)
+ (message "Unrecognised word: %s." word)
+ (throw 'mistake t))))
+ (catch 'mistake
+ (find-library "so-long")
+ (ispell-buffer)
+ nil))))
+ (should (not find-spelling-mistake))))))
;;; spelling-tests.el ends here
diff --git a/test/lisp/textmodes/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el
index b824e05f6d5..cc5b23e1c9c 100644
--- a/test/lisp/textmodes/reftex-tests.el
+++ b/test/lisp/textmodes/reftex-tests.el
@@ -24,6 +24,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
;;; reftex
(require 'reftex)
@@ -33,32 +34,31 @@
(ert-deftest reftex-locate-bibliography-files ()
"Test `reftex-locate-bibliography-files'."
- (let ((temp-dir (make-temp-file "reftex-bib" 'dir))
- (files '("ref1.bib" "ref2.bib"))
- (test '(("\\addbibresource{ref1.bib}\n" . ("ref1.bib"))
- ("\\\\addbibresource[label=x]{ref2.bib}\\n" . ("ref2.bib"))
- ("\\begin{document}\n\\bibliographystyle{plain}\n
+ (ert-with-temp-directory temp-dir
+ (let ((files '("ref1.bib" "ref2.bib"))
+ (test '(("\\addbibresource{ref1.bib}\n" . ("ref1.bib"))
+ ("\\\\addbibresource[label=x]{ref2.bib}\\n" . ("ref2.bib"))
+ ("\\begin{document}\n\\bibliographystyle{plain}\n
\\bibliography{ref1,ref2}\n\\end{document}" . ("ref1.bib" "ref2.bib"))))
- (reftex-bibliography-commands
- ;; Default value: See reftex-vars.el `reftex-bibliography-commands'
- '("bibliography" "nobibliography" "setupbibtex\\[.*?database="
- "addbibresource")))
- (with-temp-buffer
- (insert "test\n")
+ (reftex-bibliography-commands
+ ;; Default value: See reftex-vars.el `reftex-bibliography-commands'
+ '("bibliography" "nobibliography" "setupbibtex\\[.*?database="
+ "addbibresource")))
+ (with-temp-buffer
+ (insert "test\n")
+ (mapc
+ (lambda (file)
+ (write-region (point-min) (point-max) (expand-file-name file
+ temp-dir)))
+ files))
(mapc
- (lambda (file)
- (write-region (point-min) (point-max) (expand-file-name file
- temp-dir)))
- files))
- (mapc
- (lambda (data)
- (with-temp-buffer
- (insert (car data))
- (let ((res (mapcar #'file-name-nondirectory
- (reftex-locate-bibliography-files temp-dir))))
- (should (equal res (cdr data))))))
- test)
- (delete-directory temp-dir 'recursive)))
+ (lambda (data)
+ (with-temp-buffer
+ (insert (car data))
+ (let ((res (mapcar #'file-name-nondirectory
+ (reftex-locate-bibliography-files temp-dir))))
+ (should (equal res (cdr data))))))
+ test))))
(ert-deftest reftex-what-environment-test ()
"Test `reftex-what-environment'."
@@ -102,12 +102,12 @@
;; reason. (An alternative solution would be to use file-equal-p,
;; but I'm too lazy to do that, as one of the tests compares a
;; list.)
- (let* ((temp-dir (file-truename (make-temp-file "reftex-parse" 'dir)))
- (tex-file (expand-file-name "test.tex" temp-dir))
- (bib-file (expand-file-name "ref.bib" temp-dir)))
- (with-temp-buffer
- (insert
-"\\begin{document}
+ (ert-with-temp-directory temp-dir
+ (let* ((tex-file (expand-file-name "test.tex" temp-dir))
+ (bib-file (expand-file-name "ref.bib" temp-dir)))
+ (with-temp-buffer
+ (insert
+ "\\begin{document}
\\section{test}\\label{sec:test}
\\subsection{subtest}
@@ -118,27 +118,26 @@
\\bibliographystyle{plain}
\\bibliography{ref}
\\end{document}")
- (write-region (point-min) (point-max) tex-file))
- (with-temp-buffer
- (insert "test\n")
- (write-region (point-min) (point-max) bib-file))
- (reftex-ensure-compiled-variables)
- (let ((parsed (reftex-parse-from-file tex-file nil temp-dir)))
- (should (equal (car parsed) `(eof ,tex-file)))
- (pop parsed)
- (while parsed
- (let ((entry (pop parsed)))
- (cond
- ((eq (car entry) 'bib)
- (should (string= (cadr entry) bib-file)))
- ((eq (car entry) 'toc)) ;; ...
- ((string= (car entry) "eq:foo"))
- ((string= (car entry) "sec:test"))
- ((eq (car entry) 'bof)
- (should (string= (cadr entry) tex-file))
- (should (null parsed)))
- (t (should-not t)))))
- (delete-directory temp-dir 'recursive))))
+ (write-region (point-min) (point-max) tex-file))
+ (with-temp-buffer
+ (insert "test\n")
+ (write-region (point-min) (point-max) bib-file))
+ (reftex-ensure-compiled-variables)
+ (let ((parsed (reftex-parse-from-file tex-file nil temp-dir)))
+ (should (equal (car parsed) `(eof ,tex-file)))
+ (pop parsed)
+ (while parsed
+ (let ((entry (pop parsed)))
+ (cond
+ ((eq (car entry) 'bib)
+ (should (string= (cadr entry) bib-file)))
+ ((eq (car entry) 'toc)) ;; ...
+ ((string= (car entry) "eq:foo"))
+ ((string= (car entry) "sec:test"))
+ ((eq (car entry) 'bof)
+ (should (string= (cadr entry) tex-file))
+ (should (null parsed)))
+ (t (should-not t)))))))))
;;; reftex-cite
(require 'reftex-cite)
diff --git a/test/lisp/thumbs-tests.el b/test/lisp/thumbs-tests.el
index ee096138453..a9b41d7c00f 100644
--- a/test/lisp/thumbs-tests.el
+++ b/test/lisp/thumbs-tests.el
@@ -20,15 +20,13 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'thumbs)
(ert-deftest thumbs-tests-thumbsdir/create-if-missing ()
- (let ((thumbs-thumbsdir (make-temp-file "thumbs-test" t)))
- (unwind-protect
- (progn
- (delete-directory thumbs-thumbsdir)
- (should (file-directory-p (thumbs-thumbsdir))))
- (delete-directory thumbs-thumbsdir))))
+ (ert-with-temp-directory thumbs-thumbsdir
+ (delete-directory thumbs-thumbsdir)
+ (should (file-directory-p (thumbs-thumbsdir)))))
(provide 'thumbs-tests)
;;; thumbs-tests.el ends here
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index ef19fe0e0e8..909d5620de6 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -173,35 +173,33 @@ wristwatches
wrongheadedly
wrongheadedness
youthfulness
-")
- (temp-dir (make-temp-file "diff-mode-test" 'dir)))
-
- (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" )))
- (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2"))))
- (unwind-protect
- (progn
- (with-current-buffer buf (insert fil_before) (save-buffer))
- (with-current-buffer buf2 (insert fil2_before) (save-buffer))
-
- (with-temp-buffer
- (cd temp-dir)
- (insert patch)
- (goto-char (point-min))
- (diff-apply-hunk)
- (diff-apply-hunk)
- (diff-apply-hunk))
-
- (should (equal (with-current-buffer buf (buffer-string))
- fil_after))
- (should (equal (with-current-buffer buf2 (buffer-string))
- fil2_after)))
-
- (ignore-errors
- (with-current-buffer buf (set-buffer-modified-p nil))
- (kill-buffer buf)
- (with-current-buffer buf2 (set-buffer-modified-p nil))
- (kill-buffer buf2)
- (delete-directory temp-dir 'recursive))))))
+"))
+ (ert-with-temp-directory temp-dir
+ (let ((buf (find-file-noselect (format "%s/%s" temp-dir "fil" )))
+ (buf2 (find-file-noselect (format "%s/%s" temp-dir "fil2"))))
+ (unwind-protect
+ (progn
+ (with-current-buffer buf (insert fil_before) (save-buffer))
+ (with-current-buffer buf2 (insert fil2_before) (save-buffer))
+
+ (with-temp-buffer
+ (cd temp-dir)
+ (insert patch)
+ (goto-char (point-min))
+ (diff-apply-hunk)
+ (diff-apply-hunk)
+ (diff-apply-hunk))
+
+ (should (equal (with-current-buffer buf (buffer-string))
+ fil_after))
+ (should (equal (with-current-buffer buf2 (buffer-string))
+ fil2_after)))
+
+ (ignore-errors
+ (with-current-buffer buf (set-buffer-modified-p nil))
+ (kill-buffer buf)
+ (with-current-buffer buf2 (set-buffer-modified-p nil))
+ (kill-buffer buf2)))))))
(ert-deftest diff-mode-test-hunk-text-no-newline ()
"Check output of `diff-hunk-text' with no newline at end of file."
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index a464db2349d..0f09616a816 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'ediff-ptch)
(ert-deftest ediff-ptch-test-bug25010 ()
@@ -45,34 +46,33 @@ index 6a07f80..6e8e947 100644
"Test for https://debbugs.gnu.org/26084 ."
(skip-unless (executable-find "git"))
(skip-unless (executable-find ediff-patch-program))
- (let* ((tmpdir (make-temp-file "ediff-ptch-test" t))
- (default-directory (file-name-as-directory tmpdir))
- (patch (make-temp-file "ediff-ptch-test"))
- (qux (expand-file-name "qux.txt" tmpdir))
- (bar (expand-file-name "bar.txt" tmpdir))
- (git-program (executable-find "git")))
- ;; Create repository.
- (with-temp-buffer
- (insert "qux here\n")
- (write-region nil nil qux nil 'silent)
- (erase-buffer)
- (insert "bar here\n")
- (write-region nil nil bar nil 'silent))
- (call-process git-program nil nil nil "init")
- (call-process git-program nil nil nil "add" ".")
- (call-process git-program nil nil nil "commit" "-m" "Test repository.")
- ;; Update repo., save the diff and reset to initial state.
- (with-temp-buffer
- (insert "foo here\n")
- (write-region nil nil qux nil 'silent)
- (write-region nil nil bar nil 'silent))
- (call-process git-program nil `(:file ,patch) nil "diff")
- (call-process git-program nil nil nil "reset" "--hard" "HEAD")
- ;; Visit the diff file i.e., patch; extract from it the parts
- ;; affecting just each of the files: store in patch-bar the part
- ;; affecting 'bar', and in patch-qux the part affecting 'qux'.
- (find-file patch)
- (unwind-protect
+ (ert-with-temp-directory tmpdir
+ (ert-with-temp-file patch
+ (let* ((default-directory (file-name-as-directory tmpdir))
+ (qux (expand-file-name "qux.txt" tmpdir))
+ (bar (expand-file-name "bar.txt" tmpdir))
+ (git-program (executable-find "git")))
+ ;; Create repository.
+ (with-temp-buffer
+ (insert "qux here\n")
+ (write-region nil nil qux nil 'silent)
+ (erase-buffer)
+ (insert "bar here\n")
+ (write-region nil nil bar nil 'silent))
+ (call-process git-program nil nil nil "init")
+ (call-process git-program nil nil nil "add" ".")
+ (call-process git-program nil nil nil "commit" "-m" "Test repository.")
+ ;; Update repo., save the diff and reset to initial state.
+ (with-temp-buffer
+ (insert "foo here\n")
+ (write-region nil nil qux nil 'silent)
+ (write-region nil nil bar nil 'silent))
+ (call-process git-program nil `(:file ,patch) nil "diff")
+ (call-process git-program nil nil nil "reset" "--hard" "HEAD")
+ ;; Visit the diff file i.e., patch; extract from it the parts
+ ;; affecting just each of the files: store in patch-bar the part
+ ;; affecting 'bar', and in patch-qux the part affecting 'qux'.
+ (find-file patch)
(let* ((info
(progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map))
(patch-bar
@@ -116,9 +116,7 @@ index 6a07f80..6e8e947 100644
(buffer-string))
(with-temp-buffer
(insert-file-contents backup)
- (buffer-string)))))))
- (delete-directory tmpdir 'recursive)
- (delete-file patch)))))
+ (buffer-string))))))))))))
(provide 'ediff-ptch-tests)
diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el
index 43385de5955..afced819fbc 100644
--- a/test/lisp/vc/vc-bzr-tests.el
+++ b/test/lisp/vc/vc-bzr-tests.el
@@ -25,6 +25,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'vc-bzr)
(require 'vc-dir)
@@ -51,106 +52,97 @@
;; temporary directory.
;; TODO does this means tests should be setting XDG_ variables (not
;; just HOME) to temporary values too?
- (let* ((homedir (make-temp-file "vc-bzr-test" t))
- (bzrdir (expand-file-name "bzr" homedir))
- (ignored-dir (progn
- (make-directory bzrdir)
- (expand-file-name "ignored-dir" bzrdir)))
- (default-directory (file-name-as-directory bzrdir))
- (process-environment (cons (format "HOME=%s" homedir)
- process-environment)))
- (unwind-protect
- (progn
- (make-directory ignored-dir)
- (with-temp-buffer
- (insert (file-name-nondirectory ignored-dir))
- (write-region nil nil (expand-file-name ".bzrignore" bzrdir)
- nil 'silent))
- (skip-unless (eq 0 ; some internal bzr error
- (call-process vc-bzr-program nil nil nil "init")))
- (call-process vc-bzr-program nil nil nil "add")
- (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
- (with-temp-buffer
- (insert "unregistered file")
- (write-region nil nil (expand-file-name "testfile2" ignored-dir)
- nil 'silent))
- (vc-dir ignored-dir)
- (while (vc-dir-busy)
- (sit-for 0.1))
- ;; FIXME better to explicitly test for error from process sentinel.
- (with-current-buffer "*vc-dir*"
- (goto-char (point-min))
- (should (search-forward "unregistered" nil t))))
- (delete-directory homedir t))))
+ (ert-with-temp-directory homedir
+ (let* ((bzrdir (expand-file-name "bzr" homedir))
+ (ignored-dir (progn
+ (make-directory bzrdir)
+ (expand-file-name "ignored-dir" bzrdir)))
+ (default-directory (file-name-as-directory bzrdir))
+ (process-environment (cons (format "HOME=%s" homedir)
+ process-environment)))
+ (make-directory ignored-dir)
+ (with-temp-buffer
+ (insert (file-name-nondirectory ignored-dir))
+ (write-region nil nil (expand-file-name ".bzrignore" bzrdir)
+ nil 'silent))
+ (skip-unless (eq 0 ; some internal bzr error
+ (call-process vc-bzr-program nil nil nil "init")))
+ (call-process vc-bzr-program nil nil nil "add")
+ (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
+ (with-temp-buffer
+ (insert "unregistered file")
+ (write-region nil nil (expand-file-name "testfile2" ignored-dir)
+ nil 'silent))
+ (vc-dir ignored-dir)
+ (while (vc-dir-busy)
+ (sit-for 0.1))
+ ;; FIXME better to explicitly test for error from process sentinel.
+ (with-current-buffer "*vc-dir*"
+ (goto-char (point-min))
+ (should (search-forward "unregistered" nil t))))))
;; Not specific to bzr.
(ert-deftest vc-bzr-test-bug9781 ()
"Test for https://debbugs.gnu.org/9781 ."
(skip-unless (executable-find vc-bzr-program))
- (let* ((homedir (make-temp-file "vc-bzr-test" t))
- (bzrdir (expand-file-name "bzr" homedir))
- (subdir (progn
- (make-directory bzrdir)
- (expand-file-name "subdir" bzrdir)))
- (file (expand-file-name "file" bzrdir))
- (default-directory (file-name-as-directory bzrdir))
- (process-environment (cons (format "HOME=%s" homedir)
- process-environment)))
- (unwind-protect
- (progn
- (skip-unless (eq 0 ; some internal bzr error
- (call-process vc-bzr-program nil nil nil "init")))
- (make-directory subdir)
- (with-temp-buffer
- (insert "text")
- (write-region nil nil file nil 'silent)
- (write-region nil nil (expand-file-name "subfile" subdir)
- nil 'silent))
- (call-process vc-bzr-program nil nil nil "add")
- (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
- (call-process vc-bzr-program nil nil nil "remove" subdir)
- (with-temp-buffer
- (insert "different text")
- (write-region nil nil file nil 'silent))
- (vc-dir bzrdir)
- (while (vc-dir-busy)
- (sit-for 0.1))
- (vc-dir-mark-all-files t)
- (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) t)))
- (vc-next-action nil))
- (should (get-buffer "*vc-log*")))
- (delete-directory homedir t))))
+ (ert-with-temp-directory homedir
+ (let* ((bzrdir (expand-file-name "bzr" homedir))
+ (subdir (progn
+ (make-directory bzrdir)
+ (expand-file-name "subdir" bzrdir)))
+ (file (expand-file-name "file" bzrdir))
+ (default-directory (file-name-as-directory bzrdir))
+ (process-environment (cons (format "HOME=%s" homedir)
+ process-environment)))
+ (skip-unless (eq 0 ; some internal bzr error
+ (call-process vc-bzr-program nil nil nil "init")))
+ (make-directory subdir)
+ (with-temp-buffer
+ (insert "text")
+ (write-region nil nil file nil 'silent)
+ (write-region nil nil (expand-file-name "subfile" subdir)
+ nil 'silent))
+ (call-process vc-bzr-program nil nil nil "add")
+ (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
+ (call-process vc-bzr-program nil nil nil "remove" subdir)
+ (with-temp-buffer
+ (insert "different text")
+ (write-region nil nil file nil 'silent))
+ (vc-dir bzrdir)
+ (while (vc-dir-busy)
+ (sit-for 0.1))
+ (vc-dir-mark-all-files t)
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) t)))
+ (vc-next-action nil))
+ (should (get-buffer "*vc-log*")))))
;; https://lists.gnu.org/r/help-gnu-emacs/2012-04/msg00145.html
(ert-deftest vc-bzr-test-faulty-bzr-autoloads ()
"Test we can generate autoloads in a bzr directory when bzr is faulty."
(skip-unless (executable-find vc-bzr-program))
- (let* ((homedir (make-temp-file "vc-bzr-test" t))
- (bzrdir (expand-file-name "bzr" homedir))
- (file (progn
- (make-directory bzrdir)
- (expand-file-name "foo.el" bzrdir)))
- (default-directory (file-name-as-directory bzrdir))
- (process-environment (cons (format "HOME=%s" homedir)
- process-environment)))
- (unwind-protect
- (progn
- (call-process vc-bzr-program nil nil nil "init")
- (with-temp-buffer
- (insert ";;;###autoload
+ (ert-with-temp-directory homedir
+ (let* ((bzrdir (expand-file-name "bzr" homedir))
+ (file (progn
+ (make-directory bzrdir)
+ (expand-file-name "foo.el" bzrdir)))
+ (default-directory (file-name-as-directory bzrdir))
+ (process-environment (cons (format "HOME=%s" homedir)
+ process-environment)))
+ (call-process vc-bzr-program nil nil nil "init")
+ (with-temp-buffer
+ (insert ";;;###autoload
\(defun foo () \"foo\" (interactive) (message \"foo!\"))")
- (write-region nil nil file nil 'silent))
- (call-process vc-bzr-program nil nil nil "add")
- (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
- ;; Deleting dirstate ensures both that vc-bzr's status heuristic
- ;; fails, so it has to call the external bzr status, and
- ;; causes bzr status to fail. This simulates a broken bzr
- ;; installation.
- (delete-file ".bzr/checkout/dirstate")
- (should (progn (make-directory-autoloads
- default-directory
- (expand-file-name "loaddefs.el" bzrdir))
- t)))
- (delete-directory homedir t))))
+ (write-region nil nil file nil 'silent))
+ (call-process vc-bzr-program nil nil nil "add")
+ (call-process vc-bzr-program nil nil nil "commit" "-m" "Commit 1")
+ ;; Deleting dirstate ensures both that vc-bzr's status heuristic
+ ;; fails, so it has to call the external bzr status, and
+ ;; causes bzr status to fail. This simulates a broken bzr
+ ;; installation.
+ (delete-file ".bzr/checkout/dirstate")
+ (should (progn (make-directory-autoloads
+ default-directory
+ (expand-file-name "loaddefs.el" bzrdir))
+ t)))))
;;; vc-bzr-tests.el ends here
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el
index 96a01fc2c7b..e768a165529 100644
--- a/test/lisp/wdired-tests.el
+++ b/test/lisp/wdired-tests.el
@@ -20,6 +20,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'dired)
(require 'wdired)
@@ -28,104 +29,100 @@
(ert-deftest wdired-test-bug32173-01 ()
"Test using non-nil wdired-use-interactive-rename.
Partially modifying a file name should succeed."
- (let* ((test-dir (make-temp-file "test-dir-" t))
- (test-file (concat (file-name-as-directory test-dir) "foo.c"))
- (replace "bar")
- (new-file (string-replace "foo" replace test-file))
- (wdired-use-interactive-rename t))
- (write-region "" nil test-file nil 'silent)
- (advice-add 'dired-query ; Don't ask confirmation to overwrite a file.
- :override
- (lambda (_sym _prompt &rest _args) (setq dired-query t))
- '((name . "advice-dired-query")))
- (let ((buf (find-file-noselect test-dir)))
- (unwind-protect
- (with-current-buffer buf
- (should (equal (dired-file-name-at-point) test-file))
- (dired-toggle-read-only)
- (kill-region (point) (progn (search-forward ".")
- (forward-char -1) (point)))
- (insert replace)
- (wdired-finish-edit)
- (should (equal (dired-file-name-at-point) new-file)))
- (if buf (kill-buffer buf))
- (delete-directory test-dir t)))))
+ (ert-with-temp-directory test-dir
+ (let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
+ (replace "bar")
+ (new-file (string-replace "foo" replace test-file))
+ (wdired-use-interactive-rename t))
+ (write-region "" nil test-file nil 'silent)
+ (advice-add 'dired-query ; Don't ask confirmation to overwrite a file.
+ :override
+ (lambda (_sym _prompt &rest _args) (setq dired-query t))
+ '((name . "advice-dired-query")))
+ (let ((buf (find-file-noselect test-dir)))
+ (unwind-protect
+ (with-current-buffer buf
+ (should (equal (dired-file-name-at-point) test-file))
+ (dired-toggle-read-only)
+ (kill-region (point) (progn (search-forward ".")
+ (forward-char -1) (point)))
+ (insert replace)
+ (wdired-finish-edit)
+ (should (equal (dired-file-name-at-point) new-file)))
+ (if buf (kill-buffer buf)))))))
(ert-deftest wdired-test-bug32173-02 ()
"Test using non-nil wdired-use-interactive-rename.
Aborting an edit should leaving original file name unchanged."
- (let* ((test-dir (make-temp-file "test-dir-" t))
- (test-file (concat (file-name-as-directory test-dir) "foo.c"))
- (wdired-use-interactive-rename t))
- (write-region "" nil test-file nil 'silent)
- ;; Make dired-do-create-files-regexp a noop to mimic typing C-g
- ;; at its prompt before wdired-finish-edit returns.
- (advice-add 'dired-do-create-files-regexp
- :override
- (lambda (&rest _) (ignore))
- '((name . "advice-dired-do-create-files-regexp")))
- (let ((buf (find-file-noselect test-dir)))
- (unwind-protect
- (with-current-buffer buf
- (should (equal (dired-file-name-at-point) test-file))
- (dired-toggle-read-only)
- (kill-region (point) (progn (search-forward ".")
- (forward-char -1) (point)))
- (insert "bar")
- (wdired-finish-edit)
- (should (equal (dired-get-filename) test-file)))
- (if buf (kill-buffer buf))
- (delete-directory test-dir t)))))
+ (ert-with-temp-directory test-dir
+ (let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
+ (wdired-use-interactive-rename t))
+ (write-region "" nil test-file nil 'silent)
+ ;; Make dired-do-create-files-regexp a noop to mimic typing C-g
+ ;; at its prompt before wdired-finish-edit returns.
+ (advice-add 'dired-do-create-files-regexp
+ :override
+ (lambda (&rest _) (ignore))
+ '((name . "advice-dired-do-create-files-regexp")))
+ (let ((buf (find-file-noselect test-dir)))
+ (unwind-protect
+ (with-current-buffer buf
+ (should (equal (dired-file-name-at-point) test-file))
+ (dired-toggle-read-only)
+ (kill-region (point) (progn (search-forward ".")
+ (forward-char -1) (point)))
+ (insert "bar")
+ (wdired-finish-edit)
+ (should (equal (dired-get-filename) test-file)))
+ (if buf (kill-buffer buf)))))))
(ert-deftest wdired-test-symlink-name ()
"Test the file name of a symbolic link.
The Dired and WDired functions returning the name should include
only the name before the link arrow."
- (let* ((test-dir (make-temp-file "test-dir-" t))
- (link-name "foo"))
- (let ((buf (find-file-noselect test-dir)))
- (unwind-protect
- (with-current-buffer buf
- (skip-unless
- ;; This check is for wdired, not symbolic links, so skip
- ;; it when make-symbolic-link fails for any reason (like
- ;; insufficient privileges).
- (ignore-errors (make-symbolic-link "./bar/baz" link-name) t))
- (revert-buffer)
- (let* ((file-name (dired-get-filename))
- (dir-part (file-name-directory file-name))
- (lf-name (concat dir-part link-name)))
- (should (equal file-name lf-name))
- (dired-toggle-read-only)
- (should (equal (wdired-get-filename) lf-name))
- (dired-toggle-read-only)))
- (if buf (kill-buffer buf))
- (delete-directory test-dir t)))))
+ (ert-with-temp-directory test-dir
+ (let* ((link-name "foo"))
+ (let ((buf (find-file-noselect test-dir)))
+ (unwind-protect
+ (with-current-buffer buf
+ (skip-unless
+ ;; This check is for wdired, not symbolic links, so skip
+ ;; it when make-symbolic-link fails for any reason (like
+ ;; insufficient privileges).
+ (ignore-errors (make-symbolic-link "./bar/baz" link-name) t))
+ (revert-buffer)
+ (let* ((file-name (dired-get-filename))
+ (dir-part (file-name-directory file-name))
+ (lf-name (concat dir-part link-name)))
+ (should (equal file-name lf-name))
+ (dired-toggle-read-only)
+ (should (equal (wdired-get-filename) lf-name))
+ (dired-toggle-read-only)))
+ (if buf (kill-buffer buf)))))))
(ert-deftest wdired-test-unfinished-edit-01 ()
"Test editing a file name without saving the change.
Finding the new name should be possible while still in
wdired-mode."
- (let* ((test-dir (make-temp-file "test-dir-" t))
- (test-file (concat (file-name-as-directory test-dir) "foo.c"))
- (replace "bar")
- (new-file (string-replace "foo" replace test-file)))
- (write-region "" nil test-file nil 'silent)
- (let ((buf (find-file-noselect test-dir)))
- (unwind-protect
- (with-current-buffer buf
- (should (equal (dired-file-name-at-point) test-file))
- (dired-toggle-read-only)
- (kill-region (point) (progn (search-forward ".")
- (forward-char -1) (point)))
- (insert replace)
- (should (equal (dired-get-filename) new-file)))
- (when buf
- (with-current-buffer buf
- ;; Prevent kill-buffer-query-functions from chiming in.
- (set-buffer-modified-p nil)
- (kill-buffer buf)))
- (delete-directory test-dir t)))))
+ (ert-with-temp-directory test-dir
+ (let* ((test-file (concat (file-name-as-directory test-dir) "foo.c"))
+ (replace "bar")
+ (new-file (string-replace "foo" replace test-file)))
+ (write-region "" nil test-file nil 'silent)
+ (let ((buf (find-file-noselect test-dir)))
+ (unwind-protect
+ (with-current-buffer buf
+ (should (equal (dired-file-name-at-point) test-file))
+ (dired-toggle-read-only)
+ (kill-region (point) (progn (search-forward ".")
+ (forward-char -1) (point)))
+ (insert replace)
+ (should (equal (dired-get-filename) new-file)))
+ (when buf
+ (with-current-buffer buf
+ ;; Prevent kill-buffer-query-functions from chiming in.
+ (set-buffer-modified-p nil)
+ (kill-buffer buf))))))))
(defvar server-socket-dir)
(declare-function dired-smart-shell-command "dired-x"
@@ -139,61 +136,59 @@ dired-move-to-end-of-filename handles indicator characters, it
suffices to compare the return values of dired-get-filename and
wdired-get-filename before and after editing."
;; FIXME: Add a test for a door (indicator ">") only under Solaris?
- (let* ((test-dir (make-temp-file "test-dir-" t))
- (server-socket-dir test-dir)
- (dired-listing-switches "-Fl")
- (dired-ls-F-marks-symlinks (eq system-type 'darwin))
- (buf (find-file-noselect test-dir)))
- (unwind-protect
- (progn
- (with-current-buffer buf
- (dired-create-empty-file "foo")
- (set-file-modes "foo" (file-modes-symbolic-to-number "+x"))
- (make-symbolic-link "foo" "bar")
- (make-directory "foodir")
- (require 'dired-x)
- (dired-smart-shell-command "mkfifo foopipe")
- (server-force-delete)
- ;; FIXME? This seems a heavy-handed way of making a socket.
- (server-start) ; Add a socket file.
- (kill-buffer buf))
- (dired test-dir)
- (dired-toggle-read-only)
- (let (names)
- ;; Test that the file names are the same in Dired and WDired.
- (while (not (eobp))
- (should (equal (dired-get-filename 'no-dir t)
- (wdired-get-filename t)))
- (insert "w")
- (push (wdired-get-filename t) names)
- (dired-next-line 1))
- (wdired-finish-edit)
- ;; Test that editing the file names ignores the indicator
- ;; character.
- (let (dir)
- (while (and (dired-previous-line 1)
- (setq dir (dired-get-filename 'no-dir t)))
- (should (equal dir (pop names)))))))
- (kill-buffer (get-buffer test-dir))
- (server-force-delete)
- (delete-directory test-dir t))))
+ (ert-with-temp-directory test-dir
+ (let* ((server-socket-dir test-dir)
+ (dired-listing-switches "-Fl")
+ (dired-ls-F-marks-symlinks (eq system-type 'darwin))
+ (buf (find-file-noselect test-dir)))
+ (unwind-protect
+ (progn
+ (with-current-buffer buf
+ (dired-create-empty-file "foo")
+ (set-file-modes "foo" (file-modes-symbolic-to-number "+x"))
+ (make-symbolic-link "foo" "bar")
+ (make-directory "foodir")
+ (require 'dired-x)
+ (dired-smart-shell-command "mkfifo foopipe")
+ (server-force-delete)
+ ;; FIXME? This seems a heavy-handed way of making a socket.
+ (server-start) ; Add a socket file.
+ (kill-buffer buf))
+ (dired test-dir)
+ (dired-toggle-read-only)
+ (let (names)
+ ;; Test that the file names are the same in Dired and WDired.
+ (while (not (eobp))
+ (should (equal (dired-get-filename 'no-dir t)
+ (wdired-get-filename t)))
+ (insert "w")
+ (push (wdired-get-filename t) names)
+ (dired-next-line 1))
+ (wdired-finish-edit)
+ ;; Test that editing the file names ignores the indicator
+ ;; character.
+ (let (dir)
+ (while (and (dired-previous-line 1)
+ (setq dir (dired-get-filename 'no-dir t)))
+ (should (equal dir (pop names)))))))
+ (kill-buffer (get-buffer test-dir))
+ (server-force-delete)))))
(ert-deftest wdired-test-bug39280 ()
"Test for https://debbugs.gnu.org/39280."
- (let* ((test-dir (make-temp-file "test-dir" 'dir))
- (fname "foo")
- (full-fname (expand-file-name fname test-dir)))
- (make-empty-file full-fname)
- (let ((buf (find-file-noselect test-dir)))
- (unwind-protect
- (with-current-buffer buf
- (dired-toggle-read-only)
- (dolist (old '(t nil))
- (should (equal fname (wdired-get-filename 'nodir old)))
- (should (equal full-fname (wdired-get-filename nil old))))
- (wdired-finish-edit))
- (if buf (kill-buffer buf))
- (delete-directory test-dir t)))))
+ (ert-with-temp-directory test-dir
+ (let* ((fname "foo")
+ (full-fname (expand-file-name fname test-dir)))
+ (make-empty-file full-fname)
+ (let ((buf (find-file-noselect test-dir)))
+ (unwind-protect
+ (with-current-buffer buf
+ (dired-toggle-read-only)
+ (dolist (old '(t nil))
+ (should (equal fname (wdired-get-filename 'nodir old)))
+ (should (equal full-fname (wdired-get-filename nil old))))
+ (wdired-finish-edit))
+ (if buf (kill-buffer buf)))))))
(provide 'wdired-tests)
;;; wdired-tests.el ends here
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 059926ff46b..ac213d1bade 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -19,6 +19,8 @@
;;; Code:
+(require 'ert)
+(require 'ert-x)
(require 'cl-lib)
(ert-deftest overlay-modification-hooks-message-other-buf ()
@@ -1421,25 +1423,23 @@ with parameters from the *Messages* buffer modification."
(should (= (length (overlays-in (point-min) (point-max))) 0))))
(ert-deftest test-kill-buffer-auto-save-default ()
- (let ((file (make-temp-file "ert"))
- auto-save)
- (should (file-exists-p file))
- ;; Always answer yes.
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- (kill-buffer (current-buffer))
- (should (file-exists-p auto-save)))
- (ignore-errors (delete-file file))
- (when auto-save
- (ignore-errors (delete-file auto-save)))))))
+ (ert-with-temp-file file
+ (let (auto-save)
+ ;; Always answer yes.
+ (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))
+ (when auto-save
+ (ignore-errors (delete-file auto-save))))))))
(ert-deftest test-kill-buffer-auto-save-delete ()
(let ((file (make-temp-file "ert"))
diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el
index a96d6d67289..ba001679639 100644
--- a/test/src/filelock-tests.el
+++ b/test/src/filelock-tests.el
@@ -28,6 +28,7 @@
(require 'cl-macs)
(require 'ert)
+(require 'ert-x)
(require 'seq)
(defun filelock-tests--fixture (test-function)
@@ -36,22 +37,20 @@ Create a test directory and a buffer whose `buffer-file-name' and
`buffer-file-truename' are a file within it, then call
TEST-FUNCTION. Finally, delete the buffer and the test
directory."
- (let* ((temp-dir (make-temp-file "filelock-tests" t))
- (name (concat (file-name-as-directory temp-dir)
- "userfile"))
- (create-lockfiles t))
- (unwind-protect
- (with-temp-buffer
- (setq buffer-file-name name
- buffer-file-truename name)
- (unwind-protect
- (save-current-buffer
- (funcall test-function))
- ;; Set `buffer-file-truename' nil to prevent unlocking,
- ;; which might prompt the user and/or signal errors.
- (setq buffer-file-name nil
- buffer-file-truename nil)))
- (delete-directory temp-dir t nil))))
+ (ert-with-temp-directory temp-dir
+ (let ((name (concat (file-name-as-directory temp-dir)
+ "userfile"))
+ (create-lockfiles t))
+ (with-temp-buffer
+ (setq buffer-file-name name
+ buffer-file-truename name)
+ (unwind-protect
+ (save-current-buffer
+ (funcall test-function))
+ ;; Set `buffer-file-truename' nil to prevent unlocking,
+ ;; which might prompt the user and/or signal errors.
+ (setq buffer-file-name nil
+ buffer-file-truename nil))))))
(defun filelock-tests--make-lock-name (file-name)
"Return the lock file name for FILE-NAME.
diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el
index 8aab7eeb30a..c341af5c393 100644
--- a/test/src/inotify-tests.el
+++ b/test/src/inotify-tests.el
@@ -24,6 +24,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(declare-function inotify-add-watch "inotify.c" (file-name aspect callback))
(declare-function inotify-rm-watch "inotify.c" (watch-descriptor))
@@ -50,23 +51,21 @@
(ert-deftest inotify-file-watch-simple ()
"Test if watching a normal file works."
-
(skip-unless (featurep 'inotify))
- (let ((temp-file (make-temp-file "inotify-simple"))
- (events 0))
- (let ((wd
- (inotify-add-watch temp-file t (lambda (_ev)
- (setq events (1+ events))))))
- (unwind-protect
- (progn
- (with-temp-file temp-file
- (insert "Foo\n"))
- (read-event nil nil 5)
- (should (> events 0)))
- (should (inotify-valid-p wd))
- (inotify-rm-watch wd)
- (should-not (inotify-valid-p wd))
- (delete-file temp-file)))))
+ (ert-with-temp-file temp-file
+ (let ((events 0))
+ (let ((wd
+ (inotify-add-watch temp-file t (lambda (_ev)
+ (setq events (1+ events))))))
+ (unwind-protect
+ (progn
+ (with-temp-file temp-file
+ (insert "Foo\n"))
+ (read-event nil nil 5)
+ (should (> events 0)))
+ (should (inotify-valid-p wd))
+ (inotify-rm-watch wd)
+ (should-not (inotify-valid-p wd)))))))
(provide 'inotify-tests)
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index a658bccf6dc..88fcfad14cc 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -46,6 +46,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'facemenu)
(ert-deftest undo-test0 ()
@@ -218,17 +219,14 @@
(ert-deftest undo-test-file-modified ()
"Test undoing marks buffer visiting file unmodified."
- (let ((tempfile (make-temp-file "undo-test")))
- (unwind-protect
- (progn
- (with-current-buffer (find-file-noselect tempfile)
- (insert "1")
- (undo-boundary)
- (set-buffer-modified-p nil)
- (insert "2")
- (undo)
- (should-not (buffer-modified-p))))
- (delete-file tempfile))))
+ (ert-with-temp-file tempfile
+ (with-current-buffer (find-file-noselect tempfile)
+ (insert "1")
+ (undo-boundary)
+ (set-buffer-modified-p nil)
+ (insert "2")
+ (undo)
+ (should-not (buffer-modified-p)))))
(ert-deftest undo-test-region-not-most-recent ()
"Test undo in region of an edit not the most recent."
--
cgit v1.2.3
From 7fdb2ae412d4b727c6075ff3988836841b052120 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 7 Nov 2021 18:03:23 +0100
Subject: Add some unit tests for 'abbreviate-file-name'
* test/lisp/files-tests.el (files-tests-abbreviate-file-name-homedir)
(files-tests-abbreviate-file-name-directory-abbrev-alist): New tests.
---
test/lisp/files-tests.el | 33 +++++++++++++++++++++++++++++++++
1 file changed, 33 insertions(+)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index b283a512a42..9547ac2b695 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1342,6 +1342,39 @@ name (Bug#28412)."
(should (file-directory-p (concat (file-name-as-directory dest2) "a")))
(delete-directory dir 'recursive)))
+(ert-deftest files-tests-abbreviate-file-name-homedir ()
+ ;; Check homedir abbreviation.
+ (let* ((homedir temporary-file-directory)
+ (process-environment (cons (format "HOME=%s" homedir)
+ process-environment))
+ (abbreviated-home-dir nil))
+ (should (equal "~/foo/bar"
+ (abbreviate-file-name (concat homedir "foo/bar")))))
+ ;; Check that homedir abbreviation doesn't occur when homedir is just /.
+ (let* ((homedir "/")
+ (process-environment (cons (format "HOME=%s" homedir)
+ process-environment))
+ (abbreviated-home-dir nil))
+ (should (equal "/foo/bar"
+ (abbreviate-file-name (concat homedir "foo/bar"))))))
+
+(ert-deftest files-tests-abbreviate-file-name-directory-abbrev-alist ()
+ ;; Check `directory-abbrev-alist' abbreviation.
+ (let ((directory-abbrev-alist '(("\\`/nowhere/special" . "/nw/sp"))))
+ (should (equal "/nw/sp/here"
+ (abbreviate-file-name "/nowhere/special/here"))))
+ ;; Check homedir and `directory-abbrev-alist' abbreviation.
+ (let* ((homedir temporary-file-directory)
+ (process-environment (cons (format "HOME=%s" homedir)
+ process-environment))
+ (abbreviated-home-dir nil)
+ (directory-abbrev-alist
+ `((,(concat "\\`" (regexp-quote homedir) "nowhere/special")
+ . ,(concat homedir "nw/sp")))))
+ (should (equal "~/nw/sp/here"
+ (abbreviate-file-name
+ (concat homedir "nowhere/special/here"))))))
+
(ert-deftest files-tests-abbreviated-home-dir ()
"Test that changing HOME does not confuse `abbreviate-file-name'.
See <https://debbugs.gnu.org/19657#20>."
--
cgit v1.2.3
From aca235cb94b9b717de6e65b662b878362af26d57 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefan@marxist.se>
Date: Sun, 7 Nov 2021 22:46:09 +0100
Subject: ; Fix duplicate temporary file creation
* test/lisp/files-tests.el (files-tests-executable-find): Fix creating
duplicate temporary file after recent change.
---
test/lisp/files-tests.el | 37 ++++++++++++++++++-------------------
1 file changed, 18 insertions(+), 19 deletions(-)
(limited to 'test/lisp/files-tests.el')
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index cf9d87f76d7..c6d7c19279b 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1383,25 +1383,24 @@ See <https://debbugs.gnu.org/19657#20>."
See <https://debbugs.gnu.org/35241>."
(ert-with-temp-file tmpfile
:suffix (car exec-suffixes)
- (let ((tmpfile (make-temp-file "files-test" nil )))
- (set-file-modes tmpfile #o777)
- (let ((exec-path `(,temporary-file-directory)))
- (should
- (equal tmpfile
- (executable-find (file-name-nondirectory tmpfile)))))
- ;; An empty element of `exec-path' means `default-directory'.
- (let ((default-directory temporary-file-directory)
- (exec-path nil))
- (should
- (equal tmpfile
- (executable-find (file-name-nondirectory tmpfile)))))
- ;; The remote file name shall be quoted, and handled like a
- ;; non-existing directory.
- (let ((default-directory "/ssh::")
- (exec-path (append exec-path `("." ,temporary-file-directory))))
- (should
- (equal tmpfile
- (executable-find (file-name-nondirectory tmpfile))))))))
+ (set-file-modes tmpfile #o755)
+ (let ((exec-path `(,temporary-file-directory)))
+ (should
+ (equal tmpfile
+ (executable-find (file-name-nondirectory tmpfile)))))
+ ;; An empty element of `exec-path' means `default-directory'.
+ (let ((default-directory temporary-file-directory)
+ (exec-path nil))
+ (should
+ (equal tmpfile
+ (executable-find (file-name-nondirectory tmpfile)))))
+ ;; The remote file name shall be quoted, and handled like a
+ ;; non-existing directory.
+ (let ((default-directory "/ssh::")
+ (exec-path (append exec-path `("." ,temporary-file-directory))))
+ (should
+ (equal tmpfile
+ (executable-find (file-name-nondirectory tmpfile)))))))
(ert-deftest files-tests-dont-rewrite-precious-files ()
"Test that `file-precious-flag' forces files to be saved by
--
cgit v1.2.3
From 2e6ed253ce485698df649904bd9e5254a3f4bf94 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Wed, 10 Nov 2021 00:26:32 +0100
Subject: Add new function 'file-name-split'
* doc/lispref/files.texi (File Name Components): Document it.
* lisp/files.el (file-name-split): New function (bug#50572).
* lisp/emacs-lisp/shortdoc.el (file-name): Mention it.
---
doc/lispref/files.texi | 13 +++++++++++++
etc/NEWS | 4 ++++
lisp/emacs-lisp/shortdoc.el | 3 +++
lisp/files.el | 23 +++++++++++++++++++++++
test/lisp/files-tests.el | 6 ++++++
5 files changed, 49 insertions(+)
(limited to 'test/lisp/files-tests.el')
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index ddc1d05c1ca..dd058b12158 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2244,6 +2244,19 @@ and @code{file-name-nondirectory}. For example,
@end example
@end defun
+@defun file-name-split filename
+This function splits a file name into its components, and can be
+thought of as the inverse of @code{string-joing} with the appropriate
+directory separator. For example,
+
+@example
+(file-name-split "/tmp/foo.txt")
+ @result{} ("" "tmp" "foo.txt")
+(string-join (file-name-split "/tmp/foo.txt") "/")
+ @result{} "/tmp/foo.txt"
+@end example
+@end defun
+
@node Relative File Names
@subsection Absolute and Relative File Names
@cindex absolute file name
diff --git a/etc/NEWS b/etc/NEWS
index 807f31fa33e..3cad0995ac5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -612,6 +612,10 @@ Use 'exif-parse-file' and 'exif-field' instead.
* Lisp Changes in Emacs 29.1
++++
+*** New function 'file-name-split'.
+This returns a list of all the components of a file name.
+
+++
*** New macro 'with-undo-amalgamate'
It records a particular sequence of operations as a single undo step
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index c3d6c742940..a9f548b104e 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -281,6 +281,9 @@ There can be any number of :example/:result elements."
:eval (file-name-base "/tmp/foo.txt"))
(file-relative-name
:eval (file-relative-name "/tmp/foo" "/tmp"))
+ (file-name-split
+ :eval (file-name-split "/tmp/foo")
+ :eval (file-name-split "foo/bar"))
(make-temp-name
:eval (make-temp-name "/tmp/foo-"))
(file-name-concat
diff --git a/lisp/files.el b/lisp/files.el
index 0bc7a92fbea..c694df38268 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5051,6 +5051,29 @@ See also `file-name-sans-extension'."
(file-name-sans-extension
(file-name-nondirectory (or filename (buffer-file-name)))))
+(defun file-name-split (filename)
+ "Return a list of all the components of FILENAME.
+On most systems, this will be true:
+
+ (equal (string-join (file-name-split filename) \"/\") filename)"
+ (let ((components nil))
+ ;; If this is a directory file name, then we have a null file name
+ ;; at the end.
+ (when (directory-name-p filename)
+ (push "" components)
+ (setq filename (directory-file-name filename)))
+ ;; Loop, chopping off components.
+ (while (length> filename 0)
+ (push (file-name-nondirectory filename) components)
+ (let ((dir (file-name-directory filename)))
+ (setq filename (and dir (directory-file-name dir)))
+ ;; If there's nothing left to peel off, we're at the root and
+ ;; we can stop.
+ (when (equal dir filename)
+ (push "" components)
+ (setq filename nil))))
+ components))
+
(defcustom make-backup-file-name-function
#'make-backup-file-name--default-function
"A function that `make-backup-file-name' uses to create backup file names.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index c6d7c19279b..1e20317739a 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1800,6 +1800,12 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil."
;; `save-some-buffers-default-predicate' (i.e. the 2nd element) is ignored.
(nil save-some-buffers-root ,nb-might-save))))))
+(defun test-file-name-split ()
+ (should (equal (file-name-split "foo/bar") '("foo" "bar")))
+ (should (equal (file-name-split "/foo/bar") '("" "foo" "bar")))
+ (should (equal (file-name-split "/foo/bar/zot") '("" "foo" "bar" "zot")))
+ (should (equal (file-name-split "/foo/bar/") '("" "foo" "bar" "")))
+ (should (equal (file-name-split "foo/bar/") '("foo" "bar" ""))))
(provide 'files-tests)
;;; files-tests.el ends here
--
cgit v1.2.3