From 652b0f4c7453e6d440fec767336ca85aec13e33d Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 18 Apr 2021 21:57:59 +0200 Subject: [PATCH] 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. --- test/lisp/progmodes/project-tests.el | 78 ++++++++++++++++------------ 1 file 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 -- 2.39.5