From c8a3dea847bb9f87fa1876d0c6c3356d6226f121 Mon Sep 17 00:00:00 2001 From: Leo Famulari Date: Thu, 30 Mar 2017 03:10:48 -0400 Subject: packages: Enable threaded compression of source tarballs. This provides a ~2x speedup when using 4 threads. * guix/packages.scm (patch-and-repack)[build]: Invoke xz with '--threads=0' when re-packing tarballs. --- guix/packages.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 61171b8342..29351ace1d 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -576,7 +576,12 @@ (define (first-file directory) #:fail-on-error? #t))))) (zero? (apply system* (string-append #+tar "/bin/tar") - "cvfa" #$output + "cvf" #$output + ;; The bootstrap xz does not support + ;; threaded compression (introduced in + ;; 5.2.0), but it ignores the extra flag. + (string-append "--use-compress-program=" + #+xz "/bin/xz --threads=0") ;; avoid non-determinism in the archive "--mtime=@0" "--owner=root:0" -- cgit v1.2.3 From 8b14773ab6cafbd138e0c6cbfd2fc48818e2e0b5 Mon Sep 17 00:00:00 2001 From: Sergei Trofimovich Date: Sat, 13 May 2017 22:08:27 +0100 Subject: utils: Re-export 'delete'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/utils.scm: Reexport 'delete' binding. Co-authored-by: Ludovic Courtès --- guix/build/utils.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index e8efb0653a..6d3c29d001 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -32,7 +32,12 @@ (define-module (guix build utils) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:re-export (alist-cons - alist-delete) + alist-delete + + ;; Note: Re-export 'delete' to allow for proper syntax matching + ;; in 'modify-phases' forms. See + ;; . + delete) #:export (%store-directory store-file-name? strip-store-file-name -- cgit v1.2.3 From d2ac5e297578dea1c872f77a26ef4d481d5dc7bd Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 25 May 2017 22:59:00 +0200 Subject: build-system/cmake: Add support for cross compilation. Fixes . * guix/build-system/gnu.scm: Export standard-cross-packages. * guix/build-system/cmake.scm (cmake-cross-build): New procedure. (lower): Add support for cross-builds. * guix/build/cmake-build-system.scm (configure): Handle "target" argument. --- guix/build-system/cmake.scm | 160 +++++++++++++++++++++++++++++++++----- guix/build-system/gnu.scm | 1 + guix/build/cmake-build-system.scm | 11 ++- 3 files changed, 153 insertions(+), 19 deletions(-) (limited to 'guix') diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 25ac262d5d..ee116c5a4c 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Cyril Roelandt +;;; Copyright © 2017 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -56,24 +57,38 @@ (define* (lower name #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:cmake #:inputs #:native-inputs)) - - (and (not target) ;XXX: no cross-compilation - (bag - (name name) - (system system) - (host-inputs `(,@(if source - `(("source" ,source)) - '()) - ,@inputs - - ;; Keep the standard inputs of 'gnu-build-system'. - ,@(standard-packages))) - (build-inputs `(("cmake" ,cmake) - ,@native-inputs)) - (outputs outputs) - (build cmake-build) - (arguments (strip-keyword-arguments private-keywords arguments))))) + `(#:source #:cmake #:inputs #:native-inputs #:outputs + ,@(if target '() '(#:target)))) + + (bag + (name name) + (system system) + (target target) + (build-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@`(("cmake" ,cmake)) + ,@native-inputs + ,@(if target + ;; Use the standard cross inputs of + ;; 'gnu-build-system'. + (standard-cross-packages target 'host) + '()) + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (host-inputs inputs) + + ;; The cross-libc is really a target package, but for bootstrapping + ;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a + ;; native package, so it would end up using a "native" variant of + ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages + ;; would use a target variant (built with 'gnu-cross-build'.) + (target-inputs (if target + (standard-cross-packages target 'target) + '())) + (outputs outputs) + (build (if target cmake-cross-build cmake-build)) + (arguments (strip-keyword-arguments private-keywords arguments)))) (define* (cmake-build store name inputs #:key (guile #f) @@ -145,6 +160,115 @@ (define guile-for-build #:outputs outputs #:guile-for-build guile-for-build)) + +;;; +;;; Cross-compilation. +;;; + +(define* (cmake-cross-build store name + #:key + target native-drvs target-drvs + (guile #f) + (outputs '("out")) + (configure-flags ''()) + (search-paths '()) + (native-search-paths '()) + (make-flags ''()) + (out-of-source? #t) + (build-type "RelWithDebInfo") + (tests? #f) ; nothing can be done + (test-target "test") + (parallel-build? #t) (parallel-tests? #f) + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug" + "--enable-deterministic-archives")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '(@ (guix build cmake-build-system) + %standard-phases)) + (system (%current-system)) + (build (nix-system->gnu-triplet system)) + (imported-modules %cmake-build-system-modules) + (modules '((guix build cmake-build-system) + (guix build utils)))) + "Cross-build NAME using CMAKE for TARGET, where TARGET is a GNU triplet and +with INPUTS. This assumes that SOURCE provides a 'CMakeLists.txt' file as its +build system." + (define builder + `(begin + (use-modules ,@modules) + (let () + (define %build-host-inputs + ',(map (match-lambda + ((name (? derivation? drv) sub ...) + `(,name . ,(apply derivation->output-path drv sub))) + ((name path) + `(,name . ,path))) + native-drvs)) + + (define %build-target-inputs + ',(map (match-lambda + ((name (? derivation? drv) sub ...) + `(,name . ,(apply derivation->output-path drv sub))) + ((name (? package? pkg) sub ...) + (let ((drv (package-cross-derivation store pkg + target system))) + `(,name . ,(apply derivation->output-path drv sub)))) + ((name path) + `(,name . ,path))) + target-drvs)) + + (cmake-build #:source ,(match (assoc-ref native-drvs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:system ,system + #:build ,build + #:target ,target + #:outputs %outputs + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:native-search-paths ',(map + search-path-specification->sexp + native-search-paths) + #:phases ,phases + #:configure-flags ,configure-flags + #:make-flags ,make-flags + #:out-of-source? ,out-of-source? + #:build-type ,build-type + #:tests? ,tests? + #:test-target ,test-target + #:parallel-build? ,parallel-build? + #:parallel-tests? ,parallel-tests? + #:validate-runpath? ,validate-runpath? + #:patch-shebangs? ,patch-shebangs? + #:strip-binaries? ,strip-binaries? + #:strip-flags ,strip-flags + #:strip-directories ,strip-directories)))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:system system + #:inputs (append native-drvs target-drvs) + #:outputs outputs + #:modules imported-modules + #:guile-for-build guile-for-build)) + (define cmake-build-system (build-system (name 'cmake) diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 7cf0cafc0f..047ace7e6b 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -30,6 +30,7 @@ (define-module (guix build-system gnu) gnu-build gnu-build-system standard-packages + standard-cross-packages package-with-explicit-inputs package-with-extra-configure-variable static-libgcc-package diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm index 27f2b5c872..128ab28fe5 100644 --- a/guix/build/cmake-build-system.scm +++ b/guix/build/cmake-build-system.scm @@ -32,7 +32,7 @@ (define-module (guix build cmake-build-system) ;; Code: (define* (configure #:key outputs (configure-flags '()) (out-of-source? #t) - build-type + build-type target #:allow-other-keys) "Configure the given package." (let* ((out (assoc-ref outputs "out")) @@ -59,6 +59,15 @@ (define* (configure #:key outputs (configure-flags '()) (out-of-source? #t) ,(string-append "-DCMAKE_INSTALL_RPATH=" out "/lib") ;; enable verbose output from builds "-DCMAKE_VERBOSE_MAKEFILE=ON" + + ;; Cross-build + ,@(if target + (list (string-append "-DCMAKE_C_COMPILER=" + target "-gcc") + (if (string-contains target "mingw") + "-DCMAKE_SYSTEM_NAME=Windows" + "-DCMAKE_SYSTEM_NAME=Linux")) + '()) ,@configure-flags))) (format #t "running 'cmake' with arguments ~s~%" args) (zero? (apply system* "cmake" args))))) -- cgit v1.2.3 From facac292808d11d5e6ea528cc7dbe93595f62c9b Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 25 Apr 2017 01:46:05 +0900 Subject: build-system/gnu: 'compress-documentation' phase handles double symlinks. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The compress-documentation phase was breaking recursive symbolic links used for manuals, which was made visible by the `find-files' call in the recently added `manual-database' profile hook. See . * guix/build/gnu-build-system.scm (compress-documentation) [points-to-symbolic-link?]: New procedure. [maybe-compress-directory]: Use `points-to-symbolic-link?' to filter out symbolic links that shouldn't be retargetted, and re-order the calls to `retarget-symlink' and `documentation-compressor'. Co-authored-by: Ludovic Courtès --- guix/build/gnu-build-system.scm | 36 ++++++++++++++++++++++++++++++------ 1 file changed, 30 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 1786e2e3c9..09f272edee 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -521,6 +521,25 @@ (define (has-links? file) ;; Return #t if FILE has hard links. (> (stat:nlink (lstat file)) 1)) + (define (points-to-symlink? symlink) + ;; Return #t if SYMLINK points to another symbolic link. + (let* ((target (readlink symlink)) + (target-absolute (if (string-prefix? "/" target) + target + (string-append (dirname symlink) + "/" target)))) + (catch 'system-error + (lambda () + (symbolic-link? target-absolute)) + (lambda args + (if (= ENOENT (system-error-errno args)) + (begin + (format (current-error-port) + "The symbolic link '~a' target is missing: '~a'\n" + symlink target-absolute) + #f) + (apply throw args)))))) + (define (maybe-compress-directory directory regexp) (or (not (directory-exists? directory)) (match (find-files directory regexp) @@ -538,12 +557,17 @@ (define (maybe-compress-directory directory regexp) ;; Compress the non-symlink files, and adjust symlinks to refer ;; to the compressed files. Leave files that have hard links ;; unchanged ('gzip' would refuse to compress them anyway.) - (and (zero? (apply system* documentation-compressor - (append documentation-compressor-flags - (remove has-links? regular-files)))) - (every retarget-symlink - (filter (cut string-match regexp <>) - symlinks))))))))) + ;; Also, do not retarget symbolic links pointing to other + ;; symbolic links, since these are not compressed. + (and (every retarget-symlink + (filter (lambda (symlink) + (and (not (points-to-symlink? symlink)) + (string-match regexp symlink))) + symlinks)) + (zero? + (apply system* documentation-compressor + (append documentation-compressor-flags + (remove has-links? regular-files))))))))))) (define (maybe-compress output) (and (maybe-compress-directory (string-append output "/share/man") -- cgit v1.2.3 From 3f65c190d23296e7e718c3deff413e8beb61d8ba Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Thu, 1 Jun 2017 19:04:10 +0200 Subject: utils: Add helper for invoking programs. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/utils.scm (invoke): New variable. Co-authored-by: Ludovic Courtès --- guix/build/utils.scm | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 6d3c29d001..7391307c87 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -84,6 +84,7 @@ (define-module (guix build utils) fold-port-matches remove-store-references wrap-program + invoke locale-category->string)) @@ -579,6 +580,15 @@ (define-syntax %modify-phases ((_ phases (add-after old-phase-name new-phase-name new-phase)) (alist-cons-after old-phase-name new-phase-name new-phase phases)))) +(define (invoke program . args) + "Invoke PROGRAM with the given ARGS. Raise an error if the exit +code is non-zero; otherwise return #t." + (let ((status (apply system* program args))) + (unless (zero? status) + (error (format #f "program ~s exited with non-zero code" program) + status)) + #t)) + ;;; ;;; Text substitution (aka. sed). -- cgit v1.2.3 From 2ac6998063c311799cefb8edbc5b0158230d3877 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 11 Jun 2017 22:50:43 +0200 Subject: build-system/gnu: Work around 'time-monotonic' bug in Guile 2.2.2. Fixes . Reported by Leo Famulari . * guix/build/gnu-build-system.scm (time-monotonic) [guile-2.2]: Define. --- guix/build/gnu-build-system.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 09f272edee..e37b751403 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -39,6 +39,13 @@ (define-module (guix build gnu-build-system) ;; ;; Code: +(cond-expand + (guile-2.2 + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. + (define time-monotonic time-tai)) + (else #t)) + (define* (set-SOURCE-DATE-EPOCH #:rest _) "Set the 'SOURCE_DATE_EPOCH' environment variable. This is used by tools that incorporate timestamps as a way to tell them to use a fixed timestamp. -- cgit v1.2.3 From ef03d8dc3724caf59c7ea4a551084ddc601e4597 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Jul 2017 15:29:45 +0200 Subject: syscalls: Delay resolution of "scm_set_automatic_finalization_enabled". * guix/build/syscalls.scm (%set-automatic-finalization-enabled?!) [guile-2.2]: Wrap in 'delay'. --- guix/build/syscalls.scm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 549612fa3c..41208e32a8 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -725,15 +725,19 @@ (define CLONE_NEWNET #x40000000) (cond-expand (guile-2.2 (define %set-automatic-finalization-enabled?! - (let ((proc (pointer->procedure int - (dynamic-func - "scm_set_automatic_finalization_enabled" - (dynamic-link)) - (list int)))) + ;; When using a statically-linked Guile, for instance in the initrd, we + ;; cannot resolve this symbol, but most of the time we don't need it + ;; anyway. Thus, delay it. + (let ((proc (delay + (pointer->procedure int + (dynamic-func + "scm_set_automatic_finalization_enabled" + (dynamic-link)) + (list int))))) (lambda (enabled?) "Switch on or off automatic finalization in a separate thread. Turning finalization off shuts down the finalization thread as a side effect." - (->bool (proc (if enabled? 1 0)))))) + (->bool ((force proc) (if enabled? 1 0)))))) (define-syntax-rule (without-automatic-finalization exp) "Turn off automatic finalization within the dynamic extent of EXP." -- cgit v1.2.3 From 32b7506c987d8b7281382da4831958a64c048fc1 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Tue, 8 Aug 2017 16:05:58 +0200 Subject: profiles: Only check file contents if the file exists. * guix/profiles.scm (fonts-dir-file): Check that files exist before using "empty-file?". --- guix/profiles.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index b3732f61ed..0eb99f40de 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1095,9 +1095,11 @@ (define build (unless (and (zero? (system* mkfontscale)) (zero? (system* mkfontdir))) (exit #f)) - (when (empty-file? fonts-scale-file) + (when (and (file-exists? fonts-scale-file) + (empty-file? fonts-scale-file)) (delete-file fonts-scale-file)) - (when (empty-file? fonts-dir-file) + (when (and (file-exists? fonts-dir-file) + (empty-file? fonts-dir-file)) (delete-file fonts-dir-file)))) directories))))))) -- cgit v1.2.3 From e4925e00ca420737556e2039b4fa1c40121ee567 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 24 Aug 2017 00:41:44 +0200 Subject: packages: Use Guile 2.0 for grafting. Works around . Reported by Marius Bakke . * guix/packages.scm (guile-2.0): New procedure. (package-derivation, package-cross-derivation): Use it when computing the #:guile argument to 'graft-derivation'. --- guix/packages.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 3528db442f..f619d9b370 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -414,6 +414,13 @@ (define (default-guile) (let ((distro (resolve-interface '(gnu packages commencement)))) (module-ref distro 'guile-final))) +(define (guile-2.0) + "Return Guile 2.0." + ;; FIXME: This is used as a workaround for when + ;; grafting packages. + (let ((distro (resolve-interface '(gnu packages guile)))) + (module-ref distro 'guile-2.0))) + (define* (default-guile-derivation #:optional (system (%current-system))) "Return the derivation for SYSTEM of the default Guile package used to run the build code of derivation." @@ -1145,7 +1152,7 @@ (define* (package-derivation store package (() drv) (grafts - (let ((guile (package-derivation store (default-guile) + (let ((guile (package-derivation store (guile-2.0) system #:graft? #f))) ;; TODO: As an optimization, we can simply graft the tip ;; of the derivation graph since 'graft-derivation' @@ -1171,7 +1178,7 @@ (define* (package-cross-derivation store package target (graft-derivation store drv grafts #:system system #:guile - (package-derivation store (default-guile) + (package-derivation store (guile-2.0) system #:graft? #f)))) drv)))) -- cgit v1.2.3 From 05e172ca4e89d39b4e67d7bc728a3f40876f8f5d Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 25 Aug 2017 01:53:51 -0400 Subject: download: Remove a SourceForge mirror that never returns 404. * guix/download.scm (%mirrors)[sourceforge]: Remove nbtelecom.dl.sourceforge.net, which never returns 404 responses. This causes download failures due to hash mismatch, effectively preventing secondary source URLs from being queried. --- guix/download.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index bf818e3cdf..ae381ee7ab 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -115,7 +115,7 @@ (define %mirrors "http://jaist.dl.sourceforge.net/project/" "http://kent.dl.sourceforge.net/project/" "http://liquidtelecom.dl.sourceforge.net/project/" - "http://nbtelecom.dl.sourceforge.net/project/" + ;; "http://nbtelecom.dl.sourceforge.net/project/" ;never returns 404s "http://nchc.dl.sourceforge.net/project/" "http://ncu.dl.sourceforge.net/project/" "http://netcologne.dl.sourceforge.net/project/" -- cgit v1.2.3