Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Create package-vc-tests repositories once per tests run (bug#80235)

Browse source 
* test/lisp/emacs-lisp/package-vc-tests.el
(package-vc-tests-repos): New variable.
(package-vc-tests-create-repository): Add argument `repos-dir'.
(package-vc-tests-make-temp-dir): Create a temporary directory
with prefix.
(package-vc-with-tests-environment): Use
`package-vc-tests-make-temp-dir' to create a temporary directory
for package test.  Use `package-vc-tests-repos' to cache test
package repository.
(package-vc-tests-preserve-pkg-artifacts-p): Detect when to
preserve package temporary files.
(package-vc-tests-environment-tear-down): Use
`package-vc-tests-preserve-pkg-artifacts-p'.  Use plural there
are more than one buffer.  Report temporary directory with test
repository.
(package-vc-tests-add-ert-run-tests-listener): Wrap listener in
args with custom functionality for `package-vc-tests'.  On tests
run start reset `package-vc-tests-repos' cache.  On tests run
end delete temporary directories.
This commit is contained in:
Przemysław Kryger 2026-01-27 11:45:28 +00:00 committed by Mattias Engdegård
parent 43d6907ad9
commit b370a076b9
1 changed files with 97 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

126
test/lisp/emacs-lisp/package-vc-tests.el
View file

@ -65,6 +65,8 @@ of symbols, then preserve temporary directories and buffers for each
package that matches a symbol in the list. When this variable is t then
preserve all temporary directories.")
(defvar package-vc-tests-repos (make-hash-table))
(defvar package-vc-tests-dir)
(defvar package-vc-tests-packages)
(defvar package-vc-tests-repository)
@ -169,12 +171,11 @@ When LISP-DIR is non-nil place the NAME file under LISP-DIR."
(error "Failed to invoke sed on %s" in-file))
(vc-git-command nil 0 nil "add" ".")))
(defun package-vc-tests-create-repository (suffix &optional lisp-dir)
"Create a test package repository with SUFFIX.
(defun package-vc-tests-create-repository (suffix repos-dir &optional lisp-dir)
"Create a test package repository with SUFFIX in REPOS-DIR.
If LISP-DIR is non-nil place sources of the package in LISP-DIR."
(let* ((name (format "test-package-%s" suffix))
(repo-dir (expand-file-name (file-name-concat "repo" name)
package-vc-tests-dir)))
(repo-dir (expand-file-name name repos-dir)))
(make-directory (expand-file-name (or lisp-dir ".") repo-dir) t)
(let ((default-directory repo-dir)
(process-environment
@ -399,6 +400,11 @@ names."
(not (member lisp-dir '("lisp" "src")))
(list :lisp-dir lisp-dir)))))
(defun package-vc-tests-make-temp-dir (prefix)
"Create temp directory with PREFIX."
(expand-file-name
(make-temp-file prefix t (format-time-string "-%Y%m%d.%H%M%S.%3N"))))
(defun package-vc-with-tests-environment (pkg function)
"Call FUNCTION with no arguments within a test environment set up for PKG."
;; Create a test package sources repository, based on skeleton files
@ -406,10 +412,7 @@ names."
;; that:
;;
(let* ((package-vc-tests-dir
(expand-file-name
(make-temp-file "package-vc-tests-"
t
(format-time-string "-%Y%m%d.%H%M%S.%3N"))))
(package-vc-tests-make-temp-dir "package-vc-tests-"))
;; - packages are installed into test directory
(package-user-dir (expand-file-name "elpa"
package-vc-tests-dir))
@ -428,13 +431,25 @@ names."
(package-vc-tests-packages (package-vc-tests-packages))
;; - create a test package bundle
(package-vc-tests-repository
(let* ((pkg-name (symbol-name pkg))
(suffix (and (string-match
(rx ?- (group (1+ (not ?-))) eos)
pkg-name)
(match-string 1 pkg-name))))
(package-vc-tests-create-repository
suffix (cadr (alist-get pkg package-vc-tests-packages)))))
(or
(gethash pkg package-vc-tests-repos)
(let* ((pkg-name (symbol-name pkg))
(suffix (and (string-match
(rx ?- (group (1+ (not ?-))) eos)
pkg-name)
(match-string 1 pkg-name)))
(repos-dir
(or (gethash 'repos-dir package-vc-tests-repos)
(puthash 'repos-dir
(package-vc-tests-make-temp-dir
"package-vc-tests-repos-")
package-vc-tests-repos))))
(puthash pkg
(package-vc-tests-create-repository
suffix
repos-dir
(cadr (alist-get pkg package-vc-tests-packages)))
package-vc-tests-repos))))
;; - find all packages that are present in a test ELPA
(package-vc-tests-elpa-packages
(cl-loop
@ -495,6 +510,12 @@ names."
(package-vc-allow-build-commands t))
(funcall function)))
(defun package-vc-tests-preserve-pkg-artifacts-p (pkg)
"Return non nil if files and buffers for PKG should be preserved."
(or (memq package-vc-tests-preserve-artifacts `(t ,pkg))
(and (listp package-vc-tests-preserve-artifacts)
(memq pkg package-vc-tests-preserve-artifacts))))
(defun package-vc-tests-environment-tear-down (pkg)
"Tear down test environment for PKG.
Unbind package defined symbols, and remove package defined features and
@ -538,27 +559,74 @@ when PKG matches `package-vc-tests-preserve-artifacts'."
(package-vc-tests-log-buffer-name pkg
type)))
'(doc make)))))
(if (or (memq package-vc-tests-preserve-artifacts `(t ,pkg))
(and (listp package-vc-tests-preserve-artifacts)
(memq pkg package-vc-tests-preserve-artifacts)))
(if (package-vc-tests-preserve-pkg-artifacts-p pkg)
(let ((buffers
(mapconcat (lambda (buffer)
(with-current-buffer buffer
(let* ((old-name (buffer-name))
(new-name (make-temp-name
(string-trim old-name))))
(rename-buffer new-name)
(concat old-name " -> " new-name))))
buffers
", ")))
(if buffers
(format " and %s: %s"
(if (cdr buffers) "buffers" "buffer")
(mapconcat
(lambda (buffer)
(with-current-buffer buffer
(let* ((old-name (buffer-name))
(new-name (make-temp-name
(string-trim old-name))))
(rename-buffer new-name)
(format "`%s' -> `%s'"
old-name new-name))))
buffers
", "))
""))
(repo-dir (car (gethash pkg package-vc-tests-repos))))
(message
"package-vc-tests: preserving temporary directory: %s%s"
"package-vc-tests: preserving temporary %s: %s%s%s"
(if repo-dir "directories" "directory")
package-vc-tests-dir
(and buffers (format " and buffers: %s" buffers))))
(if repo-dir (format " and %s" repo-dir) "")
buffers))
(delete-directory package-vc-tests-dir t)
(dolist (buffer buffers)
(kill-buffer buffer)))))
;; Tests create a repository for a package only once per a tests run.
;; The repository location is cached in `package-vc-tests-repos'. To
;; support development, clear the cache on start of each tests run, such
;; that the package repository contains files from the source code.
;; When tests run completes delete repositories accounting for
;; `package-vc-tests-preserve-artifacts', which see.
(defun package-vc-tests-add-ert-run-tests-listener (args)
"Add `package-vc-tests' repositories cleanup to listener in ARGS."
(if-let* ((listener (cadr args))
((functionp listener)))
(cl-list*
(car args)
(lambda (event-type &rest event-args)
(cl-case event-type
(run-started
(clrhash package-vc-tests-repos))
(run-ended
(when-let* ((repos-dir (gethash 'repos-dir
package-vc-tests-repos))
((file-directory-p repos-dir)))
(if package-vc-tests-preserve-artifacts
(progn
(dolist (pkg (package-vc-tests-packages))
(unless
(package-vc-tests-preserve-pkg-artifacts-p pkg)
(when-let* ((repo-dir
(car (gethash pkg package-vc-tests-repos)))
((file-directory-p repo-dir)))
(delete-directory repo-dir t))))
(when (directory-empty-p repos-dir)
(delete-directory repos-dir)))
(delete-directory repos-dir t)))))
(apply listener (cons event-type event-args)))
(drop 2 args))
args))
(advice-add #'ert-run-tests
:filter-args #'package-vc-tests-add-ert-run-tests-listener)
(defun package-vc-tests-with-installed (pkg function)
"Call FUNCTION with PKG installed in a test environment.
FUNCTION should have no arguments."