summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/ert-x.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp/ert-x.el')
-rw-r--r--lisp/emacs-lisp/ert-x.el131
1 files changed, 118 insertions, 13 deletions
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 17967ae2bfc..6fe1ade7a06 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -338,7 +338,8 @@ unless the output is going to the echo area (when PRINTCHARFUN is
t or PRINTCHARFUN is nil and `standard-output' is t). If the
output is destined for the echo area, the advice function will
convert it to a string and pass it to COLLECTOR first."
- (lambda (func object &optional printcharfun)
+ ;;; FIXME: Pass on OVERRIDES.
+ (lambda (func object &optional printcharfun _overrides)
(if (not (eq t (or printcharfun standard-output)))
(funcall func object printcharfun)
(funcall collector (with-output-to-string
@@ -352,7 +353,6 @@ convert it to a string and pass it to COLLECTOR first."
(defvar ert-resource-directory-trim-right-regexp "\\(-tests?\\)?\\.el"
"Regexp for `string-trim' (right) used by `ert-resource-directory'.")
-;; Has to be a macro for `load-file-name'.
(defmacro ert-resource-directory ()
"Return absolute file name of the resource (test data) directory.
@@ -368,17 +368,17 @@ variable `ert-resource-directory-format'. Before formatting, the
file name will be trimmed using `string-trim' with arguments
`ert-resource-directory-trim-left-regexp' and
`ert-resource-directory-trim-right-regexp'."
- `(let* ((testfile ,(or (macroexp-file-name)
- buffer-file-name))
- (default-directory (file-name-directory testfile)))
- (file-truename
- (if (file-accessible-directory-p "resources/")
- (expand-file-name "resources/")
- (expand-file-name
- (format ert-resource-directory-format
- (string-trim testfile
- ert-resource-directory-trim-left-regexp
- ert-resource-directory-trim-right-regexp)))))))
+ `(when-let ((testfile ,(or (macroexp-file-name)
+ buffer-file-name)))
+ (let ((default-directory (file-name-directory testfile)))
+ (file-truename
+ (if (file-accessible-directory-p "resources/")
+ (expand-file-name "resources/")
+ (expand-file-name
+ (format ert-resource-directory-format
+ (string-trim testfile
+ ert-resource-directory-trim-left-regexp
+ ert-resource-directory-trim-right-regexp))))))))
(defmacro ert-resource-file (file)
"Return absolute file name of resource (test data) file named FILE.
@@ -386,6 +386,111 @@ A resource file is defined as any file placed in the resource
directory as returned by `ert-resource-directory'."
`(expand-file-name ,file (ert-resource-directory)))
+(defvar ert-temp-file-prefix "emacs-test-"
+ "Prefix used by `ert-with-temp-file' and `ert-with-temp-directory'.")
+
+(defvar ert-temp-file-suffix nil
+ "Suffix used by `ert-with-temp-file' and `ert-with-temp-directory'.")
+
+(defun ert--with-temp-file-generate-suffix (filename)
+ "Generate temp file suffix from FILENAME."
+ (thread-last
+ (file-name-base filename)
+ (replace-regexp-in-string (rx string-start
+ (group (+? not-newline))
+ (regexp "-?tests?")
+ string-end)
+ "\\1")
+ (concat "-")))
+
+(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.
+
+: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'."
+ (declare (indent 1) (debug (symbolp body)))
+ (cl-check-type name symbol)
+ (let (keyw prefix suffix directory text extra-keywords coding)
+ (while (keywordp (setq keyw (car body)))
+ (setq body (cdr body))
+ (pcase keyw
+ (:prefix (setq prefix (pop body)))
+ (:suffix (setq suffix (pop body)))
+ (:directory (setq directory (pop body)))
+ (:text (setq text (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 ert-temp-file-prefix))
+ (suffix (or suffix ert-temp-file-suffix
+ (ert--with-temp-file-generate-suffix
+ (or (macroexp-file-name) buffer-file-name)))))
+ `(let* ((coding-system-for-write ,(or coding coding-system-for-write))
+ (,temp-file (,(if directory 'file-name-as-directory 'identity)
+ (make-temp-file ,prefix ,directory ,suffix ,text)))
+ (,name ,(if directory
+ `(file-name-as-directory ,temp-file)
+ temp-file)))
+ (unwind-protect
+ (progn ,@body)
+ (ignore-errors
+ ,(if directory
+ `(delete-directory ,temp-file :recursive)
+ `(delete-file ,temp-file))))))))
+
+(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."
+ (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))
+
+(defun ert-gcc-is-clang-p ()
+ "Return non-nil if the `gcc' command actually runs the Clang compiler."
+ ;; Some macOS machines run llvm when you type gcc. (!)
+ ;; We can't even check if it's a symlink; it's a binary placed in
+ ;; "/usr/bin/gcc". So we need to check the output.
+ (string-match "Apple \\(LLVM\\|[Cc]lang\\)\\|Xcode\\.app"
+ (shell-command-to-string "gcc --version")))
+
(provide 'ert-x)
;;; ert-x.el ends here