Add ert-with-temp-directory and ert-with-temp-file

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) ;; <compat-tests:make-temp-file>
+  "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) ;; <compat-tests:make-nearby-temp-file>
   "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) ;; <compat-tests:ert-with-temp-file>
+  "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) ;; <compat-tests:ert-with-temp-directory>
+  "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: