From 56c092ce94cee893898f71ce61e443dd121cccdb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 21 Jun 2013 00:25:54 +0200 Subject: [PATCH] build-system/gnu: Unify with (guix build-system gnu-cross-build). * guix/build/gnu-build-system.scm (set-paths): Add `native-inputs' and `native-search-paths' keyword parameters. Honor them. (configure): Add `target' and `native-inputs' keyword parameters. Look for Bash in NATIVE-INPUTS or INPUTS. Pass `--host' when TARGET is true. (strip): Add `strip-command' keyword parameter. Use it. * guix/build/gnu-cross-build.scm: Remove. * Makefile.am (MODULES): Adjust accordingly. * gnu/packages/acl.scm, gnu/packages/attr.scm, gnu/packages/base.scm, gnu/packages/bash.scm, gnu/packages/gawk.scm, gnu/packages/gettext.scm, gnu/packages/guile.scm, gnu/packages/libffi.scm, gnu/packages/libsigsegv.scm, gnu/packages/linux.scm, gnu/packages/ncurses.scm, gnu/packages/readline.scm, guix/build-system/gnu.scm: Replace `%standard-cross-phases' by `%standard-phases'. Remove references to (guix build gnu-cross-build). --- Makefile.am | 1 - gnu/packages/acl.scm | 2 +- gnu/packages/attr.scm | 2 +- gnu/packages/base.scm | 4 +- gnu/packages/bash.scm | 9 +-- gnu/packages/gawk.scm | 4 +- gnu/packages/gettext.scm | 2 +- gnu/packages/guile.scm | 4 +- gnu/packages/libffi.scm | 9 +-- gnu/packages/libsigsegv.scm | 4 +- gnu/packages/linux.scm | 10 +-- gnu/packages/ncurses.scm | 2 +- gnu/packages/readline.scm | 4 +- guix/build-system/gnu.scm | 6 +- guix/build/gnu-build-system.scm | 45 +++++++++-- guix/build/gnu-cross-build.scm | 138 -------------------------------- 16 files changed, 54 insertions(+), 192 deletions(-) delete mode 100644 guix/build/gnu-cross-build.scm diff --git a/Makefile.am b/Makefile.am index 418b63a377..9faa6544ea 100644 --- a/Makefile.am +++ b/Makefile.am @@ -59,7 +59,6 @@ MODULES = \ guix/build/download.scm \ guix/build/cmake-build-system.scm \ guix/build/gnu-build-system.scm \ - guix/build/gnu-cross-build.scm \ guix/build/perl-build-system.scm \ guix/build/python-build-system.scm \ guix/build/utils.scm \ diff --git a/gnu/packages/acl.scm b/gnu/packages/acl.scm index 54c9116baf..b7604dcea6 100644 --- a/gnu/packages/acl.scm +++ b/gnu/packages/acl.scm @@ -46,7 +46,7 @@ (lambda _ (patch-makefile-SHELL "include/buildmacros")) ,(if (%current-target-system) - '%standard-cross-phases + '%standard-phases '(alist-replace 'check (lambda _ (system* "make" "tests" "-C" "test") diff --git a/gnu/packages/attr.scm b/gnu/packages/attr.scm index 3fb15d235f..2ce50296ac 100644 --- a/gnu/packages/attr.scm +++ b/gnu/packages/attr.scm @@ -55,7 +55,7 @@ ;; When building natively, adjust the test cases. ,(if (%current-target-system) - '%standard-cross-phases + '%standard-phases '(alist-replace 'check (lambda _ ;; Use the right shell. diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index 85380549ff..95052775c5 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -293,9 +293,7 @@ The tools supplied with this package are: (substitute* (find-files "tests" "\\.sh$") (("#!/bin/sh") (format #f "#!~a/bin/bash" bash))))) - ,(if (%current-target-system) - '%standard-cross-phases - '%standard-phases)))) + %standard-phases))) (synopsis "Core GNU utilities (file, text, shell)") (description "The GNU Core Utilities are the basic file, shell and text manipulation diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm index bf51403f1a..aa3f397a52 100644 --- a/gnu/packages/bash.scm +++ b/gnu/packages/bash.scm @@ -82,9 +82,7 @@ #:phases (alist-cons-after 'install 'post-install ,post-install-phase - ,(if (%current-target-system) - '%standard-cross-phases - '%standard-phases)))) + %standard-phases))) (synopsis "The GNU Bourne-Again SHell") (description "Bash is the shell, or command language interpreter, that will appear in @@ -106,10 +104,7 @@ modification.") (let ((args `(#:modules ((guix build gnu-build-system) (guix build utils) (srfi srfi-1) - (srfi srfi-26) - ,@(if (%current-target-system) - '((guix build gnu-cross-build)) - '())) + (srfi srfi-26)) ,@(package-arguments bash)))) (substitute-keyword-arguments args ((#:configure-flags flags) diff --git a/gnu/packages/gawk.scm b/gnu/packages/gawk.scm index 444fa5e556..1b19f7bfd2 100644 --- a/gnu/packages/gawk.scm +++ b/gnu/packages/gawk.scm @@ -50,9 +50,7 @@ (substitute* "io.c" (("/bin/sh") (string-append bash "/bin/bash"))))) - ,(if (%current-target-system) - '%standard-cross-phases - '%standard-phases)))) + %standard-phases))) (inputs `(("libsigsegv" ,libsigsegv) ;; TODO: On next core-updates, make Bash input unconditional. diff --git a/gnu/packages/gettext.scm b/gnu/packages/gettext.scm index e22b1ba6ff..c838f9c0a6 100644 --- a/gnu/packages/gettext.scm +++ b/gnu/packages/gettext.scm @@ -39,7 +39,7 @@ (arguments `(#:patches (list (assoc-ref %build-inputs "patch/gets")) #:phases ,(if (%current-target-system) - '%standard-cross-phases + '%standard-phases '(alist-cons-before 'check 'patch-tests (lambda* (#:key inputs #:allow-other-keys) diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index b53f3eb770..c4eca3e350 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -158,9 +158,7 @@ extensible. It supports many SRFIs.") (substitute* "module/ice-9/popen.scm" (("/bin/sh") (string-append bash "/bin/bash"))))) - ,(if (%current-target-system) - '%standard-cross-phases - '%standard-phases)) + %standard-phases) ,@(if (%current-target-system) '(#:configure-flags '("CC_FOR_BUILD=gcc")) diff --git a/gnu/packages/libffi.scm b/gnu/packages/libffi.scm index f7d4a8c908..fdebab7433 100644 --- a/gnu/packages/libffi.scm +++ b/gnu/packages/libffi.scm @@ -49,15 +49,10 @@ "0ln4jbpb6clcsdpb9niqk0frgx4k0xki96wiv067ig0q4cajb7aq")))) (build-system gnu-build-system) (arguments `(#:modules ((guix build utils) (guix build gnu-build-system) - (ice-9 ftw) (srfi srfi-26) - ,@(if (%current-target-system) - '((guix build gnu-cross-build)) - '())) + (ice-9 ftw) (srfi srfi-26)) #:phases (alist-cons-after 'install 'post-install ,post-install-phase - ,(if (%current-target-system) - '%standard-cross-phases - '%standard-phases)))) + %standard-phases))) (synopsis "Foreign function call interface library") (description "The libffi library provides a portable, high level programming interface diff --git a/gnu/packages/libsigsegv.scm b/gnu/packages/libsigsegv.scm index 4689b3d8b5..62fb40737a 100644 --- a/gnu/packages/libsigsegv.scm +++ b/gnu/packages/libsigsegv.scm @@ -49,9 +49,7 @@ (lambda _ (substitute* "src/fault-linux-mips-old.h" (("#include ") ""))) - ,(if (%current-target-system) - '%standard-cross-phases - '%standard-phases))) + %standard-phases)) '())) (description "GNU libsigsegv is a library for handling page faults in user mode. A page diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 0bc9fbcb5e..dde53e9f5d 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -80,18 +80,12 @@ (arguments `(#:modules ((guix build gnu-build-system) (guix build utils) - (srfi srfi-1) - ,@(if (%current-target-system) - '((guix build gnu-cross-build)) - '())) + (srfi srfi-1)) #:phases (alist-replace 'build ,(build-phase (%current-system)) (alist-replace 'install ,install-phase - (alist-delete 'configure - ,(if (%current-target-system) - '%standard-cross-phases - '%standard-phases)))) + (alist-delete 'configure %standard-phases))) #:tests? #f)) (synopsis "GNU Linux-Libre kernel headers") (description "Headers of the Linux-Libre kernel.") diff --git a/gnu/packages/ncurses.scm b/gnu/packages/ncurses.scm index c1badae8a3..e5a9bce0f1 100644 --- a/gnu/packages/ncurses.scm +++ b/gnu/packages/ncurses.scm @@ -116,7 +116,7 @@ ,cross-pre-install-phase (alist-cons-after 'install 'post-install ,post-install-phase - %standard-cross-phases))) + %standard-phases))) `(alist-cons-after ; native build 'install 'post-install ,post-install-phase diff --git a/gnu/packages/readline.scm b/gnu/packages/readline.scm index 1fb4376971..8857666fcc 100644 --- a/gnu/packages/readline.scm +++ b/gnu/packages/readline.scm @@ -61,9 +61,7 @@ #:phases (alist-cons-after 'install 'post-install ,post-install-phase - ,(if (%current-target-system) - '%standard-cross-phases - '%standard-phases)))) + %standard-phases))) (synopsis "Edit command lines while typing, with history support") (description "The GNU Readline library provides a set of functions for use by diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 35590aa3da..b72239d13e 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -340,14 +340,12 @@ inputs." (strip-flags ''("--strip-debug")) (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) - (phases '%standard-cross-phases) + (phases '%standard-phases) (system (%current-system)) - (implicit-inputs? #t) ; useful when bootstrapping + (implicit-inputs? #t) (imported-modules '((guix build gnu-build-system) - (guix build gnu-cross-build) (guix build utils))) (modules '((guix build gnu-build-system) - (guix build gnu-cross-build) (guix build utils)))) "Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are cross-built inputs, and NATIVE-INPUTS are inputs that run on the build diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 47820aa02e..4245f2aefd 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -48,15 +48,28 @@ #f dir)) -(define* (set-paths #:key inputs (search-paths '()) +(define* (set-paths #:key target inputs native-inputs + (search-paths '()) (native-search-paths '()) #:allow-other-keys) (define input-directories (match inputs (((_ . dir) ...) dir))) + (define native-input-directories + (match native-inputs + (((_ . dir) ...) + dir) + (#f ; not cross compiling + '()))) + + ;; When cross building, $PATH must refer only to native (host) inputs since + ;; target inputs are not executable. (set-path-environment-variable "PATH" '("bin" "sbin") - input-directories) + (append native-input-directories + (if target + '() + input-directories))) (for-each (match-lambda ((env-var (directories ...) separator) @@ -65,6 +78,15 @@ #:separator separator))) search-paths) + (when native-search-paths + ;; Search paths for native inputs, when cross building. + (for-each (match-lambda + ((env-var (directories ...) separator) + (set-path-environment-variable env-var directories + native-input-directories + #:separator separator))) + native-search-paths)) + ;; Dump the environment variables as a shell script, for handy debugging. (system "export > environment-variables")) @@ -102,7 +124,8 @@ makefiles." (append patch-flags (list "--input" p))))) patches)) -(define* (configure #:key inputs outputs (configure-flags '()) out-of-source? +(define* (configure #:key target native-inputs inputs outputs + (configure-flags '()) out-of-source? #:allow-other-keys) (define (package-name) (let* ((out (assoc-ref outputs "out")) @@ -119,7 +142,7 @@ makefiles." (libdir (assoc-ref outputs "lib")) (includedir (assoc-ref outputs "include")) (docdir (assoc-ref outputs "doc")) - (bash (or (and=> (assoc-ref inputs "bash") + (bash (or (and=> (assoc-ref (or native-inputs inputs) "bash") (cut string-append <> "/bin/bash")) "/bin/sh")) (flags `(,(string-append "CONFIG_SHELL=" bash) @@ -148,6 +171,9 @@ makefiles." (list (string-append "--docdir=" docdir "/doc/" (package-name))) '()) + ,@(if target ; cross building + (list (string-append "--host=" target)) + '()) ,@configure-flags)) (abs-srcdir (getcwd)) (srcdir (if out-of-source? @@ -230,17 +256,20 @@ makefiles." bindirs))) #t) -(define* (strip #:key outputs (strip-binaries? #t) +(define* (strip #:key target outputs (strip-binaries? #t) + (strip-command (if target + (string-append target "-strip") + "strip")) (strip-flags '("--strip-debug")) (strip-directories '("lib" "lib64" "libexec" "bin" "sbin")) #:allow-other-keys) (define (strip-dir dir) - (format #t "stripping binaries in ~s with flags ~s~%" - dir strip-flags) + (format #t "stripping binaries in ~s with ~s and flags ~s~%" + dir strip-command strip-flags) (file-system-fold (const #t) (lambda (path stat result) ; leaf - (zero? (apply system* "strip" + (zero? (apply system* strip-command (append strip-flags (list path))))) (const #t) ; down (const #t) ; up diff --git a/guix/build/gnu-cross-build.scm b/guix/build/gnu-cross-build.scm deleted file mode 100644 index dab60684ac..0000000000 --- a/guix/build/gnu-cross-build.scm +++ /dev/null @@ -1,138 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès -;;; -;;; This file is part of GNU Guix. -;;; -;;; GNU Guix is free software; you can redistribute it and/or modify it -;;; under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or (at -;;; your option) any later version. -;;; -;;; GNU Guix is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Guix. If not, see . - -(define-module (guix build gnu-cross-build) - #:use-module (guix build utils) - #:use-module ((guix build gnu-build-system) - #:renamer (symbol-prefix-proc 'build:)) - #:use-module (ice-9 ftw) - #:use-module (ice-9 match) - #:use-module (srfi srfi-1) - #:export (%standard-cross-phases - gnu-cross-build)) - -;;; Commentary: -;;; -;;; Extension of `gnu-build-system.scm' to support cross-compilation. -;;; -;;; Code: - -(define* (set-paths #:key inputs native-inputs - (search-paths '()) (native-search-paths '()) - #:allow-other-keys) - (define input-directories - (match inputs - (((_ . dir) ...) - dir))) - - (define native-input-directories - (match native-inputs - (((_ . dir) ...) - dir))) - - ;; $PATH must refer only to native (host) inputs since target inputs are not - ;; executable. - (set-path-environment-variable "PATH" '("bin" "sbin") - native-input-directories) - - ;; Search paths for target inputs. - (for-each (match-lambda - ((env-var (directories ...) separator) - (set-path-environment-variable env-var directories - input-directories - #:separator separator))) - search-paths) - - ;; Search paths for native inputs. - (for-each (match-lambda - ((env-var (directories ...) separator) - (set-path-environment-variable env-var directories - native-input-directories - #:separator separator))) - native-search-paths) - - ;; Dump the environment variables as a shell script, for handy debugging. - (system "export > environment-variables")) - -(define* (configure #:key - inputs outputs (configure-flags '()) out-of-source? - target native-inputs - #:allow-other-keys) - (format #t "configuring for cross-compilation to `~a'~%" target) - (apply (assoc-ref build:%standard-phases 'configure) - #:configure-flags (cons (string-append "--host=" target) - configure-flags) - - ;; XXX: The underlying `configure' phase looks for Bash among - ;; #:inputs, so fool it this way. - #:inputs native-inputs - - #:outputs outputs - #:out-of-source? out-of-source? - '())) - -(define* (strip #:key target outputs (strip-binaries? #t) - (strip-flags '("--strip-debug")) - (strip-directories '("lib" "lib64" "libexec" - "bin" "sbin")) - #:allow-other-keys) - ;; TODO: The only difference with `strip' in gnu-build-system.scm is the - ;; name of the strip command; factorize it. - - (define (strip-dir dir) - (format #t "stripping binaries in ~s with flags ~s~%" - dir strip-flags) - (file-system-fold (const #t) - (lambda (path stat result) ; leaf - (zero? (apply system* - (string-append target "-strip") - (append strip-flags (list path))))) - (const #t) ; down - (const #t) ; up - (const #t) ; skip - (lambda (path stat errno result) - (format (current-error-port) - "strip: failed to access `~a': ~a~%" - path (strerror errno)) - #f) - #t - dir)) - - (or (not strip-binaries?) - (every strip-dir - (append-map (match-lambda - ((_ . dir) - (filter-map (lambda (d) - (let ((sub (string-append dir "/" d))) - (and (directory-exists? sub) sub))) - strip-directories))) - outputs)))) - -(define %standard-cross-phases - ;; The standard phases when cross-building. - (let ((replacements `((set-paths ,set-paths) - (configure ,configure) - (strip ,strip)))) - (fold (lambda (replacement phases) - (match replacement - ((name proc) - (alist-replace name proc phases)))) - (alist-delete 'check build:%standard-phases) - replacements))) - -;;; gnu-cross-build.scm ends here