From 40f56176c517d9b5e0d3da8cc06d3ccde6b58cc2 Mon Sep 17 00:00:00 2001 From: Andy Patterson Date: Mon, 3 Apr 2017 09:01:30 -0400 Subject: 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. --- guix/build/lisp-utils.scm | 36 ++++++++++++++++++++++++------------ 1 file changed, 24 insertions(+), 12 deletions(-) (limited to 'guix/build/lisp-utils.scm') 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) -- cgit v1.2.3