From 56c092ce94cee893898f71ce61e443dd121cccdb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Jun 2013 00:25:54 +0200 Subject: 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). --- guix/build/gnu-build-system.scm | 45 ++++++++++--- guix/build/gnu-cross-build.scm | 138 ---------------------------------------- 2 files changed, 37 insertions(+), 146 deletions(-) delete mode 100644 guix/build/gnu-cross-build.scm (limited to 'guix/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 @@ (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 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 -- cgit v1.2.3 From 4ca968eb954c0a8c166c8cd390024cdafdb9e416 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 21 Jun 2013 00:32:07 +0200 Subject: build-system/gnu: Save `environment-variables' after each phase. * guix/build/gnu-build-system.scm (set-paths): Move `system' call to... (gnu-build): ... here. --- guix/build/gnu-build-system.scm | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 4245f2aefd..8ccf27a1b1 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -87,8 +87,7 @@ (define native-input-directories #:separator separator))) native-search-paths)) - ;; Dump the environment variables as a shell script, for handy debugging. - (system "export > environment-variables")) + #t) (define* (unpack #:key source #:allow-other-keys) (and (zero? (system* "tar" "xvf" source)) @@ -316,10 +315,13 @@ (define* (gnu-build #:key (source #f) (outputs #f) (inputs #f) (every (match-lambda ((name . proc) (let ((start (gettimeofday))) - (format #t "starting phase `~a'~%" name) - (let ((result (apply proc args)) - (end (gettimeofday))) - (format #t "phase `~a' ~:[failed~;succeeded~] after ~a seconds~%" - name result (- (car end) (car start))) - result)))) + (format #t "starting phase `~a'~%" name) + (let ((result (apply proc args)) + (end (gettimeofday))) + (format #t "phase `~a' ~:[failed~;succeeded~] after ~a seconds~%" + name result (- (car end) (car start))) + + ;; Dump the environment variables as a shell script, for handy debugging. + (system "export > $NIX_BUILD_TOP/environment-variables") + result)))) phases)) -- cgit v1.2.3 From 2f41f51c401cc45842218a801891a71a64416ef0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Jun 2013 16:15:23 +0200 Subject: build-system/gnu: Set #:tests? to #f when cross-compiling. * guix/build/gnu-build-system.scm (check): Add `target' formal parameter. Change `tests?' to default to (not target). --- guix/build/gnu-build-system.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 8ccf27a1b1..bed498dfef 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -214,8 +214,8 @@ (define* (build #:key (make-flags '()) (parallel-build? #t) '()) ,@make-flags)))) -(define* (check #:key (make-flags '()) (tests? #t) (test-target "check") - (parallel-tests? #t) +(define* (check #:key target (make-flags '()) (tests? (not target)) + (test-target "check") (parallel-tests? #t) #:allow-other-keys) (if tests? (zero? (apply system* "make" test-target -- cgit v1.2.3 From b15669f37daecd9d06e0d4b3c864ecdbb81c9b9c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Jun 2013 16:42:46 +0200 Subject: utils: `set-path-environment-variable' calls `unsetenv' for empty values. * guix/build/utils.scm (set-path-environment-variable): When VALUE is the empty string, call `unsetenv' instead of `setenv'. * gnu/packages/guile.scm (guile-2.0)[arguments]: Remove `unsetenv' trick. --- gnu/packages/guile.scm | 11 ----------- guix/build/utils.scm | 14 +++++++++++--- 2 files changed, 11 insertions(+), 14 deletions(-) (limited to 'guix/build') diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index c4eca3e350..c78ab57915 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -142,17 +142,6 @@ (define-public guile-2.0 `(#:phases (alist-cons-before 'configure 'pre-configure (lambda* (#:key inputs #:allow-other-keys) - ;; By default we end up with GUILE_LOAD_PATH="" and - ;; GUILE_LOAD_COMPILED_PATH="". But that is equivalent to - ;; ".", and breaks the build system when cross-compiling. - ;; Thus, make sure they are unset. - ;; TODO: Eventually fix `set-path-environment-variable' - ;; for that case. - ,@(if (%current-target-system) - '((unsetenv "GUILE_LOAD_PATH") - (unsetenv "GUILE_LOAD_COMPILED_PATH")) - '()) - ;; Tell (ice-9 popen) the file name of Bash. (let ((bash (assoc-ref inputs "bash"))) (substitute* "module/ice-9/popen.scm" diff --git a/guix/build/utils.scm b/guix/build/utils.scm index a4a82a5f8c..c0b150e016 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -248,9 +248,17 @@ (define* (set-path-environment-variable env-var sub-directories input-dirs " (let* ((path (search-path-as-list sub-directories input-dirs)) (value (list->search-path-as-string path separator))) - (setenv env-var value) - (format #t "environment variable `~a' set to `~a'~%" - env-var value))) + (if (string-null? value) + (begin + ;; Never set ENV-VAR to an empty string because often, the empty + ;; string is equivalent to ".". This is the case for + ;; GUILE_LOAD_PATH in Guile 2.0, for instance. + (unsetenv env-var) + (format #t "environment variable `~a' unset~%" env-var)) + (begin + (setenv env-var value) + (format #t "environment variable `~a' set to `~a'~%" + env-var value))))) (define (which program) "Return the complete file name for PROGRAM as found in $PATH, or #f if -- cgit v1.2.3 From d475b25953012cacbc8c661884d7f89cd5e93b3d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 3 Jul 2013 23:08:41 +0200 Subject: utils: Re-export `alist-cons' and `alist-delete'. * guix/build/utils.scm: Re-export `alist-cons' and `alist-delete'. --- guix/build/utils.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'guix/build') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index c0b150e016..06e88b1ff8 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -27,6 +27,8 @@ (define-module (guix build utils) #:use-module (ice-9 rdelim) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) + #:re-export (alist-cons + alist-delete) #:export (directory-exists? executable-file? call-with-ascii-input-file -- cgit v1.2.3 From be58d01a7e60601eb7b00a5fd3b724fdafb8dd29 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 3 Jul 2013 23:53:31 +0200 Subject: build-system/gnu: Write debug files to the "debug" sub-derivation, if any. * guix/build/gnu-build-system.scm (strip): Add `objcopy-command' keyword parameter. [debug-output, debug-file-extension]: New variables. [debug-file, make-debug-file, add-debug-link]: New procedures. [strip-dir]: Use them. --- guix/build/gnu-build-system.scm | 53 +++++++++++++++++++++++++++++++++++++++-- 1 file changed, 51 insertions(+), 2 deletions(-) (limited to 'guix/build') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index bed498dfef..ebcb185e13 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -259,17 +259,66 @@ (define* (strip #:key target outputs (strip-binaries? #t) (strip-command (if target (string-append target "-strip") "strip")) + (objcopy-command (if target + (string-append target "-objcopy") + "objcopy")) (strip-flags '("--strip-debug")) (strip-directories '("lib" "lib64" "libexec" "bin" "sbin")) #:allow-other-keys) + (define debug-output + ;; If an output is called "debug", then that's where debugging information + ;; will be stored instead of being discarded. + (assoc-ref outputs "debug")) + + (define debug-file-extension + ;; File name extension for debugging information. + ".debug") + + (define (debug-file file) + ;; Return the name of the debug file for FILE, an absolute file name. + ;; Once installed in the user's profile, it is in $PROFILE/lib/debug/FILE, + ;; which is where GDB looks for it (info "(gdb) Separate Debug Files"). + (string-append debug-output "/lib/debug/" + file debug-file-extension)) + + (define (make-debug-file file) + ;; Create a file in DEBUG-OUTPUT containing the debugging info of FILE. + (let ((debug (debug-file file))) + (mkdir-p (dirname debug)) + (copy-file file debug) + (and (zero? (system* strip-command "--only-keep-debug" debug)) + (begin + (chmod debug #o400) + #t)))) + + (define (add-debug-link file) + ;; Add a debug link in FILE (info "(binutils) strip"). + + ;; `objcopy --add-gnu-debuglink' wants to have the target of the debug + ;; link around so it can compute a CRC of that file (see the + ;; `bfd_fill_in_gnu_debuglink_section' function.) No reference to + ;; DEBUG-OUTPUT is kept because bfd keeps only the basename of the debug + ;; file. + (zero? (system* objcopy-command + (string-append "--add-gnu-debuglink=" + (debug-file file)) + file))) + (define (strip-dir dir) (format #t "stripping binaries in ~s with ~s and flags ~s~%" dir strip-command strip-flags) + (when debug-output + (format #t "debugging output written to ~s using ~s~%" + debug-output objcopy-command)) (file-system-fold (const #t) (lambda (path stat result) ; leaf - (zero? (apply system* strip-command - (append strip-flags (list path))))) + (and (or (not debug-output) + (make-debug-file path)) + (zero? (apply system* strip-command + (append strip-flags (list path)))) + (or (not debug-output) + (add-debug-link path)))) (const #t) ; down (const #t) ; up (const #t) ; skip -- cgit v1.2.3