From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:57830) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cv1dZ-00065z-65 for guix-patches@gnu.org; Mon, 03 Apr 2017 09:03:16 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cv1dS-00019E-TQ for guix-patches@gnu.org; Mon, 03 Apr 2017 09:03:13 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:60045) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cv1dS-000197-Py for guix-patches@gnu.org; Mon, 03 Apr 2017 09:03:06 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cv1dS-0007WV-Ic for guix-patches@gnu.org; Mon, 03 Apr 2017 09:03:06 -0400 Subject: bug#26346: [PATCH 11/17] build-system/asdf: Pass the system name as an argument to the builder. Resent-Message-ID: From: Andy Patterson Date: Mon, 3 Apr 2017 09:01:28 -0400 Message-Id: <20170403130134.18881-11-ajpatter@uwaterloo.ca> In-Reply-To: <20170403130134.18881-1-ajpatter@uwaterloo.ca> References: <20170403003732.1c3b8afb@uwaterloo.ca> <20170403130134.18881-1-ajpatter@uwaterloo.ca> In-Reply-To: <20170403003732.1c3b8afb@uwaterloo.ca> References: <20170403003732.1c3b8afb@uwaterloo.ca> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 26346@debbugs.gnu.org * guix/build-system/asdf.scm (asdf-build): Use the user-defined system name, or calculate it from the package's full name. [builder]: Pass the value along to the build procedure. (package-with-build-system): Remove #:asd-system-name from source packages' arguments. * guix/build/asdf-build-system.scm: Adjust accordingly. * guix/build/lisp-utils.scm (remove-lisp-from-name): Delete variable. --- guix/build-system/asdf.scm | 14 ++++++++++++- guix/build/asdf-build-system.scm | 44 ++++++++++++++++------------------------ guix/build/lisp-utils.scm | 4 ---- 3 files changed, 30 insertions(+), 32 deletions(-) diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 4afc6ef1a..ab571c9b4 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 "-" prefixa + (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 4305a86af..0fe01bd6b 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)) @@ -99,33 +92,31 @@ valid." (find-files target "\\.asd$")) #t)) -(define* (install #:key outputs #:allow-other-keys) +(define* (install #:key outputs asd-system-name #:allow-other-keys) "Copy and symlink all the source files." - (copy-files-to-output (assoc-ref outputs "out") (outputs->name outputs))) + (copy-files-to-output (assoc-ref outputs "out") asd-system-name)) -(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 +128,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 +137,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 148357bf0..2d730570a 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." -- 2.11.1