build-system/asdf: Handle unusually-named systems.
* guix/build/lisp-utils.scm (valid-char-set): New variable. (normalize-string): New procedure. (compiled-system): Truncate the name of a system which contains slashes. (generate-system-definition, make-asd-file): Use `normalize-string' to alter the names of the created system and its dependencies. * guix/build/asdf-build-system.scm (create-asd-file): Normalize the name of the asd file being created.
This commit is contained in:
parent
0186a463d0
commit
40f56176c5
|
@ -153,8 +153,10 @@ valid."
|
||||||
(let*-values (((out) (library-output outputs))
|
(let*-values (((out) (library-output outputs))
|
||||||
((_ version) (package-name->name+version
|
((_ version) (package-name->name+version
|
||||||
(strip-store-file-name out)))
|
(strip-store-file-name out)))
|
||||||
((new-asd-file) (string-append (library-directory out)
|
((new-asd-file) (string-append
|
||||||
"/" asd-system-name ".asd")))
|
(library-directory out)
|
||||||
|
"/" (normalize-string asd-system-name)
|
||||||
|
".asd")))
|
||||||
|
|
||||||
(make-asd-file new-asd-file
|
(make-asd-file new-asd-file
|
||||||
#:system asd-system-name
|
#:system asd-system-name
|
||||||
|
|
|
@ -40,7 +40,9 @@
|
||||||
prepend-to-source-registry
|
prepend-to-source-registry
|
||||||
build-program
|
build-program
|
||||||
build-image
|
build-image
|
||||||
make-asd-file))
|
make-asd-file
|
||||||
|
valid-char-set
|
||||||
|
normalize-string))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -65,6 +67,15 @@
|
||||||
(define (%bundle-install-prefix)
|
(define (%bundle-install-prefix)
|
||||||
(string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems"))
|
(string-append %source-install-prefix "/" (%lisp-type) "-bundle-systems"))
|
||||||
|
|
||||||
|
;; See nix/libstore/store-api.cc#checkStoreName.
|
||||||
|
(define valid-char-set
|
||||||
|
(string->char-set
|
||||||
|
"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?="))
|
||||||
|
|
||||||
|
(define (normalize-string str)
|
||||||
|
"Replace invalid characters in STR with a hyphen."
|
||||||
|
(string-join (string-tokenize str valid-char-set) "-"))
|
||||||
|
|
||||||
(define (inputs->asd-file-map inputs)
|
(define (inputs->asd-file-map inputs)
|
||||||
"Produce a hash table of the form (system . asd-file), where system is the
|
"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."
|
name of an ASD system, and asd-file is the full path to its definition."
|
||||||
|
@ -161,14 +172,15 @@ asdf:system-depends-on. First load the system's ASD-FILE."
|
||||||
(delete-file deps-file)))))
|
(delete-file deps-file)))))
|
||||||
|
|
||||||
(define (compiled-system system)
|
(define (compiled-system system)
|
||||||
|
(let ((system (basename system))) ; this is how asdf handles slashes
|
||||||
(match (%lisp-type)
|
(match (%lisp-type)
|
||||||
("sbcl" (string-append system "--system"))
|
("sbcl" (string-append system "--system"))
|
||||||
(_ system)))
|
(_ system))))
|
||||||
|
|
||||||
(define* (generate-system-definition system
|
(define* (generate-system-definition system
|
||||||
#:key version dependencies)
|
#:key version dependencies)
|
||||||
`(asdf:defsystem
|
`(asdf:defsystem
|
||||||
,system
|
,(normalize-string system)
|
||||||
:class asdf/bundle:prebuilt-system
|
:class asdf/bundle:prebuilt-system
|
||||||
:version ,version
|
:version ,version
|
||||||
:depends-on ,dependencies
|
:depends-on ,dependencies
|
||||||
|
@ -261,20 +273,20 @@ to locate its dependent systems."
|
||||||
"Create an ASD-FILE for SYSTEM@VERSION, appending a program to allow the
|
"Create an ASD-FILE for SYSTEM@VERSION, appending a program to allow the
|
||||||
system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
|
system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
|
||||||
(define dependencies
|
(define dependencies
|
||||||
(system-dependencies system system-asd-file))
|
(let ((deps
|
||||||
|
(system-dependencies system system-asd-file)))
|
||||||
|
(if (eq? 'NIL deps)
|
||||||
|
'()
|
||||||
|
(map normalize-string deps))))
|
||||||
|
|
||||||
(define lisp-input-map
|
(define lisp-input-map
|
||||||
(inputs->asd-file-map inputs))
|
(inputs->asd-file-map inputs))
|
||||||
|
|
||||||
(define registry
|
(define registry
|
||||||
(filter-map hash-get-handle
|
(filter-map hash-get-handle
|
||||||
(make-list (if (eq? 'NIL dependencies)
|
(make-list (length dependencies)
|
||||||
0
|
|
||||||
(length dependencies))
|
|
||||||
lisp-input-map)
|
lisp-input-map)
|
||||||
(if (eq? 'NIL dependencies)
|
dependencies))
|
||||||
'()
|
|
||||||
dependencies)))
|
|
||||||
|
|
||||||
(call-with-output-file asd-file
|
(call-with-output-file asd-file
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
|
|
Loading…
Reference in New Issue