summaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
authorPierre Neidhardt <mail@ambrevar.xyz>2022-07-01 17:17:32 +0200
committerGuillaume Le Vaillant <glv@posteo.net>2022-08-03 16:45:53 +0200
commit6181f1f26310146ae509af2074c55f87e8f21a96 (patch)
treeffbd541615acc24b8bf7cec44975a713fab32adf /guix/build
parent6b5ef03a2582ab23228478018fd356e17db1daea (diff)
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>
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/asdf-build-system.scm29
-rw-r--r--guix/build/lisp-utils.scm35
2 files changed, 22 insertions, 42 deletions
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index 6186613e52..0a3c55c6c4 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -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)
diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 8403c94cb5..7c5d865338 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -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."