02/05: build-system: asdf: Read all .asd files if no #:asd-files specified.

[guix-commits]

glv pushed a commit to branch wip-lisp
in repository guix.

commit 952fafb2a3c7a0978cc6a96268ad0632558b212d
Author: Guillaume Le Vaillant <glv@posteo.net>
AuthorDate: Tue Sep 15 14:36:24 2020 +0200

    build-system: asdf: Read all .asd files if no #:asd-files specified.
    
    * guix/build-system/asdf.scm (asdf-build): Remove the 'files' variable.
    * guix/build/asd-build-system.scm (find-asd-files): New variable.
      (build, check): Use it.
---
 guix/build-system/asdf.scm       | 11 ++---------
 guix/build/asdf-build-system.scm | 15 +++++++++------
 2 files changed, 11 insertions(+), 15 deletions(-)

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index 334a119..28403a1 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -291,7 +291,7 @@ set up using CL source package conventions."
                   (imported-modules %asdf-build-system-modules)
                   (modules %asdf-build-modules))
 
-    ;; FIXME: The definitions of 'systems' and 'files' are pretty hacky.
+    ;; FIXME: The definition of 'systems' is pretty hacky.
     ;; Is there a more elegant way to do it?
     (define systems
       (if (null? (cadr asd-systems))
@@ -303,13 +303,6 @@ set up using CL source package conventions."
                (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix.
           asd-systems))
 
-    (define files
-      (if (null? (cadr asd-files))
-          `(quote ,(map (lambda (system)
-                          (string-append system ".asd"))
-                        (cadr systems)))
-          asd-files))
-
     (define builder
       `(begin
          (use-modules ,@modules)
@@ -323,7 +316,7 @@ set up using CL source package conventions."
                                     (derivation->output-path source))
                                    ((source) source)
                                    (source source))
-                       #:asd-files ,files
+                       #:asd-files ,asd-files
                        #:asd-systems ,systems
                        #:test-asd-file ,test-asd-file
                        #:system ,system
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index b7957e7..26d295e 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -81,6 +81,13 @@ to it's binary 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
@@ -189,9 +196,7 @@ if it's present in the native-inputs."
          (translations (wrap-output-translations
                         `(,(output-translation source-path
                                                out))))
-         (asd-files (map (lambda (asd-file)
-                           (source-asd-file out system-name asd-file))
-                         asd-files)))
+         (asd-files (find-asd-files out system-name asd-files)))
     (setenv "ASDF_OUTPUT_TRANSLATIONS"
             (replace-escaped-macros (format #f "~S" translations)))
     (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
@@ -204,9 +209,7 @@ if it's present in the native-inputs."
   "Test the system."
   (let* ((out (library-output outputs))
          (system-name (main-system-name out))
-         (asd-files (map (lambda (asd-file)
-                           (source-asd-file out system-name asd-file))
-                         asd-files))
+         (asd-files (find-asd-files out system-name asd-files))
          (test-asd-file
           (and=> test-asd-file
                  (cut source-asd-file out system-name <>))))