build-system: asdf: Let ASDF locate the .asd files.
This approach has many benefits: - It simplifies the build system. - The package definitions are easier to write. - It fixes a bug with systems that call asdf:clear-system which would cause the load to fail. See for instance test systems using Prove. * guix/build-system/asdf.scm (package-with-build-system): Remove 'asd-files' and replace 'test-asd-file' by 'asd-test-systems'. (lower): Same. * guix/build/asdf-build-system.scm (source-asd-file): Remove since ASDF does it better than us. (find-asd-files): Same. (build): Remove unused asd-files argument. (check): Remove asd-files argument and replace asd-systems by asd-test-systems. * guix/build/lisp-utils.scm (compile-systems): Call to ASDF to find the systems. (test-system): Same. Signed-off-by: Guillaume Le Vaillant <glv@posteo.net>
This commit is contained in:
Pierre Neidhardt
Guillaume Le Vaillant
parent
6b5ef03a25
commit
6181f1f263
@ -2,6 +2,7 @@
|
||||
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
|
||||
;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
|
||||
;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@ -202,7 +203,7 @@ set up using CL source package conventions."
|
||||
(define base-arguments
|
||||
(if target-is-source?
|
||||
(strip-keyword-arguments
|
||||
'(#:tests? #:asd-files #:lisp #:asd-systems #:test-asd-file)
|
||||
'(#:tests? #:lisp #:asd-systems #:asd-test-systems)
|
||||
(package-arguments pkg))
|
||||
(package-arguments pkg)))
|
||||
|
||||
@ -270,9 +271,8 @@ set up using CL source package conventions."
|
||||
(lambda* (name inputs
|
||||
#:key source outputs
|
||||
(tests? #t)
|
||||
(asd-files ''())
|
||||
(asd-systems ''())
|
||||
(test-asd-file #f)
|
||||
(asd-test-systems ''())
|
||||
(phases '%standard-phases)
|
||||
(search-paths '())
|
||||
(system (%current-system))
|
||||
@ -292,6 +292,11 @@ set up using CL source package conventions."
|
||||
`(quote ,(list package-name)))
|
||||
asd-systems))
|
||||
|
||||
(define test-systems
|
||||
(if (null? (cadr asd-test-systems))
|
||||
systems
|
||||
asd-test-systems))
|
||||
|
||||
(define builder
|
||||
(with-imported-modules imported-modules
|
||||
#~(begin
|
||||
@ -302,9 +307,8 @@ set up using CL source package conventions."
|
||||
(%lisp-type #$lisp-type))
|
||||
(asdf-build #:name #$name
|
||||
#:source #+source
|
||||
#:asd-files #$asd-files
|
||||
#:asd-systems #$systems
|
||||
#:test-asd-file #$test-asd-file
|
||||
#:asd-test-systems #$test-systems
|
||||
#:system #$system
|
||||
#:tests? #$tests?
|
||||
#:phases #$phases
|
||||
|
||||
@ -1,6 +1,7 @@
|
||||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
|
||||
;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
|
||||
;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
@ -78,16 +79,6 @@
|
||||
(,(library-directory object-output)
|
||||
:**/ :*.*.*)))
|
||||
|
||||
(define (source-asd-file output name asd-file)
|
||||
(string-append (lisp-source-directory output name) "/" asd-file))
|
||||
|
||||
(define (find-asd-files output name asd-files)
|
||||
(if (null? asd-files)
|
||||
(find-files (lisp-source-directory output name) "\\.asd$")
|
||||
(map (lambda (asd-file)
|
||||
(source-asd-file output name asd-file))
|
||||
asd-files)))
|
||||
|
||||
(define (copy-files-to-output out name)
|
||||
"Copy all files from the current directory to OUT. Create an extra link to
|
||||
any system-defining files in the source to a convenient location. This is
|
||||
@ -190,7 +181,7 @@ if it's present in the native-inputs."
|
||||
(setenv "XDG_CONFIG_DIRS" (string-append out "/etc")))
|
||||
#t)
|
||||
|
||||
(define* (build #:key outputs inputs asd-files asd-systems
|
||||
(define* (build #:key outputs inputs asd-systems
|
||||
#:allow-other-keys)
|
||||
"Compile the system."
|
||||
(let* ((out (library-output outputs))
|
||||
@ -198,26 +189,20 @@ if it's present in the native-inputs."
|
||||
(source-path (string-append out (%lisp-source-install-prefix)))
|
||||
(translations (wrap-output-translations
|
||||
`(,(output-translation source-path
|
||||
out))))
|
||||
(asd-files (find-asd-files out system-name asd-files)))
|
||||
out)))))
|
||||
(setenv "ASDF_OUTPUT_TRANSLATIONS"
|
||||
(replace-escaped-macros (format #f "~S" translations)))
|
||||
(setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
|
||||
(compile-systems asd-systems asd-files))
|
||||
(compile-systems asd-systems (lisp-source-directory out system-name)))
|
||||
#t)
|
||||
|
||||
(define* (check #:key tests? outputs inputs asd-files asd-systems
|
||||
test-asd-file
|
||||
(define* (check #:key tests? outputs inputs asd-test-systems
|
||||
#:allow-other-keys)
|
||||
"Test the system."
|
||||
(let* ((out (library-output outputs))
|
||||
(system-name (main-system-name out))
|
||||
(asd-files (find-asd-files out system-name asd-files))
|
||||
(test-asd-file
|
||||
(and=> test-asd-file
|
||||
(cut source-asd-file out system-name <>))))
|
||||
(system-name (main-system-name out)))
|
||||
(if tests?
|
||||
(test-system (first asd-systems) asd-files test-asd-file)
|
||||
(test-system asd-test-systems (lisp-source-directory out system-name))
|
||||
(format #t "test suite not run~%")))
|
||||
#t)
|
||||
|
||||
|
||||
@ -108,38 +108,33 @@ with PROGRAM."
|
||||
"--eval" "(quit)"))
|
||||
(_ (error "The LISP provided is not supported at this time."))))
|
||||
|
||||
(define (compile-systems systems asd-files)
|
||||
(define (compile-systems systems directory)
|
||||
"Use a lisp implementation to compile the SYSTEMS using asdf.
|
||||
Load ASD-FILES first."
|
||||
(lisp-eval-program
|
||||
`((require :asdf)
|
||||
,@(map (lambda (asd-file)
|
||||
`(asdf:load-asd (truename ,asd-file)))
|
||||
asd-files)
|
||||
(asdf:initialize-source-registry
|
||||
(list :source-registry (list :tree (uiop:ensure-pathname ,directory
|
||||
:truenamize t
|
||||
:ensure-directory t))
|
||||
:inherit-configuration))
|
||||
,@(map (lambda (system)
|
||||
`(asdf:load-system ,system))
|
||||
systems))))
|
||||
|
||||
(define (test-system system asd-files test-asd-file)
|
||||
(define (test-system test-systems directory)
|
||||
"Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILES first.
|
||||
Also load TEST-ASD-FILE if necessary."
|
||||
(lisp-eval-program
|
||||
`((require :asdf)
|
||||
,@(map (lambda (asd-file)
|
||||
`(asdf:load-asd (truename ,asd-file)))
|
||||
asd-files)
|
||||
,@(if test-asd-file
|
||||
`((asdf:load-asd (truename ,test-asd-file)))
|
||||
;; Try some likely files.
|
||||
(map (lambda (file)
|
||||
`(when (uiop:file-exists-p ,file)
|
||||
(asdf:load-asd (truename ,file))))
|
||||
(list
|
||||
(string-append system "-tests.asd")
|
||||
(string-append system "-test.asd")
|
||||
"tests.asd"
|
||||
"test.asd")))
|
||||
(asdf:test-system ,system))))
|
||||
(asdf:initialize-source-registry
|
||||
(list :source-registry (list :tree (uiop:ensure-pathname ,directory
|
||||
:truenamize t
|
||||
:ensure-directory t))
|
||||
:inherit-configuration))
|
||||
,@(map (lambda (system)
|
||||
`(asdf:test-system ,system))
|
||||
test-systems))))
|
||||
|
||||
(define (string->lisp-keyword . strings)
|
||||
"Return a lisp keyword for the concatenation of STRINGS."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user