ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

build-system/gnu: Unify with (guix build-system gnu-cross-build).

Browse source 
* 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).
This commit is contained in:
Ludovic Courtès 2013-06-21 00:25:54 +02:00
parent d501fad11c
commit 56c092ce94
16 changed files with 54 additions and 192 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Makefile.am
View file

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

2
gnu/packages/acl.scm
View file

@ -46,7 +46,7 @@ (define-public acl
(lambda _
(patch-makefile-SHELL "include/buildmacros"))
,(if (%current-target-system)
'%standard-cross-phases
'%standard-phases
'(alist-replace 'check
(lambda _
(system* "make" "tests" "-C" "test")

2
gnu/packages/attr.scm
View file

@ -55,7 +55,7 @@ (define-public attr
;; When building natively, adjust the test cases.
,(if (%current-target-system)
'%standard-cross-phases
'%standard-phases
'(alist-replace 'check
(lambda _
;; Use the right shell.

4
gnu/packages/base.scm
View file

@ -293,9 +293,7 @@ (define-public coreutils
(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

9
gnu/packages/bash.scm
View file

@ -82,9 +82,7 @@ (define-public bash
#: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 @@ (define-public bash-light
(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)

4
gnu/packages/gawk.scm
View file

@ -50,9 +50,7 @@ (define-public gawk
(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.

2
gnu/packages/gettext.scm
View file

@ -39,7 +39,7 @@ (define-public gettext
(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)

4
gnu/packages/guile.scm
View file

@ -158,9 +158,7 @@ (define-public guile-2.0
(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"))

9
gnu/packages/libffi.scm
View file

@ -49,15 +49,10 @@ (define out (assoc-ref outputs "out"))
"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

4
gnu/packages/libsigsegv.scm
View file

@ -49,9 +49,7 @@ (define-public libsigsegv
(lambda _
(substitute* "src/fault-linux-mips-old.h"
(("#include <asm/sigcontext\\.h>") "")))
,(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

10
gnu/packages/linux.scm
View file

@ -80,18 +80,12 @@ (define-public linux-libre-headers
(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.")

2
gnu/packages/ncurses.scm
View file

@ -116,7 +116,7 @@ (define lib.so
,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

4
gnu/packages/readline.scm
View file

@ -61,9 +61,7 @@ (define-public readline
#: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

6
guix/build-system/gnu.scm
View file

@ -340,14 +340,12 @@ (define* (gnu-cross-build store name target source inputs native-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

45
guix/build/gnu-build-system.scm
View file

@ -48,15 +48,28 @@ (define (first-subdirectory dir)
#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 @@ (define input-directories
#: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 @@ (define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
(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 @@ (define (package-name)
(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 @@ (define (package-name)
(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 @@ (define bindirs
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

138
guix/build/gnu-cross-build.scm
View file

@ -1,138 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(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