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:
Andy Patterson 2017-04-03 09:01:30 -04:00 committed by Ricardo Wurmus
parent 0186a463d0
commit 40f56176c5
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
2 changed files with 28 additions and 14 deletions

View File

@ -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

View File

@ -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)
(match (%lisp-type) (let ((system (basename system))) ; this is how asdf handles slashes
("sbcl" (string-append system "--system")) (match (%lisp-type)
(_ system))) ("sbcl" (string-append 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)