Factor out a helper macro to create a temporary directory.

This is a useful abstraction, and saves a few levels of indentation in
the test body.

* test/lisp/progmodes/project-tests.el
(project-tests--with-temporary-directory): New helper macro.
(project/quoted-directory): Use it.

1 files changed, 44 insertions, 34 deletions

diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el
index bb58f80d181..c8c03aa2579 100644
--- a/test/lisp/progmodes/project-tests.el
+++ b/test/lisp/progmodes/project-tests.el
@@ -27,49 +27,59 @@
 
 (require 'project)
 
+(require 'cl-lib)
 (require 'ert)
 (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"))
-  (let ((directory (make-temp-file "project-tests-" :directory)))
-    (unwind-protect
-        (let ((default-directory directory)
-              (project-current-inhibit-prompt t)
-              (project-find-functions nil)
-              (project-list-file
-               (expand-file-name "projects" directory))
-              (project (cons 'transient (file-name-quote directory)))
-              (file (expand-file-name "file" directory)))
-          (add-hook 'project-find-functions (lambda (_dir) project))
-          (should (eq (project-current) project))
-          (write-region "contents" nil file nil nil nil 'excl)
-          (should (equal (project-files project)
-                         (list (file-name-quote file))))
-          (let* ((references nil)
-                 (xref-search-program 'grep)
-                 (xref-show-xrefs-function
-                  (lambda (fetcher _display)
-                    (push (funcall fetcher) references))))
-            (project-find-regexp "tent")
-            (pcase references
-              (`((,item))
-               (should
-                ;; FIXME: Shouldn't `xref-match-item' be a subclass of
-                ;; `xref-item'?
-                (cl-typep item '(or xref-item xref-match-item)))
-               (should
-                (file-equal-p
-                 (xref-location-group (xref-item-location item))
-                 file)))
-              (otherwise
-               (ert-fail (format-message "Unexpected references: %S"
-                                         otherwise))))))
-      (delete-directory directory :recursive))))
+  (project-tests--with-temporary-directory directory
+    (let ((default-directory directory)
+          (project-current-inhibit-prompt t)
+          (project-find-functions nil)
+          (project-list-file
+           (expand-file-name "projects" directory))
+          (project (cons 'transient (file-name-quote directory)))
+          (file (expand-file-name "file" directory)))
+      (add-hook 'project-find-functions (lambda (_dir) project))
+      (should (eq (project-current) project))
+      (write-region "contents" nil file nil nil nil 'excl)
+      (should (equal (project-files project)
+                     (list (file-name-quote file))))
+      (let* ((references nil)
+             (xref-search-program 'grep)
+             (xref-show-xrefs-function
+              (lambda (fetcher _display)
+                (push (funcall fetcher) references))))
+        (project-find-regexp "tent")
+        (pcase references
+          (`((,item))
+           ;; FIXME: Shouldn't `xref-match-item' be a subclass of
+           ;; `xref-item'?
+           (should (cl-typep item '(or xref-item xref-match-item)))
+           (should (file-equal-p
+                    (xref-location-group (xref-item-location item))
+                    file)))
+          (otherwise
+           (ert-fail (format-message "Unexpected references: %S"
+                                     otherwise))))))))
 
 ;;; project-tests.el ends here