aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Patterson <ajpatter@uwaterloo.ca>2017-04-03 09:01:30 -0400
committerRicardo Wurmus <rekado@elephly.net>2017-05-16 15:18:15 +0200
commit40f56176c517d9b5e0d3da8cc06d3ccde6b58cc2 (patch)
treebeec782a0abf0c60351d8e4596c573f4450494bc
parent0186a463d0f352eef485326cf57619d23a26734e (diff)
downloadguix-40f56176c517d9b5e0d3da8cc06d3ccde6b58cc2.tar
guix-40f56176c517d9b5e0d3da8cc06d3ccde6b58cc2.tar.gz
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.
-rw-r--r--guix/build/asdf-build-system.scm6
-rw-r--r--guix/build/lisp-utils.scm36
2 files changed, 28 insertions, 14 deletions
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index 4f3fc162ff..fd4d84dfa0 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -153,8 +153,10 @@ valid."
(let*-values (((out) (library-output outputs))
((_ version) (package-name->name+version
(strip-store-file-name out)))
- ((new-asd-file) (string-append (library-directory out)
- "/" asd-system-name ".asd")))
+ ((new-asd-file) (string-append
+ (library-directory out)
+ "/" (normalize-string asd-system-name)
+ ".asd")))
(make-asd-file new-asd-file
#:system asd-system-name
diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 3f7a6f77c1..c48f51c982 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -40,7 +40,9 @@
prepend-to-source-registry
build-program
build-image
- make-asd-file))
+ make-asd-file
+ valid-char-set
+ normalize-string))
;;; Commentary:
;;;
@@ -65,6 +67,15 @@
(define (%bundle-install-prefix)
(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)
"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."
@@ -161,14 +172,15 @@ asdf:system-depends-on. First load the system's ASD-FILE."
(delete-file deps-file)))))
(define (compiled-system system)
- (match (%lisp-type)
- ("sbcl" (string-append system "--system"))
- (_ system)))
+ (let ((system (basename system))) ; this is how asdf handles slashes
+ (match (%lisp-type)
+ ("sbcl" (string-append system "--system"))
+ (_ system))))
(define* (generate-system-definition system
#:key version dependencies)
`(asdf:defsystem
- ,system
+ ,(normalize-string system)
:class asdf/bundle:prebuilt-system
:version ,version
: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
system to find its dependencies, as described by GENERATE-DEPENDENCY-LINKS."
(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
(inputs->asd-file-map inputs))
(define registry
(filter-map hash-get-handle
- (make-list (if (eq? 'NIL dependencies)
- 0
- (length dependencies))
+ (make-list (length dependencies)
lisp-input-map)
- (if (eq? 'NIL dependencies)
- '()
- dependencies)))
+ dependencies))
(call-with-output-file asd-file
(lambda (port)