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.
This commit is contained in:
Andy Patterson 2017-04-03 09:01:29 -04:00 committed by Ricardo Wurmus
parent 457702b1d9
commit 0186a463d0
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
3 changed files with 12 additions and 28 deletions

View File

@ -294,7 +294,7 @@ set up using CL source package conventions."
(derivation->output-path source)) (derivation->output-path source))
((source) source) ((source) source)
(source source)) (source source))
#:asd-file ,asd-file #:asd-file ,(or asd-file (string-append system-name ".asd"))
#:asd-system-name ,system-name #:asd-system-name ,system-name
#:system ,system #:system ,system
#:tests? ,tests? #:tests? ,tests?

View File

@ -118,17 +118,11 @@ valid."
(translations (wrap-output-translations (translations (wrap-output-translations
`(,(output-translation source-path `(,(output-translation source-path
out)))) out))))
(asd-file (and=> asd-file (asd-file (source-asd-file out asd-system-name asd-file)))
(cut source-asd-file out asd-system-name <>))))
(setenv "ASDF_OUTPUT_TRANSLATIONS" (setenv "ASDF_OUTPUT_TRANSLATIONS"
(replace-escaped-macros (format #f "~S" 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 (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
(compile-system asd-system-name asd-file) (compile-system asd-system-name asd-file)
@ -144,8 +138,7 @@ valid."
#:allow-other-keys) #:allow-other-keys)
"Test the system." "Test the system."
(let* ((out (library-output outputs)) (let* ((out (library-output outputs))
(asd-file (and=> asd-file (asd-file (source-asd-file out asd-system-name asd-file)))
(cut source-asd-file out asd-system-name <>))))
(if tests? (if tests?
(test-system asd-system-name asd-file) (test-system asd-system-name asd-file)
(format #t "test suite not run~%"))) (format #t "test suite not run~%")))

View File

@ -112,15 +112,12 @@ with PROGRAM."
(define (compile-system system asd-file) (define (compile-system system asd-file)
"Use a lisp implementation to compile SYSTEM using asdf. Load ASD-FILE "Use a lisp implementation to compile SYSTEM using asdf. Load ASD-FILE
first if SYSTEM is defined there." first."
(lisp-eval-program (lisp-eval-program
`(progn `(progn
(require :asdf) (require :asdf)
(in-package :asdf) (let ((*package* (find-package :asdf)))
,@(if asd-file (load ,asd-file))
`((load ,asd-file))
'())
(in-package :cl-user)
(funcall (find-symbol (funcall (find-symbol
(symbol-name :operate) (symbol-name :operate)
(symbol-name :asdf)) (symbol-name :asdf))
@ -131,15 +128,13 @@ first if SYSTEM is defined there."
(define (system-dependencies system asd-file) (define (system-dependencies system asd-file)
"Return the dependencies of SYSTEM, as reported by "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 deps-file ".deps.sexp")
(define program (define program
`(progn `(progn
(require :asdf) (require :asdf)
,@(if asd-file (let ((*package* (find-package :asdf)))
`((let ((*package* (find-package :asdf))) (load ,asd-file))
(load ,asd-file)))
'())
(with-open-file (with-open-file
(stream ,deps-file :direction :output) (stream ,deps-file :direction :output)
(format stream (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) (define (test-system system asd-file)
"Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILE first."
if SYSTEM is defined there."
(lisp-eval-program (lisp-eval-program
`(progn `(progn
(require :asdf) (require :asdf)
(in-package :asdf) (let ((*package* (find-package :asdf)))
,@(if asd-file (load ,asd-file))
`((load ,asd-file))
'())
(in-package :cl-user)
(funcall (find-symbol (funcall (find-symbol
(symbol-name :test-system) (symbol-name :test-system)
(symbol-name :asdf)) (symbol-name :asdf))