From d5b3de6af276c1ade22a946b16d36b6077a06ab8 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Wed, 4 Feb 2015 09:48:39 -0600 Subject: utils: Strip duplicates from search path. * guix/build/utils.scm (search-path-as-list): Delete duplicate input directories before searching. --- guix/build/utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 4407f9af23..c7fdd1d553 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -323,7 +323,7 @@ for under the directories designated by FILES. For example: (list file) '()))))) files)) - input-dirs)) + (delete-duplicates input-dirs))) (define (list->search-path-as-string lst separator) (string-join lst separator)) -- cgit v1.2.3 From b01f89675d03202851a00c38d4995424bbb1879f Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 15 Feb 2015 17:14:53 +0100 Subject: utils: Use $0 instead of absolute path to original program in 'wrap-program'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/utils.scm (wrap-program): Create scripts that use $0 (which is usually just the base name) instead of the absolute path to the original program. Alternative implementation of 2ed11b3. Co-authored-by: Ludovic Courtès Closes . --- guix/build/utils.scm | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index c7fdd1d553..a3446cb617 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -816,7 +816,7 @@ contents: #!location/of/bin/bash export PATH=\"/gnu/.../bar/bin\" export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/gnu/.../baz/certs:/qux/certs\" - exec -a location/of/foo location/of/.foo-real \"$@\" + exec -a $0 location/of/.foo-real \"$@\" This is useful for scripts that expect particular programs to be in $PATH, for programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or @@ -870,11 +870,10 @@ the previous wrapper." (with-output-to-file prog-tmp (lambda () (format #t - "#!~a~%~a~%exec -a \"~a\" \"~a\" \"$@\"~%" + "#!~a~%~a~%exec -a \"$0\" \"~a\" \"$@\"~%" (which "bash") (string-join (map export-variable vars) "\n") - (canonicalize-path prog) (canonicalize-path target)))) (chmod prog-tmp #o755) -- cgit v1.2.3 From da466f7ff63e34aca271e603090f25ba471f009e Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 15 Feb 2015 17:40:17 +0100 Subject: utils: Preserve symbolic links in 'wrap-program'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/utils.scm (wrap-program): Preserve symbolic links instead of copying the contents of the link. Co-authored-by: Ludovic Courtès Closes . --- guix/build/utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index a3446cb617..6de1fa3b1e 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -837,7 +837,7 @@ the previous wrapper." (if (zero? number) (let ((prog-real (string-append (dirname prog) "/." (basename prog) "-real"))) - (copy-file prog prog-real) + (rename-file prog prog-real) prog-real) (wrapper-file-name number))) -- cgit v1.2.3 From cd0385b61a934eafe1601e7c22024cf452d357c2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Feb 2015 22:46:26 +0100 Subject: build-system/gnu: Add support for zip archives. Fixes . Reported by Andreas Enge . * guix/build/gnu-build-system.scm (unpack): Use 'unzip' when SOURCE ends in '.zip'. --- guix/build/gnu-build-system.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 2880168273..25df711170 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -108,7 +108,9 @@ working directory." (copy-recursively source "." #:keep-mtime? #t) #t) - (and (zero? (system* "tar" "xvf" source)) + (and (if (string-suffix? ".zip" source) + (zero? (system* "unzip" source)) + (zero? (system* "tar" "xvf" source))) (chdir (first-subdirectory "."))))) ;; See . -- cgit v1.2.3 From 8ddc41e1f25b643beaa204b1f5c271cfe7f3e0a9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Feb 2015 22:48:14 +0100 Subject: utils: Add 'modify-phases'. * guix/build/utils.scm (modify-phases): New macro. --- .dir-locals.el | 1 + guix/build/utils.scm | 28 ++++++++++++++++++++++++++++ 2 files changed, 29 insertions(+) (limited to 'guix') diff --git a/.dir-locals.el b/.dir-locals.el index e056e26c9a..7aef853625 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -20,6 +20,7 @@ (eval . (put 'guard 'scheme-indent-function 1)) (eval . (put 'lambda* 'scheme-indent-function 1)) (eval . (put 'substitute* 'scheme-indent-function 1)) + (eval . (put 'modify-phases 'scheme-indent-function 1)) (eval . (put 'with-directory-excursion 'scheme-indent-function 1)) (eval . (put 'package 'scheme-indent-function 0)) (eval . (put 'origin 'scheme-indent-function 0)) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 6de1fa3b1e..f24ed47f3e 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -54,6 +54,7 @@ alist-cons-before alist-cons-after alist-replace + modify-phases with-atomic-file-replacement substitute substitute* @@ -423,6 +424,33 @@ An error is raised when no such pair exists." ((_ after ...) (append before (alist-cons key value after)))))) +(define-syntax-rule (modify-phases phases mod-spec ...) + "Modify PHASES sequentially as per each MOD-SPEC, which may have one of the +following forms: + + (delete ) + (replace ) + (add-before ) + (add-after ) + +Where every <*-phase-name> is an automatically quoted symbol, and +an expression evaluating to a procedure." + (let* ((phases* phases) + (phases* (%modify-phases phases* mod-spec)) + ...) + phases*)) + +(define-syntax %modify-phases + (syntax-rules (delete replace add-before add-after) + ((_ phases (delete old-phase-name)) + (alist-delete 'old-phase-name phases)) + ((_ phases (replace old-phase-name new-phase)) + (alist-replace 'old-phase-name new-phase phases)) + ((_ phases (add-before old-phase-name new-phase-name new-phase)) + (alist-cons-before 'old-phase-name 'new-phase-name new-phase phases)) + ((_ phases (add-after old-phase-name new-phase-name new-phase)) + (alist-cons-after 'old-phase-name 'new-phase-name new-phase phases)))) + ;;; ;;; Text substitution (aka. sed). -- cgit v1.2.3 From f84218acae6cb323c6c9f7d5957531dae9b9912f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Feb 2015 23:00:21 +0100 Subject: build-system: Use 'modify-phases'. * guix/build/cmake-build-system.scm (%standard-phases): Use 'modify-phases' instead of alist-*. * guix/build/glib-or-gtk-build-system.scm (%standard-phases): Likewise. * guix/build/gnu-dist.scm (%dist-phases): Likewise. * guix/build/perl-build-system.scm (%standard-phases): Likewise. * guix/build/python-build-system.scm (%standard-phases): Likewise. * guix/build/ruby-build-system.scm (%standard-phases): Likewise. * guix/build/waf-build-system.scm (%standard-phases): Likewise. --- guix/build/cmake-build-system.scm | 8 ++++---- guix/build/glib-or-gtk-build-system.scm | 11 ++++------- guix/build/gnu-dist.scm | 17 +++++++---------- guix/build/perl-build-system.scm | 16 ++++++---------- guix/build/python-build-system.scm | 22 ++++++++-------------- guix/build/ruby-build-system.scm | 12 +++++------- guix/build/waf-build-system.scm | 13 +++++-------- 7 files changed, 39 insertions(+), 60 deletions(-) (limited to 'guix') diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm index 74b4f01425..07fd8df481 100644 --- a/guix/build/cmake-build-system.scm +++ b/guix/build/cmake-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Cyril Roelandt ;;; Copyright © 2014 Andreas Enge ;;; @@ -72,9 +72,9 @@ (define %standard-phases ;; Everything is as with the GNU Build System except for the `configure' ;; and 'check' phases. - (alist-replace 'configure configure - (alist-replace 'check check - gnu:%standard-phases))) + (modify-phases gnu:%standard-phases + (replace check check) + (replace configure configure))) (define* (cmake-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm index 92e91bf7a5..c57bc3e731 100644 --- a/guix/build/glib-or-gtk-build-system.scm +++ b/guix/build/glib-or-gtk-build-system.scm @@ -239,13 +239,10 @@ needed." outputs)) (define %standard-phases - (alist-cons-after - 'install 'glib-or-gtk-wrap wrap-all-programs - (alist-cons-after - 'install 'glib-or-gtk-icon-cache generate-icon-cache - (alist-cons-after - 'install 'glib-or-gtk-compile-schemas compile-glib-schemas - gnu:%standard-phases)))) + (modify-phases gnu:%standard-phases + (add-after install glib-or-gtk-compile-schemas compile-glib-schemas) + (add-after install glib-or-gtk-icon-cache generate-icon-cache) + (add-after install glib-or-gtk-wrap wrap-all-programs))) (define* (glib-or-gtk-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/gnu-dist.scm b/guix/build/gnu-dist.scm index 562056b5f6..887b5e94e9 100644 --- a/guix/build/gnu-dist.scm +++ b/guix/build/gnu-dist.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -82,14 +82,11 @@ (define %dist-phases ;; Phases for building a source tarball. - (alist-replace - 'unpack copy-source - (alist-cons-before - 'configure 'autoreconf autoreconf - (alist-replace - 'build build - (alist-replace - 'install install-dist - (alist-delete 'strip %standard-phases)))))) + (modify-phases %standard-phases + (delete strip) + (replace install install-dist) + (replace build build) + (add-before configure autoreconf autoreconf) + (replace unpack copy-source))) ;;; gnu-dist.scm ends here diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm index 7eb944ccd1..9ca5353bb9 100644 --- a/guix/build/perl-build-system.scm +++ b/guix/build/perl-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -71,15 +71,11 @@ (define %standard-phases ;; Everything is as with the GNU Build System except for the `configure', ;; `build', `check', and `install' phases. - (alist-replace - 'configure configure - (alist-replace - 'build build - (alist-replace - 'check check - (alist-replace - 'install install - gnu:%standard-phases))))) + (modify-phases gnu:%standard-phases + (replace install install) + (replace check check) + (replace build build) + (replace configure configure))) (define* (perl-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm index 74ba0c765d..9f853134bd 100644 --- a/guix/build/python-build-system.scm +++ b/guix/build/python-build-system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2015 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; @@ -122,19 +122,13 @@ installed with setuptools." (define %standard-phases ;; 'configure' and 'build' phases are not needed. Everything is done during ;; 'install'. - (alist-cons-before - 'strip 'rename-pth-file - rename-pth-file - (alist-cons-after - 'install 'wrap - wrap - (alist-replace - 'build build - (alist-replace - 'check check - (alist-replace 'install install - (alist-delete 'configure - gnu:%standard-phases))))))) + (modify-phases gnu:%standard-phases + (delete configure) + (replace install install) + (replace check check) + (replace build build) + (add-after install wrap wrap) + (add-before strip rename-pth-file rename-pth-file))) (define* (python-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index 2b3ba7c8cd..40aa974dee 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -62,13 +62,11 @@ directory." (first-matching-file "\\.gem$"))))) (define %standard-phases - (alist-replace - 'build build - (alist-replace - 'install install - (alist-replace - 'check check - (alist-delete 'configure gnu:%standard-phases))))) + (modify-phases gnu:%standard-phases + (delete configure) + (replace build build) + (replace install install) + (replace check check))) (define* (ruby-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) diff --git a/guix/build/waf-build-system.scm b/guix/build/waf-build-system.scm index e64b51abc0..d172c5a836 100644 --- a/guix/build/waf-build-system.scm +++ b/guix/build/waf-build-system.scm @@ -69,14 +69,11 @@ (call-waf "install" params))) (define %standard-phases - (alist-replace - 'configure configure - (alist-replace - 'build build - (alist-replace - 'check check - (alist-replace 'install install - gnu:%standard-phases))))) + (modify-phases gnu:%standard-phases + (replace configure configure) + (replace build build) + (replace check check) + (replace install install))) (define* (waf-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- cgit v1.2.3 From 5335c56e8eb1953d7e14130896fea35309231134 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Feb 2015 23:36:55 +0100 Subject: build-system/gnu: Add 'install-locale' phase. * guix/build/gnu-build-system.scm (install-locale): New procedure. (%standard-phases): Add it. * guix/build-system/gnu.scm (gnu-build): Add #:locale and pass it to the build script. (gnu-cross-build): Likewise. --- guix/build-system/gnu.scm | 6 +++++- guix/build/gnu-build-system.scm | 25 ++++++++++++++++++++++++- 2 files changed, 29 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index c675155a6a..c91ad2ee0c 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -278,6 +278,7 @@ standard packages used as implicit inputs of the GNU build system." (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) (phases '%standard-phases) + (locale "en_US.UTF-8") (system (%current-system)) (imported-modules %default-modules) (modules %default-modules) @@ -328,6 +329,7 @@ are allowed to refer to." #:search-paths ',(map search-path-specification->sexp search-paths) #:phases ,phases + #:locale ,locale #:configure-flags ,configure-flags #:make-flags ,make-flags #:out-of-source? ,out-of-source? @@ -410,6 +412,7 @@ is one of `host' or `target'." (strip-directories ''("lib" "lib64" "libexec" "bin" "sbin")) (phases '%standard-phases) + (locale "en_US.UTF-8") (system (%current-system)) (imported-modules '((guix build gnu-build-system) (guix build utils))) @@ -473,6 +476,7 @@ platform." search-path-specification->sexp native-search-paths) #:phases ,phases + #:locale ,locale #:configure-flags ,configure-flags #:make-flags ,make-flags #:out-of-source? ,out-of-source? diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 25df711170..c3cc3ce70a 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -94,6 +94,29 @@ #t) +(define* (install-locale #:key + (locale "en_US.UTF-8") + (locale-category LC_ALL) + #:allow-other-keys) + "Try to install LOCALE; emit a warning if that fails. The main goal is to +use a UTF-8 locale so that Guile correctly interprets UTF-8 file names. + +This phase must typically happen after 'set-paths' so that $LOCPATH has a +chance to be set." + (catch 'system-error + (lambda () + (setlocale locale-category locale) + (format (current-error-port) "using '~a' locale for category ~a~%" + locale locale-category) + #t) + (lambda args + ;; This is known to fail for instance in early bootstrap where locales + ;; are not available. + (format (current-error-port) + "warning: failed to install '~a' locale: ~a~%" + locale (strerror (system-error-errno args))) + #t))) + (define* (unpack #:key source #:allow-other-keys) "Unpack SOURCE in the working directory, and change directory within the source. When SOURCE is a directory, copy it in a sub-directory of the current @@ -454,7 +477,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS." ;; Standard build phases, as a list of symbol/procedure pairs. (let-syntax ((phases (syntax-rules () ((_ p ...) `((p . ,p) ...))))) - (phases set-paths unpack + (phases set-paths install-locale unpack patch-usr-bin-file patch-source-shebangs configure patch-generated-file-shebangs build check install -- cgit v1.2.3 From 9cca706c2e76bddb3c04ca2ab310cd1262596232 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Feb 2015 00:03:17 +0100 Subject: packages: When possible, use a UTF-8 locale in patch-and-repack. * guix/packages.scm (%standard-patch-inputs): Add "locales". (patch-and-repack)[builder]: Add 'locales' variable. When it is true, call 'setenv' and 'setlocale'. --- guix/packages.scm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 5b686a122f..b72a6ddc8e 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -335,7 +335,8 @@ corresponds to the arguments expected by `set-path-environment-variable'." ("bzip2" ,(ref '(gnu packages compression) 'bzip2)) ("gzip" ,(ref '(gnu packages compression) 'gzip)) ("lzip" ,(ref '(gnu packages compression) 'lzip)) - ("patch" ,(ref '(gnu packages base) 'patch))))) + ("patch" ,(ref '(gnu packages base) 'patch)) + ("locales" ,(ref '(gnu packages base) 'glibc-utf8-locales))))) (define (default-guile) "Return the default Guile package used to run the build code of @@ -411,7 +412,8 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." (srfi srfi-1) (guix build utils)) - (let ((out (assoc-ref %outputs "out")) + (let ((locales (assoc-ref %build-inputs "locales")) + (out (assoc-ref %outputs "out")) (xz (assoc-ref %build-inputs "xz")) (decomp (assoc-ref %build-inputs ,decompression-type)) (source (assoc-ref %build-inputs "source")) @@ -433,6 +435,12 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." (lambda (name) (not (member name '("." ".."))))))) + (when locales + ;; First of all, install a UTF-8 locale so that UTF-8 file names + ;; are correctly interpreted. During bootstrap, LOCALES is #f. + (setenv "LOCPATH" (string-append locales "/lib/locale")) + (setlocale LC_ALL "en_US.UTF-8")) + (setenv "PATH" (string-append xz "/bin" ":" decomp "/bin")) -- cgit v1.2.3 From 50915d2c2ed050c40db51988106ad46d61039d56 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Fri, 27 Feb 2015 19:10:40 +0800 Subject: build-system/cmake: Enable verbose output from Makefile builds. * guix/build/cmake-build-system.scm (configure): Pass -DCMAKE_VERBOSE_MAKEFILE=ON to cmake. --- guix/build/cmake-build-system.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'guix') diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm index 07fd8df481..08ae73ef8d 100644 --- a/guix/build/cmake-build-system.scm +++ b/guix/build/cmake-build-system.scm @@ -57,6 +57,8 @@ "-DCMAKE_INSTALL_RPATH_USE_LINK_PATH=TRUE" ;; add (other) libraries of the project itself to rpath ,(string-append "-DCMAKE_INSTALL_RPATH=" out "/lib") + ;; enable verbose output from builds + "-DCMAKE_VERBOSE_MAKEFILE=ON" ,@configure-flags))) (setenv "CMAKE_LIBRARY_PATH" (getenv "LIBRARY_PATH")) (setenv "CMAKE_INCLUDE_PATH" (getenv "CPATH")) -- cgit v1.2.3 From 251e8b2ee8a9cb89ce662b9c47d9dcd76dec618b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Feb 2015 14:54:00 +0100 Subject: build-system/gnu: Set $LC_ALL (or similar) to the chosen locale. Suggested by Mark H Weaver. * guix/build/utils.scm (locale-category->string): New procedure. * guix/build/gnu-build-system.scm (install-locale): Add 'setenv' call. --- guix/build/gnu-build-system.scm | 8 ++++++-- guix/build/utils.scm | 26 +++++++++++++++++++++++++- 2 files changed, 31 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index c3cc3ce70a..a2bd9d43d1 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -106,8 +106,12 @@ chance to be set." (catch 'system-error (lambda () (setlocale locale-category locale) - (format (current-error-port) "using '~a' locale for category ~a~%" - locale locale-category) + + ;; While we're at it, pass it to sub-processes. + (setenv (locale-category->string locale-category) locale) + + (format (current-error-port) "using '~a' locale for category ~s~%" + locale (locale-category->string locale-category)) #t) (lambda args ;; This is known to fail for instance in early bootstrap where locales diff --git a/guix/build/utils.scm b/guix/build/utils.scm index f24ed47f3e..f43451bd35 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -21,6 +21,7 @@ (define-module (guix build utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-60) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 regex) @@ -65,7 +66,9 @@ patch-/usr/bin/file fold-port-matches remove-store-references - wrap-program)) + wrap-program + + locale-category->string)) ;;; @@ -909,6 +912,27 @@ the previous wrapper." (symlink wrapper prog-tmp) (rename-file prog-tmp prog))) + +;;; +;;; Locales. +;;; + +(define (locale-category->string category) + "Return the name of locale category CATEGORY, one of the 'LC_' constants. +If CATEGORY is a bitwise or of several 'LC_' constants, an approximation is +returned." + (letrec-syntax ((convert (syntax-rules () + ((_) + (number->string category)) + ((_ first rest ...) + (if (= first category) + (symbol->string 'first) + (convert rest ...)))))) + (convert LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE + LC_IDENTIFICATION LC_MEASUREMENT LC_MESSAGES LC_MONETARY + LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE + LC_TIME))) + ;;; Local Variables: ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1) -- cgit v1.2.3 From 2c1fb35377182d3301a265945c88deb12f0b88d4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Feb 2015 14:56:01 +0100 Subject: utils: Call the progress-report proc when 'dump-port' starts. * guix/build/utils.scm (dump-port): Add call to PROGRESS at the beginning. --- guix/build/utils.scm | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index f43451bd35..a3f8911491 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -588,22 +588,27 @@ match the terminating newline of a line." (define* (dump-port in out #:key (buffer-size 16384) (progress (lambda (t k) (k)))) - "Read as much data as possible from IN and write it to OUT, using -chunks of BUFFER-SIZE bytes. Call PROGRESS after each successful -transfer of BUFFER-SIZE bytes or less, passing it the total number of -bytes transferred and the continuation of the transfer as a thunk." + "Read as much data as possible from IN and write it to OUT, using chunks of +BUFFER-SIZE bytes. Call PROGRESS at the beginning and after each successful +transfer of BUFFER-SIZE bytes or less, passing it the total number of bytes +transferred and the continuation of the transfer as a thunk." (define buffer (make-bytevector buffer-size)) - (let loop ((total 0) - (bytes (get-bytevector-n! in buffer 0 buffer-size))) + (define (loop total bytes) (or (eof-object? bytes) (let ((total (+ total bytes))) (put-bytevector out buffer 0 bytes) (progress total (lambda () (loop total - (get-bytevector-n! in buffer 0 buffer-size)))))))) + (get-bytevector-n! in buffer 0 buffer-size))))))) + + ;; Make sure PROGRESS is called when we start so that it can measure + ;; throughput. + (progress 0 + (lambda () + (loop 0 (get-bytevector-n! in buffer 0 buffer-size))))) (define (set-file-time file stat) "Set the atime/mtime of FILE to that specified by STAT." -- cgit v1.2.3 From e7620dc9951132439abec2a49904aaeeb8de5397 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Feb 2015 14:57:54 +0100 Subject: download: Abstract the receive buffer size. * guix/build/download.scm (%http-receive-buffer-size): New variable. (progress-proc, tls-wrap, http-fetch): Use it. --- guix/build/download.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/build/download.scm b/guix/build/download.scm index e8d61e0d92..c439f6b2b9 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -42,6 +42,10 @@ ;;; ;;; Code: +(define %http-receive-buffer-size + ;; Size of the HTTP receive buffer. + 65536) + (define* (progress-proc file size #:optional (log-port (current-output-port))) "Return a procedure to show the progress of FILE's download, which is SIZE byte long. The returned procedure is suitable for use as an @@ -92,7 +96,7 @@ abbreviation of URI showing the scheme, host, and basename of the file." (call-with-output-file file (lambda (out) (dump-port in out - #:buffer-size 65536 ; don't flood the log + #:buffer-size %http-receive-buffer-size #:progress (progress-proc (uri-abbreviation uri) size)))) (ftp-close conn)) @@ -182,7 +186,7 @@ which is not available during bootstrap." (connect s (addrinfo:addr ai)) ;; Buffer input and output on this port. - (setvbuf s _IOFBF) + (setvbuf s _IOFBF %http-receive-buffer-size) (if (eq? 'https (uri-scheme uri)) (tls-wrap s (uri-host uri)) @@ -334,7 +338,7 @@ Return the resulting target URI." (if (port? bv-or-port) (begin (dump-port bv-or-port p - #:buffer-size 65536 ; don't flood the log + #:buffer-size %http-receive-buffer-size #:progress (progress-proc (uri-abbreviation uri) size)) (newline)) -- cgit v1.2.3 From 9fbe6f1920f0c16be3d1e7a216c164837e31f0fe Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Feb 2015 15:00:38 +0100 Subject: download: Measure and display the throughput. * guix/build/download.scm (duration->seconds, throughput->string): New procedures. (progress-proc): Measure and display the throughput. --- guix/build/download.scm | 68 +++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 54 insertions(+), 14 deletions(-) (limited to 'guix') diff --git a/guix/build/download.scm b/guix/build/download.scm index c439f6b2b9..6c94fa0574 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -26,6 +26,7 @@ #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -46,24 +47,59 @@ ;; Size of the HTTP receive buffer. 65536) +(define (duration->seconds duration) + "Return the number of seconds represented by DURATION, a 'time-duration' +object, as an inexact number." + (+ (time-second duration) + (/ (time-nanosecond duration) 1e9))) + +(define (throughput->string throughput) + "Given THROUGHPUT, measured in bytes per second, return a string +representing it in a human-readable way." + (if (> throughput 3e6) + (format #f "~,2f MiB/s" (/ throughput (expt 2. 20))) + (format #f "~,0f KiB/s" (/ throughput 1024.0)))) + (define* (progress-proc file size #:optional (log-port (current-output-port))) "Return a procedure to show the progress of FILE's download, which is SIZE byte long. The returned procedure is suitable for use as an argument to `dump-port'. The progress report is written to LOG-PORT." - (if (number? size) - (lambda (transferred cont) - (let ((% (* 100.0 (/ transferred size)))) - (display #\cr log-port) - (format log-port "~a\t~5,1f% of ~,1f KiB" - file % (/ size 1024.0)) - (flush-output-port log-port) - (cont))) - (lambda (transferred cont) - (display #\cr log-port) - (format log-port "~a\t~6,1f KiB transferred" - file (/ transferred 1024.0)) - (flush-output-port log-port) - (cont)))) + (let ((start-time #f)) + (let-syntax ((with-elapsed-time + (syntax-rules () + ((_ elapsed body ...) + (let* ((now (current-time time-monotonic)) + (elapsed (and start-time + (duration->seconds + (time-difference now + start-time))))) + (unless start-time + (set! start-time now)) + body ...))))) + (if (number? size) + (lambda (transferred cont) + (with-elapsed-time elapsed + (let ((% (* 100.0 (/ transferred size))) + (throughput (if elapsed + (/ transferred elapsed) + 0))) + (display #\cr log-port) + (format log-port "~a\t~5,1f% of ~,1f KiB (~a)" + file % (/ size 1024.0) + (throughput->string throughput)) + (flush-output-port log-port) + (cont)))) + (lambda (transferred cont) + (with-elapsed-time elapsed + (let ((throughput (if elapsed + (/ transferred elapsed) + 0))) + (display #\cr log-port) + (format log-port "~a\t~6,1f KiB transferred (~a)" + file (/ transferred 1024.0) + (throughput->string throughput)) + (flush-output-port log-port) + (cont)))))))) (define* (uri-abbreviation uri #:optional (max-length 42)) "If URI's string representation is larger than MAX-LENGTH, return an @@ -427,4 +463,8 @@ on success." file url) #f)))) +;;; Local Variables: +;;; eval: (put 'with-elapsed-time 'scheme-indent-function 1) +;;; End: + ;;; download.scm ends here -- cgit v1.2.3 From c9727aac405123ecf2ffb26745fa255a76c87e40 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Feb 2015 15:04:05 +0100 Subject: download: Comment on lack of progress report with chunked encoding. * guix/build/download.scm (progress-proc): Add comment. --- guix/build/download.scm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'guix') diff --git a/guix/build/download.scm b/guix/build/download.scm index 6c94fa0574..a3105ad41d 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -64,6 +64,9 @@ representing it in a human-readable way." "Return a procedure to show the progress of FILE's download, which is SIZE byte long. The returned procedure is suitable for use as an argument to `dump-port'. The progress report is written to LOG-PORT." + ;; XXX: Because of this procedure is often not + ;; called as frequently as we'd like too; this is especially bad with Nginx + ;; on hydra.gnu.org, which returns whole nars as a single chunk. (let ((start-time #f)) (let-syntax ((with-elapsed-time (syntax-rules () -- cgit v1.2.3 From f9efe568c3cd46f0aecb5bdd35731e98a29dbcea Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 27 Feb 2015 22:05:40 +0100 Subject: gexp: Aggregate outputs of compound gexps. * guix/gexp.scm (gexp-outputs)[add-reference-output]: Recurse into lists. * tests/gexp.scm ("output list + ungexp-splicing list, combined gexps"): New test. --- guix/gexp.scm | 6 +++--- tests/gexp.scm | 10 ++++++++++ 2 files changed, 13 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index a8349c7d6e..1f64cf75ae 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -314,12 +314,12 @@ references." (cons name result)) ((? gexp? exp) (append (gexp-outputs exp) result)) + ((lst ...) + (fold-right add-reference-output result lst)) (_ result))) - (fold-right add-reference-output - '() - (gexp-references exp))) + (add-reference-output (gexp-references exp) '())) (define* (gexp->sexp exp #:key (system (%current-system)) diff --git a/tests/gexp.scm b/tests/gexp.scm index a6fb550540..2ec6c8e3ef 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -230,6 +230,16 @@ (gexp-outputs exp2)) (= 2 (length (gexp-outputs exp2)))))) +(test-assert "output list + ungexp-splicing list, combined gexps" + (let* ((exp0 (gexp (mkdir (ungexp output)))) + (exp1 (gexp (mkdir (ungexp output "foo")))) + (exp2 (gexp (begin (display "hi!") + (ungexp-splicing (list exp0 exp1)))))) + (and (lset= equal? + (append (gexp-outputs exp0) (gexp-outputs exp1)) + (gexp-outputs exp2)) + (= 2 (length (gexp-outputs exp2)))))) + (test-assertm "gexp->file" (mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile)))) (guile (package-file %bootstrap-guile)) -- cgit v1.2.3 From ca1e3ad2faa59d5b32289f84e0937fa476e21a1a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Feb 2015 01:01:51 +0100 Subject: utils: Change 'patch-shebangs' to use binary input. * guix/build/utils.scm (get-char*): New procedure. (patch-shebang): Use it instead of 'read-char'. (fold-port-matches): Remove local 'get-char' and use 'get-char*' instead. --- guix/build/utils.scm | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index a3f8911491..c98c4ca0f0 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -618,6 +618,14 @@ transferred and the continuation of the transfer as a thunk." (stat:atimensec stat) (stat:mtimensec stat))) +(define (get-char* p) + ;; We call it `get-char', but that's really a binary version + ;; thereof. (The real `get-char' cannot be used here because our + ;; bootstrap Guile is hacked to always use UTF-8.) + (match (get-u8 p) + ((? integer? x) (integer->char x)) + (x x))) + (define patch-shebang (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$"))) (lambda* (file @@ -653,8 +661,8 @@ FILE are kept unchanged." (call-with-ascii-input-file file (lambda (p) - (and (eq? #\# (read-char p)) - (eq? #\! (read-char p)) + (and (eq? #\# (get-char* p)) + (eq? #\! (get-char* p)) (let ((line (false-if-exception (read-line p)))) (and=> (and line (regexp-exec shebang-rx line)) (lambda (m) @@ -753,21 +761,13 @@ for each unmatched character." (map char-set (string->list pattern)) pattern)) - (define (get-char p) - ;; We call it `get-char', but that's really a binary version - ;; thereof. (The real `get-char' cannot be used here because our - ;; bootstrap Guile is hacked to always use UTF-8.) - (match (get-u8 p) - ((? integer? x) (integer->char x)) - (x x))) - ;; Note: we're not really striving for performance here... (let loop ((chars '()) (pattern initial-pattern) (matched '()) (result init)) (cond ((null? chars) - (loop (list (get-char port)) + (loop (list (get-char* port)) pattern matched result)) -- cgit v1.2.3 From 4db87162e68e58031d71597a86b253072e18e2ac Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Feb 2015 01:10:24 +0100 Subject: packages: Set the port conversion strategy to 'error'. Suggested by Mark H Weaver. * guix/build/gnu-build-system.scm (gnu-build): Set %DEFAULT-PORT-CONVERSION-STRATEGY to 'error. * guix/packages.scm (patch-and-repack)[builder]: Likewise. --- guix/build/gnu-build-system.scm | 3 +++ guix/packages.scm | 3 +++ 2 files changed, 6 insertions(+) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index a2bd9d43d1..5ae537150f 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -499,6 +499,9 @@ in order. Return #t if all the PHASES succeeded, #f otherwise." (setvbuf (current-output-port) _IOLBF) (setvbuf (current-error-port) _IOLBF) + ;; Encoding/decoding errors shouldn't be silent. + (fluid-set! %default-port-conversion-strategy 'error) + ;; The trick is to #:allow-other-keys everywhere, so that each procedure in ;; PHASES can pick the keyword arguments it's interested in. (every (match-lambda diff --git a/guix/packages.scm b/guix/packages.scm index b72a6ddc8e..fc5264673d 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -412,6 +412,9 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET." (srfi srfi-1) (guix build utils)) + ;; Encoding/decoding errors shouldn't be silent. + (fluid-set! %default-port-conversion-strategy 'error) + (let ((locales (assoc-ref %build-inputs "locales")) (out (assoc-ref %outputs "out")) (xz (assoc-ref %build-inputs "xz")) -- cgit v1.2.3 From dd0a8ef15f903422c6b020e7d793986427add927 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Feb 2015 12:25:22 +0100 Subject: utils: Treat 'configure' and Makefiles with an 8-bit encoding. * guix/build/utils.scm (patch-makefile-SHELL, patch-/usr/bin/file): Wrap 'substitute*' in 'with-fluids'. Fixes . --- guix/build/utils.scm | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index c98c4ca0f0..a5a6167a8c 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -712,16 +712,18 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged." shell)) (let ((st (stat file))) - (substitute* file - (("^ *SHELL[[:blank:]]*:?=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$" - _ dir shell args) - (let* ((old (string-append dir shell)) - (new (or (find-shell shell) old))) - (unless (string=? new old) - (format (current-error-port) - "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%" - file old new)) - (string-append "SHELL = " new args)))) + ;; Consider FILE is using an 8-bit encoding to avoid errors. + (with-fluids ((%default-port-encoding #f)) + (substitute* file + (("^ *SHELL[[:blank:]]*:?=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$" + _ dir shell args) + (let* ((old (string-append dir shell)) + (new (or (find-shell shell) old))) + (unless (string=? new old) + (format (current-error-port) + "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%" + file old new)) + (string-append "SHELL = " new args))))) (when keep-mtime? (set-file-time file st)))) @@ -738,13 +740,15 @@ unchanged." "patch-/usr/bin/file: warning: \ no replacement 'file' command, doing nothing~%") (let ((st (stat file))) - (substitute* file - (("/usr/bin/file") - (begin - (format (current-error-port) - "patch-/usr/bin/file: ~a: changing `~a' to `~a'~%" - file "/usr/bin/file" file-command) - file-command))) + ;; Consider FILE is using an 8-bit encoding to avoid errors. + (with-fluids ((%default-port-encoding #f)) + (substitute* file + (("/usr/bin/file") + (begin + (format (current-error-port) + "patch-/usr/bin/file: ~a: changing `~a' to `~a'~%" + file "/usr/bin/file" file-command) + file-command)))) (when keep-mtime? (set-file-time file st))))) -- cgit v1.2.3 From b479c3ddaf85c831e34888229849bc1ce34419de Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 1 Mar 2015 00:23:07 +0100 Subject: build-system/gnu: Keep the sloppy conversion strategy during bootstrap. * guix/build/gnu-build-system.scm (gnu-build): Leave %DEFAULT-PORT-CONVERSION-STRATEGY unchanged when 'string->bytevector' fails to convert to ISO-8859-1. This is an attempt to work around the build failures at . --- guix/build/gnu-build-system.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 5ae537150f..5ac6b4d43a 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -22,6 +22,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 format) + #:use-module (ice-9 iconv) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%standard-phases @@ -499,8 +500,11 @@ in order. Return #t if all the PHASES succeeded, #f otherwise." (setvbuf (current-output-port) _IOLBF) (setvbuf (current-error-port) _IOLBF) - ;; Encoding/decoding errors shouldn't be silent. - (fluid-set! %default-port-conversion-strategy 'error) + ;; Encoding/decoding errors shouldn't be silent. But our bootstrap Guile + ;; currently doesn't have access to iconv modules, so we have to allow it to + ;; be sloppier (XXX). + (when (false-if-exception (string->bytevector "works?" "ISO-8859-1")) + (fluid-set! %default-port-conversion-strategy 'error)) ;; The trick is to #:allow-other-keys everywhere, so that each procedure in ;; PHASES can pick the keyword arguments it's interested in. -- cgit v1.2.3 From bbe7a2ce0c7cbc44349c4f073af102872e1bb965 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 1 Mar 2015 17:05:41 +0100 Subject: Revert "build-system/gnu: Keep the sloppy conversion strategy during bootstrap." This reverts commit b479c3ddaf85c831e34888229849bc1ce34419de. This commit was the result of an incorrect characterization of the problem; see the log of commit 87c8b92 for details. --- guix/build/gnu-build-system.scm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 5ac6b4d43a..5ae537150f 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -22,7 +22,6 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 format) - #:use-module (ice-9 iconv) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%standard-phases @@ -500,11 +499,8 @@ in order. Return #t if all the PHASES succeeded, #f otherwise." (setvbuf (current-output-port) _IOLBF) (setvbuf (current-error-port) _IOLBF) - ;; Encoding/decoding errors shouldn't be silent. But our bootstrap Guile - ;; currently doesn't have access to iconv modules, so we have to allow it to - ;; be sloppier (XXX). - (when (false-if-exception (string->bytevector "works?" "ISO-8859-1")) - (fluid-set! %default-port-conversion-strategy 'error)) + ;; Encoding/decoding errors shouldn't be silent. + (fluid-set! %default-port-conversion-strategy 'error) ;; The trick is to #:allow-other-keys everywhere, so that each procedure in ;; PHASES can pick the keyword arguments it's interested in. -- cgit v1.2.3 From 7e75a6739bf02c39baf8340e31e590c2c7c5fd16 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Mar 2015 16:26:13 +0100 Subject: gexp: Make sure 'gexp-outputs' removes duplicate outputs. Fixes a regression introduced in f9efe56. * guix/gexp.scm (gexp-outputs): Add call to 'delete-duplicates'. * tests/gexp.scm ("output list, combined gexps, duplicate output"): New test. --- guix/gexp.scm | 3 ++- tests/gexp.scm | 7 +++++++ 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/gexp.scm b/guix/gexp.scm index 1f64cf75ae..1e26342101 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -319,7 +319,8 @@ references." (_ result))) - (add-reference-output (gexp-references exp) '())) + (delete-duplicates + (add-reference-output (gexp-references exp) '()))) (define* (gexp->sexp exp #:key (system (%current-system)) diff --git a/tests/gexp.scm b/tests/gexp.scm index 2ec6c8e3ef..783ca2cdbc 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -230,6 +230,13 @@ (gexp-outputs exp2)) (= 2 (length (gexp-outputs exp2)))))) +(test-equal "output list, combined gexps, duplicate output" + 1 + (let* ((exp0 (gexp (mkdir (ungexp output)))) + (exp1 (gexp (begin (mkdir (ungexp output)) (ungexp exp0)))) + (exp2 (gexp (begin (mkdir (ungexp output)) (ungexp exp1))))) + (length (gexp-outputs exp2)))) + (test-assert "output list + ungexp-splicing list, combined gexps" (let* ((exp0 (gexp (mkdir (ungexp output)))) (exp1 (gexp (mkdir (ungexp output "foo")))) -- cgit v1.2.3