From 01a8a9dc90dbd4d4a69b906e01488a63d003d65d Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sun, 29 Jan 2023 11:56:17 +0100 Subject: Add ert-with-temp-directory and ert-with-temp-file --- NEWS.org | 2 + compat-26.el | 10 ++++ compat-29.el | 105 +++++++++++++++++++++++++++++++++++++++++ compat-tests.el | 142 ++++++++++++++++++++++++++++++++++---------------------- compat.texi | 64 +++++++++++++++++++++++++ 5 files changed, 268 insertions(+), 55 deletions(-) diff --git a/NEWS.org b/NEWS.org index 6068bc3..5337252 100644 --- a/NEWS.org +++ b/NEWS.org @@ -2,7 +2,9 @@ * Development +- compat-26: Add ~make-temp-file~ with optional argument TEXT. - compat-29: Add ~funcall-with-delayed-message~ and ~with-delayed-message~. +- compat-29: Add ~ert-with-temp-file~ and ~ert-with-temp-directory~. * Release of "Compat" Version 29.1.3.1 diff --git a/compat-26.el b/compat-26.el index a63edbb..fcb05f8 100644 --- a/compat-26.el +++ b/compat-26.el @@ -383,6 +383,16 @@ the variable `temporary-file-directory' is returned." default-directory temporary-file-directory))))) +(compat-defun make-temp-file (prefix &optional dir-flag suffix text) ;; + "Handle optional argument TEXT." + :extended t + (let ((file (make-temp-file prefix dir-flag suffix))) + (when text + (with-temp-buffer + (insert text) + (write-region (point-min) (point-max) file))) + file)) + (compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix) ;; "Create a temporary file as close as possible to `default-directory'. If PREFIX is a relative file name, and `default-directory' is a diff --git a/compat-29.el b/compat-29.el index 665366e..fa62c45 100644 --- a/compat-29.el +++ b/compat-29.el @@ -1281,5 +1281,110 @@ Also see `buttonize'." (setq sentences (1- sentences))) sentences)))) +;;;; Defined in ert-x.el + +(compat-defmacro ert-with-temp-file (name &rest body) ;; + "Bind NAME to the name of a new temporary file and evaluate BODY. +Delete the temporary file after BODY exits normally or +non-locally. NAME will be bound to the file name of the temporary +file. + +The following keyword arguments are supported: + +:prefix STRING If non-nil, pass STRING to `make-temp-file' as + the PREFIX argument. Otherwise, use the value of + `ert-temp-file-prefix'. + +:suffix STRING If non-nil, pass STRING to `make-temp-file' as the + SUFFIX argument. Otherwise, use the value of + `ert-temp-file-suffix'; if the value of that + variable is nil, generate a suffix based on the + name of the file that `ert-with-temp-file' is + called from. + +:text STRING If non-nil, pass STRING to `make-temp-file' as + the TEXT argument. + +:buffer SYMBOL Open the temporary file using `find-file-noselect' + and bind SYMBOL to the buffer. Kill the buffer + after BODY exits normally or non-locally. + +:coding CODING If non-nil, bind `coding-system-for-write' to CODING + when executing BODY. This is handy when STRING includes + non-ASCII characters or the temporary file must have a + specific encoding or end-of-line format. + +See also `ert-with-temp-directory'." + :feature ert-x + (declare (indent 1) (debug (symbolp body))) + (cl-check-type name symbol) + (let (keyw prefix suffix directory text extra-keywords buffer coding) + (while (keywordp (setq keyw (car body))) + (setq body (cdr body)) + (pcase keyw + (:prefix (setq prefix (pop body))) + (:suffix (setq suffix (pop body))) + ;; This is only for internal use by `ert-with-temp-directory' + ;; and is therefore not documented. + (:directory (setq directory (pop body))) + (:text (setq text (pop body))) + (:buffer (setq buffer (pop body))) + (:coding (setq coding (pop body))) + (_ (push keyw extra-keywords) (pop body)))) + (when extra-keywords + (error "Invalid keywords: %s" (mapconcat #'symbol-name extra-keywords " "))) + (let ((temp-file (make-symbol "temp-file")) + (prefix (or prefix "emacs-test-")) + (suffix (or suffix + (thread-last + (file-name-base (or (macroexp-file-name) buffer-file-name)) + (replace-regexp-in-string (rx string-start + (group (+? not-newline)) + (regexp "-?tests?") + string-end) + "\\1") + (concat "-"))))) + `(let* ((coding-system-for-write ,(or coding coding-system-for-write)) + (,temp-file (,(if directory 'file-name-as-directory 'identity) + (,(if (< emacs-major-version 26) 'compat--make-temp-file 'make-temp-file) + ,prefix ,directory ,suffix ,text))) + (,name ,(if directory + `(file-name-as-directory ,temp-file) + temp-file)) + ,@(when buffer + (list `(,buffer (find-file-literally ,temp-file))))) + (unwind-protect + (progn ,@body) + (ignore-errors + ,@(when buffer + (list `(with-current-buffer ,buffer + (set-buffer-modified-p nil)) + `(kill-buffer ,buffer)))) + (ignore-errors + ,(if directory + `(delete-directory ,temp-file :recursive) + `(delete-file ,temp-file)))))))) + +(compat-defmacro ert-with-temp-directory (name &rest body) ;; + "Bind NAME to the name of a new temporary directory and evaluate BODY. +Delete the temporary directory after BODY exits normally or +non-locally. + +NAME is bound to the directory name, not the directory file +name. (In other words, it will end with the directory delimiter; +on Unix-like systems, it will end with \"/\".) + +The same keyword arguments are supported as in +`ert-with-temp-file' (which see), except for :text." + :feature ert-x + (declare (indent 1) (debug (symbolp body))) + (let ((tail body) keyw) + (while (keywordp (setq keyw (car tail))) + (setq tail (cddr tail)) + (pcase keyw (:text (error "Invalid keyword for directory: :text"))))) + `(ert-with-temp-file ,name + :directory t + ,@body)) + (provide 'compat-29) ;;; compat-29.el ends here diff --git a/compat-tests.el b/compat-tests.el index 0f317c3..11e108c 100644 --- a/compat-tests.el +++ b/compat-tests.el @@ -50,8 +50,8 @@ ;;; Code: -(require 'ert) (require 'compat) +(require 'ert-x) (require 'subr-x) (require 'time-date) (require 'image) @@ -1376,34 +1376,48 @@ (should-equal t (always 1 2 3 4))) ;; multiple arguments (ert-deftest file-backup-file-names () - (let ((file (make-temp-file "compat-tests")) backups) - (should-not (file-backup-file-names file)) - (push (concat file "~") backups) - (make-empty-file (car backups)) - (should-equal backups (file-backup-file-names file)) - (push (concat file ".~1~") backups) - (make-empty-file (car backups)) - (should-equal backups (sort (file-backup-file-names file) #'string<)))) + (ert-with-temp-directory dir + (let ((file (file-name-concat dir "file")) backups) + (make-empty-file file) + (should (file-exists-p file)) + (should-not (file-backup-file-names file)) + (push (concat file "~") backups) + (make-empty-file (car backups)) + (should-equal backups (file-backup-file-names file)) + (push (concat file ".~1~") backups) + (make-empty-file (car backups)) + (should-equal backups (sort (file-backup-file-names file) #'string<))))) + +(ert-deftest make-temp-file () + (let ((file (compat-call make-temp-file "compat-tests" nil nil "test-content"))) + (unwind-protect + (with-temp-buffer + (insert-file-contents file) + (should-equal "test-content" (buffer-string))) + (delete-file file)))) (ert-deftest make-nearby-temp-file () (let ((file1 (make-nearby-temp-file "compat-tests")) (file2 (make-nearby-temp-file "compat-tests" nil "suffix")) (dir (make-nearby-temp-file "compat-tests" t))) - (should (string-suffix-p "suffix" file2)) - (should (file-regular-p file1)) - (should (file-regular-p file2)) - (should (file-directory-p dir)) - (should-equal (file-name-directory file1) temporary-file-directory) - (should-equal (file-name-directory file2) temporary-file-directory) - (should-equal (file-name-directory dir) temporary-file-directory) - (delete-file file1) - (delete-file file2) - (delete-directory dir)) - ;; Tramp test (mock protocol) - (let* ((default-directory "/mock::/") - (file (make-nearby-temp-file "compat-tests"))) - (should (string-match-p "\\`/mock:.*:/tmp/compat-tests" file)) - (delete-file file))) + (unwind-protect + (progn + (should (string-suffix-p "suffix" file2)) + (should (file-regular-p file1)) + (should (file-regular-p file2)) + (should (file-directory-p dir)) + (should-equal (file-name-directory file1) temporary-file-directory) + (should-equal (file-name-directory file2) temporary-file-directory) + (should-equal (file-name-directory dir) temporary-file-directory)) + (delete-file file1) + (delete-file file2) + (delete-directory dir)) + ;; Tramp test (mock protocol) + (let* ((default-directory "/mock::/") + (file (make-nearby-temp-file "compat-tests"))) + (unwind-protect + (should (string-match-p "\\`/mock:.*:/tmp/compat-tests" file)) + (delete-file file))))) (ert-deftest executable-find () (should (member (executable-find "sh") '("/usr/bin/sh" "/bin/sh"))) @@ -1462,21 +1476,20 @@ (should-not (directory-name-p "dir/subdir"))) (ert-deftest directory-empty-p () - (let ((name (make-temp-name "/tmp/compat-tests"))) - (make-directory name) - (should (directory-empty-p name)) - (make-empty-file (file-name-concat name "file")) - (should-not (directory-empty-p name)) - (delete-file (file-name-concat name "file")) - (delete-directory name))) + (ert-with-temp-directory dir + (should (directory-empty-p dir)) + (make-empty-file (file-name-concat dir "file")) + (should-not (directory-empty-p dir)) + (delete-file (file-name-concat dir "file")) + (should (directory-empty-p dir)))) (ert-deftest make-empty-file () - (let ((name (make-temp-name "/tmp/compat-tests"))) - (should-not (file-exists-p name)) - (make-empty-file name) - (should-equal 0 (file-attribute-size (file-attributes name))) - (should (file-exists-p name)) - (delete-file name))) + (ert-with-temp-directory dir + (let ((file (file-name-concat dir "file"))) + (should-not (file-exists-p file)) + (make-empty-file file) + (should (file-exists-p file)) + (should-equal 0 (file-attribute-size (file-attributes file)))))) (ert-deftest mounted-file-systems () (should-not (string-match-p mounted-file-systems "/etc/")) @@ -1500,26 +1513,25 @@ (should-equal (expand-file-name "bar/.#foo") (make-lock-file-name "bar/foo"))) (ert-deftest file-has-changed-p () - (let ((name (make-temp-file "/tmp/compat-tests"))) - (should (file-has-changed-p name)) - (should-not (file-has-changed-p name)) - (should-not (file-has-changed-p name)) - (should (file-has-changed-p name 'tag1)) - (should-not (file-has-changed-p name 'tag1)) - (should-not (file-has-changed-p name 'tag1)) + (ert-with-temp-file file + (should (file-has-changed-p file)) + (should-not (file-has-changed-p file)) + (should-not (file-has-changed-p file)) + (should (file-has-changed-p file 'tag1)) + (should-not (file-has-changed-p file 'tag1)) + (should-not (file-has-changed-p file 'tag1)) (with-temp-buffer (insert "changed") - (write-region (point-min) (point-max) name)) - (should (file-has-changed-p name)) - (should-not (file-has-changed-p name)) - (should-not (file-has-changed-p name)) - (should (file-has-changed-p name 'tag1)) - (should-not (file-has-changed-p name 'tag1)) - (should-not (file-has-changed-p name 'tag1)) - (should (file-has-changed-p name 'tag2)) - (should-not (file-has-changed-p name 'tag2)) - (should-not (file-has-changed-p name 'tag2)) - (delete-file name))) + (write-region (point-min) (point-max) file)) + (should (file-has-changed-p file)) + (should-not (file-has-changed-p file)) + (should-not (file-has-changed-p file)) + (should (file-has-changed-p file 'tag1)) + (should-not (file-has-changed-p file 'tag1)) + (should-not (file-has-changed-p file 'tag1)) + (should (file-has-changed-p file 'tag2)) + (should-not (file-has-changed-p file 'tag2)) + (should-not (file-has-changed-p file 'tag2)))) (ert-deftest file-attribute-getters () (let ((attrs '(type link-number user-id group-id access-time modification-time @@ -2863,5 +2875,25 @@ (should-equal 'result (funcall-with-delayed-message 1 "timeout" (lambda () 'result)))) +(ert-deftest ert-with-temp-file () + (ert-with-temp-file file + (should-not (directory-name-p file)) + (should (file-readable-p file)) + (should (file-writable-p file))) + (ert-with-temp-file dir :directory t + (should (directory-name-p dir)) + (should (file-directory-p dir))) + (ert-with-temp-file file :buffer buffer + (should (equal (current-buffer) buffer)) + (should-equal buffer-file-name file) + (should-not (directory-name-p file)) + (should (file-readable-p file)) + (should (file-writable-p file)))) + +(ert-deftest ert-with-temp-directory () + (ert-with-temp-directory dir + (should (directory-name-p dir)) + (should (file-directory-p dir)))) + (provide 'compat-tests) ;;; compat-tests.el ends here diff --git a/compat.texi b/compat.texi index 563a4d9..e323c59 100644 --- a/compat.texi +++ b/compat.texi @@ -893,6 +893,48 @@ size, modes, inode-number and device-number. These functions must be called explicitly via @code{compat-call}, since their calling convention or behavior was extended in Emacs 26.1: +@c copied from lispref/files.texi +@defun compat-call make-temp-file prefix &optional dir-flag suffix text +This function creates a temporary file and returns its name. Emacs +creates the temporary file's name by adding to @var{prefix} some +random characters that are different in each Emacs job. The result is +guaranteed to be a newly created file, containing @var{text} if that's +given as a string and empty otherwise. On MS-DOS, this function can +truncate @var{prefix} to fit into the 8+3 file-name limits. If +@var{prefix} is a relative file name, it is expanded against +@code{temporary-file-directory}. + +The compatibility version adds support for handling the optional +argument @var{TEXT}. + +@example +@group +(make-temp-file "foo") + @result{} "/tmp/foo232J6v" +@end group +@end example + +When @code{make-temp-file} returns, the file has been created and is +empty. At that point, you should write the intended contents into the +file. + +If @var{dir-flag} is non-@code{nil}, @code{make-temp-file} creates an +empty directory instead of an empty file. It returns the file name, +not the directory name, of that directory. @xref{Directory Names,,,elisp}. + +If @var{suffix} is non-@code{nil}, @code{make-temp-file} adds it at +the end of the file name. + +If @var{text} is a string, @code{make-temp-file} inserts it in the file. + +To prevent conflicts among different libraries running in the same +Emacs, each Lisp program that uses @code{make-temp-file} should have its +own @var{prefix}. The number added to the end of @var{prefix} +distinguishes between the same application running in different Emacs +jobs. Additional added characters permit a large number of distinct +names even in one Emacs job. +@end defun + @defun compat-call@ assoc key alist &optional testfn This function returns the first association for @var{key} in @var{alist}, comparing @var{key} against the alist elements using @@ -2844,6 +2886,28 @@ Like @code{when-let}, but repeat until a binding in @var{spec} is This is comparable to @code{and-let*}. @end defmac +@c based on lisp/emacs-lisp/ert-x.el +@defmac ert-with-temp-file name &rest body +Bind @var{name} to the name of a new temporary file and evaluate +@var{body}. Delete the temporary file after @var{body} exits normally +or non-locally. @var{name} will be bound to the file name of the +temporary file. See the docstring for supported keyword arguments. +@end defmac + +@c based on lisp/emacs-lisp/ert-x.el +@defmac ert-with-temp-directory name &rest body +Bind @var{name} to the name of a new temporary directory and evaluate +@var{body}. Delete the temporary directory after @var{body} exits +normally or non-locally. + +@var{name} is bound to the directory name, not the directory file +name. (In other words, it will end with the directory delimiter; on +Unix-like systems, it will end with "/".) + +The same keyword arguments are supported as in +@code{ert-with-temp-file} (which see), except for @code{:text}. +@end defmac + @subsection Extended Definitions These functions must be called explicitly via @code{compat-call}, since their calling convention or behavior was extended in Emacs 29.1: -- cgit v1.0