diff options
| -rw-r--r-- | guix/build-system/asdf.scm | 14 | ||||
| -rw-r--r-- | guix/build/asdf-build-system.scm | 45 | ||||
| -rw-r--r-- | guix/build/lisp-utils.scm | 4 |
3 files changed, 32 insertions, 31 deletions
diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 4afc6ef1a7..553bbe4825 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -22,6 +22,9 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix search-paths) + #:use-module ((guix build utils) + #:select ((package-name->name+version + . hyphen-separated-name->name+version))) #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) @@ -196,7 +199,7 @@ set up using CL source package conventions." (define base-arguments (if target-is-source? (strip-keyword-arguments - '(#:tests? #:asd-file #:lisp) + '(#:tests? #:asd-file #:lisp #:asd-system-name) (package-arguments pkg)) (package-arguments pkg))) @@ -262,6 +265,7 @@ set up using CL source package conventions." #:key source outputs (tests? #t) (asd-file #f) + (asd-system-name #f) (phases '(@ (guix build asdf-build-system) %standard-phases)) (search-paths '()) @@ -270,6 +274,13 @@ set up using CL source package conventions." (imported-modules %asdf-build-system-modules) (modules %asdf-build-modules)) + (define system-name + (or asd-system-name + (string-drop + ;; NAME is the value returned from `package-full-name'. + (hyphen-separated-name->name+version name) + (1+ (string-length lisp-type))))) ; drop the "<lisp>-" prefix. + (define builder `(begin (use-modules ,@modules) @@ -284,6 +295,7 @@ set up using CL source package conventions." ((source) source) (source source)) #:asd-file ,asd-file + #:asd-system-name ,system-name #:system ,system #:tests? ,tests? #:phases ,phases diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 4305a86af9..20116a4883 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -49,13 +49,6 @@ (define %system-install-prefix (string-append %source-install-prefix "/systems")) -(define (output-path->package-name path) - (package-name->name+version (strip-store-file-name path))) - -(define (outputs->name outputs) - (output-path->package-name - (assoc-ref outputs "out"))) - (define (lisp-source-directory output name) (string-append output (%lisp-source-install-prefix) "/" name)) @@ -101,31 +94,32 @@ valid." (define* (install #:key outputs #:allow-other-keys) "Copy and symlink all the source files." - (copy-files-to-output (assoc-ref outputs "out") (outputs->name outputs))) + (define output (assoc-ref outputs "out")) + (copy-files-to-output output + (package-name->name+version + (strip-store-file-name output)))) -(define* (copy-source #:key outputs #:allow-other-keys) +(define* (copy-source #:key outputs asd-system-name #:allow-other-keys) "Copy the source to the library output." (let* ((out (library-output outputs)) - (name (remove-lisp-from-name (output-path->package-name out))) (install-path (string-append out %source-install-prefix))) - (copy-files-to-output out name) + (copy-files-to-output out asd-system-name) ;; Hide the files from asdf (with-directory-excursion install-path (rename-file "source" (string-append (%lisp-type) "-source")) (delete-file-recursively "systems"))) #t) -(define* (build #:key outputs inputs asd-file +(define* (build #:key outputs inputs asd-file asd-system-name #:allow-other-keys) "Compile the system." (let* ((out (library-output outputs)) - (name (remove-lisp-from-name (output-path->package-name out))) - (source-path (lisp-source-directory out name)) + (source-path (lisp-source-directory out asd-system-name)) (translations (wrap-output-translations `(,(output-translation source-path out)))) (asd-file (and=> asd-file - (cut source-asd-file out name <>)))) + (cut source-asd-file out asd-system-name <>)))) (setenv "ASDF_OUTPUT_TRANSLATIONS" (replace-escaped-macros (format #f "~S" translations))) @@ -137,7 +131,7 @@ valid." (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache - (compile-system name asd-file) + (compile-system asd-system-name asd-file) ;; As above, ecl will sometimes create this even though it doesn't use it @@ -146,32 +140,31 @@ valid." (delete-file-recursively cache-directory)))) #t) -(define* (check #:key tests? outputs inputs asd-file +(define* (check #:key tests? outputs inputs asd-file asd-system-name #:allow-other-keys) "Test the system." - (let* ((name (remove-lisp-from-name (outputs->name outputs))) - (out (library-output outputs)) + (let* ((out (library-output outputs)) (asd-file (and=> asd-file - (cut source-asd-file out name <>)))) + (cut source-asd-file out asd-system-name <>)))) (if tests? - (test-system name asd-file) + (test-system asd-system-name asd-file) (format #t "test suite not run~%"))) #t) (define* (create-asd-file #:key outputs inputs asd-file + asd-system-name #:allow-other-keys) "Create a system definition file for the built system." (let*-values (((out) (library-output outputs)) - ((full-name version) (package-name->name+version - (strip-store-file-name out))) - ((name) (remove-lisp-from-name full-name)) + ((_ version) (package-name->name+version + (strip-store-file-name out))) ((new-asd-file) (string-append (library-directory out) - "/" name ".asd"))) + "/" asd-system-name ".asd"))) (make-asd-file new-asd-file - #:system name + #:system asd-system-name #:version version #:inputs inputs #:system-asd-file asd-file)) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 148357bf0e..2d730570a1 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -36,7 +36,6 @@ generate-executable-for-system %bundle-install-prefix bundle-asd-file - remove-lisp-from-name wrap-output-translations prepend-to-source-registry build-program @@ -66,9 +65,6 @@ (define (%bundle-install-prefix) (string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems")) -(define (remove-lisp-from-name name lisp) - (string-drop name (1+ (string-length lisp)))) - (define (inputs->asd-file-map inputs) "Produce a hash table of the form (system . asd-file), where system is the name of an ASD system, and asd-file is the full path to its definition." |