diff options
Diffstat (limited to 'guix/build')
-rw-r--r-- | guix/build/asdf-build-system.scm | 29 | ||||
-rw-r--r-- | guix/build/lisp-utils.scm | 35 |
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." |