123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899 |
- (use-modules (gnu tests)
- (gnu packages package-management)
- ((gnu ci) #:select (channel-source->package))
- ((guix git-download) #:select (git-predicate))
- ((guix utils) #:select (current-source-directory))
- (git)
- (ice-9 match))
- (define (source-commit directory)
- "Return the commit of the head of DIRECTORY or #f if it could not be
- determined."
- (let ((repository #f))
- (catch 'git-error
- (lambda ()
- (set! repository (repository-open directory))
- (let* ((head (repository-head repository))
- (target (reference-target head))
- (commit (oid->string target)))
- (repository-close! repository)
- commit))
- (lambda _
- (when repository
- (repository-close! repository))
- #f))))
- (define (tests-for-current-guix source commit)
- "Return a list of tests for perform, using Guix built from SOURCE, a channel
- instance."
-
-
-
-
- (parameterize ((current-guix-package
- (channel-source->package source #:commit commit)))
- (match (getenv "TESTS")
- (#f
- (all-system-tests))
- ((= string-tokenize (tests ...))
- (filter (lambda (test)
- (member (system-test-name test) tests))
- (all-system-tests))))))
- (define (system-test->manifest-entry test)
- "Return a manifest entry for TEST, a system test."
- (manifest-entry
- (name (string-append "test." (system-test-name test)))
- (version "0")
- (item test)))
- (define (system-test-manifest)
- "Return a manifest containing all the system tests, or all those selected by
- the 'TESTS' environment variable."
- (define source
- (string-append (current-source-directory) "/.."))
- (define commit
-
-
- (source-commit source))
-
-
-
- (let* ((source (local-file source
- (if commit
- (string-append "guix-"
- (string-take commit 7))
- "guix-source")
- #:recursive? #t
- #:select?
- (or (git-predicate source)
- (const #t))))
- (tests (tests-for-current-guix source commit)))
- (format (current-error-port) "Selected ~a system tests...~%"
- (length tests))
- (manifest (map system-test->manifest-entry tests))))
- (system-test-manifest)
|