12/28: build-system/asdf: Always pre-load the system's definition file.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository guix.

commit 0186a463d0f352eef485326cf57619d23a26734e
Author: Andy Patterson <address@hidden>
Date:   Mon Apr 3 09:01:29 2017 -0400

    build-system/asdf: Always pre-load the system's definition file.
    
    * guix/build-system/asdf.scm (asdf-build)[builder]: Pass a default
    `#:asd-file' argument to the build procedure, using the system's name.
    * guix/build/asdf-build-system.scm (build, check): Adjust to assume that
    `asd-file' will always be a string.
    * guix/build/lisp-utils.scm (compile-system, system-dependencies)
    (test-system): Likewise.
---
 guix/build-system/asdf.scm       |  2 +-
 guix/build/asdf-build-system.scm | 11 ++---------
 guix/build/lisp-utils.scm        | 27 +++++++++------------------
 3 files changed, 12 insertions(+), 28 deletions(-)

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index 553bbe4..f842fdc 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -294,7 +294,7 @@ set up using CL source package conventions."
                                     (derivation->output-path source))
                                    ((source) source)
                                    (source source))
-                       #:asd-file ,asd-file
+                       #:asd-file ,(or asd-file (string-append system-name 
".asd"))
                        #:asd-system-name ,system-name
                        #:system ,system
                        #:tests? ,tests?
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index 20116a4..4f3fc16 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -118,17 +118,11 @@ valid."
          (translations (wrap-output-translations
                         `(,(output-translation source-path
                                                out))))
-         (asd-file (and=> asd-file
-                          (cut source-asd-file out asd-system-name <>))))
+         (asd-file (source-asd-file out asd-system-name asd-file)))
 
     (setenv "ASDF_OUTPUT_TRANSLATIONS"
             (replace-escaped-macros (format #f "~S" translations)))
 
-    ;; We don't need this if we have the asd file, and it can mess with the
-    ;; load ordering we're trying to enforce
-    (unless asd-file
-      (prepend-to-source-registry (string-append source-path "//")))
-
     (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
 
     (compile-system asd-system-name asd-file)
@@ -144,8 +138,7 @@ valid."
                 #:allow-other-keys)
   "Test the system."
   (let* ((out (library-output outputs))
-         (asd-file (and=> asd-file
-                          (cut source-asd-file out asd-system-name <>))))
+         (asd-file (source-asd-file out asd-system-name asd-file)))
     (if tests?
         (test-system asd-system-name asd-file)
         (format #t "test suite not run~%")))
diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 2d73057..3f7a6f7 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -112,15 +112,12 @@ with PROGRAM."
 
 (define (compile-system system asd-file)
   "Use a lisp implementation to compile SYSTEM using asdf.  Load ASD-FILE
-first if SYSTEM is defined there."
+first."
   (lisp-eval-program
    `(progn
      (require :asdf)
-     (in-package :asdf)
-     ,@(if asd-file
-           `((load ,asd-file))
-           '())
-     (in-package :cl-user)
+     (let ((*package* (find-package :asdf)))
+       (load ,asd-file))
      (funcall (find-symbol
                (symbol-name :operate)
                (symbol-name :asdf))
@@ -131,15 +128,13 @@ first if SYSTEM is defined there."
 
 (define (system-dependencies system asd-file)
   "Return the dependencies of SYSTEM, as reported by
-asdf:system-depends-on.  First load the system's ASD-FILE, if necessary."
+asdf:system-depends-on.  First load the system's ASD-FILE."
   (define deps-file ".deps.sexp")
   (define program
     `(progn
       (require :asdf)
-      ,@(if asd-file
-            `((let ((*package* (find-package :asdf)))
-                (load ,asd-file)))
-            '())
+      (let ((*package* (find-package :asdf)))
+        (load ,asd-file))
       (with-open-file
        (stream ,deps-file :direction :output)
        (format stream
@@ -183,16 +178,12 @@ asdf:system-depends-on.  First load the system's 
ASD-FILE, if necessary."
           '())))
 
 (define (test-system system asd-file)
-  "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILE first
-if SYSTEM is defined there."
+  "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILE first."
   (lisp-eval-program
    `(progn
      (require :asdf)
-     (in-package :asdf)
-     ,@(if asd-file
-           `((load ,asd-file))
-           '())
-     (in-package :cl-user)
+     (let ((*package* (find-package :asdf)))
+       (load ,asd-file))
      (funcall (find-symbol
                (symbol-name :test-system)
                (symbol-name :asdf))