nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

build-system/asdf: Handle tests defined in external systems. 

* guix/build-system/asdf.scm (asdf-build): Add a #:test-asd-file argument.
[builder]: Pass it to the build system.
(package-with-build-system)[transform]: Strip it from source systems' arguments.
* guix/build/asdf-build-system.scm (check): Pass the fully qualified path to
it on to the test-system procedure.
* guix/build/lisp-utils.scm (test-system): Load the file, or otherwise one of
the often used names for it, before running the tests.  Adjust the docstring
accordingly.
This commit is contained in:
Andy Patterson 2017-04-08 23:43:31 -04:00 committed by Ricardo Wurmus
parent f56da605d8
commit 0383afa02a
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
3 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
guix/build-system/asdf.scm
View File

@ -199,7 +199,7 @@ set up using CL source package conventions."
(define base-arguments (define base-arguments
(if target-is-source? (if target-is-source?
(strip-keyword-arguments (strip-keyword-arguments
'(#:tests? #:asd-file #:lisp #:asd-system-name) '(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file)
(package-arguments pkg)) (package-arguments pkg))
(package-arguments pkg))) (package-arguments pkg)))
@ -266,6 +266,7 @@ set up using CL source package conventions."
(tests? #t) (tests? #t)
(asd-file #f) (asd-file #f)
(asd-system-name #f) (asd-system-name #f)
(test-asd-file #f)
(phases '(@ (guix build asdf-build-system) (phases '(@ (guix build asdf-build-system)
%standard-phases)) %standard-phases))
(search-paths '()) (search-paths '())
@ -296,6 +297,7 @@ set up using CL source package conventions."
(source source)) (source source))
#:asd-file ,(or asd-file (string-append system-name ".asd")) #:asd-file ,(or asd-file (string-append system-name ".asd"))
#:asd-system-name ,system-name #:asd-system-name ,system-name
#:test-asd-file ,test-asd-file
#:system ,system #:system ,system
#:tests? ,tests? #:tests? ,tests?
#:phases ,phases #:phases ,phases

8
guix/build/asdf-build-system.scm
View File

@ -131,12 +131,16 @@ valid."
#t) #t)
(define* (check #:key tests? outputs inputs asd-file asd-system-name (define* (check #:key tests? outputs inputs asd-file asd-system-name
test-asd-file
#:allow-other-keys) #:allow-other-keys)
"Test the system." "Test the system."
(let* ((out (library-output outputs)) (let* ((out (library-output outputs))
(asd-file (source-asd-file out asd-system-name asd-file))) (asd-file (source-asd-file out asd-system-name asd-file))
(test-asd-file
(and=> test-asd-file
(cut source-asd-file out asd-system-name <>))))
(if tests? (if tests?
(test-system asd-system-name asd-file) (test-system asd-system-name asd-file test-asd-file)
(format #t "test suite not run~%"))) (format #t "test suite not run~%")))
#t) #t)

18
guix/build/lisp-utils.scm
View File

@ -184,12 +184,24 @@ asdf:system-depends-on. First load the system's ASD-FILE."
`(:lib ,(string-append system ".a")) `(:lib ,(string-append system ".a"))
'()))) '())))
(define (test-system system asd-file) (define (test-system system asd-file test-asd-file)
"Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first." "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first.
Also load TEST-ASD-FILE if necessary."
(lisp-eval-program (lisp-eval-program
`((require :asdf) `((require :asdf)
(let ((*package* (find-package :asdf))) (let ((*package* (find-package :asdf)))
(load ,asd-file)) (load ,asd-file)
,@(if test-asd-file
`((load ,test-asd-file))
;; Try some likely files.
(map (lambda (file)
`(when (uiop:file-exists-p ,file)
(load ,file)))
(list
(string-append system "-tests.asd")
(string-append system "-test.asd")
"tests.asd"
"test.asd"))))
(asdf:test-system ,system)))) (asdf:test-system ,system))))
(define (string->lisp-keyword . strings) (define (string->lisp-keyword . strings)