From 6181f1f26310146ae509af2074c55f87e8f21a96 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 1 Jul 2022 17:17:32 +0200 Subject: 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 --- guix/build/asdf-build-system.scm | 29 +++++++---------------------- guix/build/lisp-utils.scm | 35 +++++++++++++++-------------------- 2 files changed, 22 insertions(+), 42 deletions(-) (limited to 'guix/build') 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 ;;; Copyright © 2020, 2021 Guillaume Le Vaillant +;;; Copyright © 2022 Pierre Neidhardt ;;; ;;; This file is part of GNU Guix. ;;; @@ -78,16 +79,6 @@ (define (output-translation source-path (,(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 @@ (define* (configure #:key inputs #:allow-other-keys) (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 @@ (define* (build #:key outputs inputs asd-files asd-systems (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 @@ (define (lisp-invocation 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." -- cgit v1.2.3