Merge branch 'core-updates'

master
Ludovic Courtès 2014-09-22 23:06:33 +02:00
commit f07aa672fd
27 changed files with 288 additions and 231 deletions

View File

@ -311,7 +311,6 @@ dist_patch_DATA = \
gnu/packages/patches/clucene-pkgconfig.patch \ gnu/packages/patches/clucene-pkgconfig.patch \
gnu/packages/patches/cmake-fix-tests.patch \ gnu/packages/patches/cmake-fix-tests.patch \
gnu/packages/patches/coreutils-dummy-man.patch \ gnu/packages/patches/coreutils-dummy-man.patch \
gnu/packages/patches/coreutils-skip-nohup.patch \
gnu/packages/patches/cpio-gets-undeclared.patch \ gnu/packages/patches/cpio-gets-undeclared.patch \
gnu/packages/patches/cssc-gets-undeclared.patch \ gnu/packages/patches/cssc-gets-undeclared.patch \
gnu/packages/patches/cssc-missing-include.patch \ gnu/packages/patches/cssc-missing-include.patch \
@ -322,11 +321,13 @@ dist_patch_DATA = \
gnu/packages/patches/doxygen-tmake.patch \ gnu/packages/patches/doxygen-tmake.patch \
gnu/packages/patches/emacs-configure-sh.patch \ gnu/packages/patches/emacs-configure-sh.patch \
gnu/packages/patches/eudev-rules-directory.patch \ gnu/packages/patches/eudev-rules-directory.patch \
gnu/packages/patches/file-CVE-2014-3587.patch \
gnu/packages/patches/findutils-absolute-paths.patch \ gnu/packages/patches/findutils-absolute-paths.patch \
gnu/packages/patches/flashrom-use-libftdi1.patch \ gnu/packages/patches/flashrom-use-libftdi1.patch \
gnu/packages/patches/flex-bison-tests.patch \ gnu/packages/patches/flex-bison-tests.patch \
gnu/packages/patches/gawk-shell.patch \ gnu/packages/patches/gawk-shell.patch \
gnu/packages/patches/gcc-cross-environment-variables.patch \ gnu/packages/patches/gcc-cross-environment-variables.patch \
gnu/packages/patches/gcc-fix-pr61801.patch \
gnu/packages/patches/gd-mips64-deplibs-fix.patch \ gnu/packages/patches/gd-mips64-deplibs-fix.patch \
gnu/packages/patches/glib-tests-desktop.patch \ gnu/packages/patches/glib-tests-desktop.patch \
gnu/packages/patches/glib-tests-homedir.patch \ gnu/packages/patches/glib-tests-homedir.patch \
@ -354,7 +355,6 @@ dist_patch_DATA = \
gnu/packages/patches/kmod-module-directory.patch \ gnu/packages/patches/kmod-module-directory.patch \
gnu/packages/patches/libbonobo-activation-test-race.patch \ gnu/packages/patches/libbonobo-activation-test-race.patch \
gnu/packages/patches/libevent-dns-tests.patch \ gnu/packages/patches/libevent-dns-tests.patch \
gnu/packages/patches/libffi-mips-n32-fix.patch \
gnu/packages/patches/liboop-mips64-deplibs-fix.patch \ gnu/packages/patches/liboop-mips64-deplibs-fix.patch \
gnu/packages/patches/libmad-mips-newgcc.patch \ gnu/packages/patches/libmad-mips-newgcc.patch \
gnu/packages/patches/libtheora-config-guess.patch \ gnu/packages/patches/libtheora-config-guess.patch \

View File

@ -28,7 +28,7 @@
(define-public acl (define-public acl
(package (package
(name "acl") (name "acl")
(version "2.2.51") (version "2.2.52")
(source (source
(origin (origin
(method url-fetch) (method url-fetch)
@ -36,7 +36,7 @@
version ".src.tar.gz")) version ".src.tar.gz"))
(sha256 (sha256
(base32 (base32
"09aj30m49ivycl3irram8c3givc0crivjm3ymw0nhfaxrwhlb186")))) "08qd9s3wfhv0ajswsylnfwr5h0d7j9d4rgip855nrh400nxp940p"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:phases `(#:phases

View File

@ -647,18 +647,7 @@ system administrator.")
"") "")
(("^install: (.*)install-sudoers(.*)" _ before after) (("^install: (.*)install-sudoers(.*)" _ before after)
;; Don't try to create /etc/sudoers. ;; Don't try to create /etc/sudoers.
(string-append "install: " before after "\n"))) (string-append "install: " before after "\n"))))
;; XXX FIXME sudo 1.8.10p3 was bootstrapped with a
;; prerelease libtool, which fails on MIPS in the absence
;; of /usr/bin/file. As a temporary workaround, we patch
;; the configure script to hardcode use of the little
;; endian N32 ABI on MIPS.
,@(if (equal? "mips64el-linux" (or (%current-target-system)
(%current-system)))
'((substitute* "configure"
(("\\$emul") "elf32ltsmipn32")))
'()))
%standard-phases) %standard-phases)
;; XXX: The 'testsudoers' test series expects user 'root' to exist, but ;; XXX: The 'testsudoers' test series expects user 'root' to exist, but

View File

@ -25,6 +25,7 @@
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages acl) #:use-module (gnu packages acl)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages ed)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (gnu packages multiprecision) #:use-module (gnu packages multiprecision)
#:use-module (gnu packages perl) #:use-module (gnu packages perl)
@ -122,14 +123,14 @@ implementation offers several extensions over the standard utility.")
(define-public tar (define-public tar
(package (package
(name "tar") (name "tar")
(version "1.27.1") (version "1.28")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/tar/tar-" (uri (string-append "mirror://gnu/tar/tar-"
version ".tar.bz2")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1iip0fk0wqhxb0jcwphz43r4fxkx1y7mznnhmlvr618jhp7b63wv")))) "1wi2zwm4c9r3h3b8y4w0nm0qq897kn8kyj9k22ba0iqvxj48vvk4"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(synopsis "Managing tar archives") (synopsis "Managing tar archives")
(description (description
@ -154,12 +155,9 @@ standard utility.")
(base32 (base32
"1sqckf560pzwgniy00vcpdv2c9c11s4cmhlm14yqgg8avd3bl94i")))) "1sqckf560pzwgniy00vcpdv2c9c11s4cmhlm14yqgg8avd3bl94i"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs '()) ; FIXME: needs `ed' for the tests (native-inputs `(("ed", ed)))
(arguments
'(#:tests? #f)
;; TODO: When cross-compiling, add this: ;; TODO: When cross-compiling, add this:
;; '(#:configure-flags '("ac_cv_func_strnlen_working=yes")) ;; '(#:configure-flags '("ac_cv_func_strnlen_working=yes"))
)
(synopsis "Apply differences to originals, with optional backups") (synopsis "Apply differences to originals, with optional backups")
(description (description
"Patch is a program that applies changes to files based on differences "Patch is a program that applies changes to files based on differences
@ -225,17 +223,15 @@ used to apply commands with arbitrarily long arguments.")
(define-public coreutils (define-public coreutils
(package (package
(name "coreutils") (name "coreutils")
(version "8.22") (version "8.23")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/coreutils/coreutils-" (uri (string-append "mirror://gnu/coreutils/coreutils-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"04hjzzv434fb8ak3hh3dyhdvg3hqjjwvjmjxqzk1gh2jh6cr8gjv")) "0bdq6yggyl7nkc2pbl6pxhhyx15nyqhz3ds6rfn448n6rxdwlhzc"))
(patches (list (search-patch "coreutils-dummy-man.patch") (patches (list (search-patch "coreutils-dummy-man.patch")))))
;; TODO: remove this patch for >= 8.23
(search-patch "coreutils-skip-nohup.patch")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(inputs `(("acl" ,acl) ; TODO: add SELinux (inputs `(("acl" ,acl) ; TODO: add SELinux
("gmp" ,gmp))) ("gmp" ,gmp)))
@ -362,14 +358,14 @@ included.")
(define-public glibc (define-public glibc
(package (package
(name "glibc") (name "glibc")
(version "2.19") (version "2.20")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/glibc/glibc-" (uri (string-append "mirror://gnu/glibc/glibc-"
version ".tar.xz")) version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"18m2dssd6ja5arxmdxinc90xvpqcsnqjfwmjl2as07j0i3srff9d")) "19bbyfc2gcxr9rihrkkbd3p362i608yhlyrr7icqsa6cmr16sjzq"))
(snippet (snippet
;; Disable 'ldconfig' and /etc/ld.so.cache. The latter is ;; Disable 'ldconfig' and /etc/ld.so.cache. The latter is
;; required on LFS distros to avoid loading the distro's libc.so ;; required on LFS distros to avoid loading the distro's libc.so
@ -409,10 +405,10 @@ included.")
(assoc-ref %build-inputs "linux-headers") (assoc-ref %build-inputs "linux-headers")
"/include") "/include")
;; The default is to assume a 2.4 Linux interface, but we'll ;; This is the default for most architectures as of GNU libc 2.20,
;; always use something newer. See "kernel-features.h" in the ;; but we specify it explicitly for clarity and consistency. See
;; GNU libc for details. ;; "kernel-features.h" in the GNU libc for details.
"--enable-kernel=2.6.30" "--enable-kernel=2.6.32"
;; Use our Bash instead of /bin/sh. ;; Use our Bash instead of /bin/sh.
(string-append "BASH_SHELL=" (string-append "BASH_SHELL="

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -64,15 +65,15 @@ C or C++ programs, though that is not its primary goal.")
(define-public libatomic-ops (define-public libatomic-ops
(package (package
(name "libatomic-ops") (name "libatomic-ops")
(version "7.4.0") (version "7.4.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
"http://www.hboehm.info/gc/gc_source/libatomic_ops-" "http://www.ivmaisoft.com/_bin/atomic_ops/libatomic_ops-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"0njv3n63zw6v45k68z6dz14g2hpk5p230ncwmdfkglsljb1cqx98")))) "1pdm0h1y7bgkczr8byg20r6bq15m5072cqm5pny4f9crc9gn3yh4"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(outputs '("out" "debug")) (outputs '("out" "debug"))
(synopsis "Accessing hardware atomic memory update operations") (synopsis "Accessing hardware atomic memory update operations")
@ -88,14 +89,14 @@ lock-free code, experiment with thread programming paradigms, etc.")
(define-public libgc (define-public libgc
(package (inherit libgc-7.2) (package (inherit libgc-7.2)
(version "7.4.0") (version "7.4.2")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "http://www.hboehm.info/gc/gc_source/gc-" (uri (string-append "http://www.hboehm.info/gc/gc_source/gc-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"10z2nph62ilab063wygg2lv0jxlsbcf2az9w1lx01jzqj5lzry31")))) "18mg28rr6kwr5clc65k4l4hkyy4kd16amx831sjf8q2lqkbhlck3"))))
;; New dependencies. ;; New dependencies.
(native-inputs `(("pkg-config" ,pkg-config))) (native-inputs `(("pkg-config" ,pkg-config)))

View File

@ -26,6 +26,8 @@
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages gcc) #:use-module (gnu packages gcc)
#:use-module (gnu packages ed)
#:use-module (gnu packages file)
#:use-module (gnu packages gawk) #:use-module (gnu packages gawk)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module (gnu packages multiprecision) #:use-module (gnu packages multiprecision)
@ -106,11 +108,20 @@
(current-source-location) (current-source-location)
#:guile %bootstrap-guile))) #:guile %bootstrap-guile)))
(define file-boot0
(package-with-bootstrap-guile
(package-with-explicit-inputs file
`(("make" ,gnu-make-boot0)
,@%bootstrap-inputs)
(current-source-location)
#:guile %bootstrap-guile)))
(define %boot0-inputs (define %boot0-inputs
`(("make" ,gnu-make-boot0) `(("make" ,gnu-make-boot0)
("diffutils" ,diffutils-boot0) ("diffutils" ,diffutils-boot0)
("findutils" ,findutils-boot0) ("findutils" ,findutils-boot0)
("file" ,file-boot0)
,@%bootstrap-inputs)) ,@%bootstrap-inputs))
(define* (nix-system->gnu-triplet (define* (nix-system->gnu-triplet
@ -663,6 +674,7 @@ store.")
("gzip" ,gzip) ("gzip" ,gzip)
("bzip2" ,bzip2) ("bzip2" ,bzip2)
("xz" ,xz) ("xz" ,xz)
("file" ,file)
("diffutils" ,diffutils) ("diffutils" ,diffutils)
("patch" ,patch) ("patch" ,patch)
("sed" ,sed) ("sed" ,sed)

View File

@ -49,7 +49,13 @@
(arguments (arguments
'(#:configure-flags (list (string-append "--with-plugindir=" '(#:configure-flags (list (string-append "--with-plugindir="
(assoc-ref %outputs "out") (assoc-ref %outputs "out")
"/lib/sasl2")))) "/lib/sasl2"))
;; The 'plugins' directory has shared source files, such as
;; 'plugin_common.c'. When building the shared libraries there, libtool
;; ends up doing "ln -s plugin_common.lo plugin_common.o", which can
;; fail with EEXIST when building things in parallel.
#:parallel-build? #f))
(synopsis "Cyrus SASL, an implementation of the Simple Authentication Security Layer framework") (synopsis "Cyrus SASL, an implementation of the Simple Authentication Security Layer framework")
(description (description
"SASL (Simple Authentication Security Layer) is an Internet "SASL (Simple Authentication Security Layer) is an Internet

View File

@ -27,17 +27,15 @@
(define-public file (define-public file
(package (package
(name "file") (name "file")
(version "5.18") (version "5.19")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append "ftp://ftp.astron.com/pub/file/file-" (uri (string-append "ftp://ftp.astron.com/pub/file/file-"
version ".tar.gz")) version ".tar.gz"))
(sha256 (base32 (sha256 (base32
"01xz106biz6x4h5ilymg5v3367djvgnfp4lm87132cjqdmqgn6b5")))) "0z1sgrcfy6d285kj5izy1yypf371bjl3247plh9ppk0svaxv714l"))
(patches (list (search-patch "file-CVE-2014-3587.patch")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs
;; This package depends upon a native install of itself.
(if (%current-target-system) `(("file" ,file)) '() ))
(synopsis "file, a file type guesser") (synopsis "file, a file type guesser")
(description (description
"The file command is a file type guesser, a command-line tool that tells "The file command is a file type guesser, a command-line tool that tells

View File

@ -57,15 +57,12 @@
(string-append "### " match)))) (string-append "### " match))))
'()) '())
;; XXX FIXME gawk 4.1.1 was bootstrapped with a prerelease ;; XXX FIXME prerelease libtool fails on MIPS in the
;; libtool, which fails on MIPS in the absence of ;; absence of /usr/bin/file.
;; /usr/bin/file. As a temporary workaround, we patch
;; the configure script to hardcode use of the little
;; endian N32 ABI on MIPS.
,@(if (equal? "mips64el-linux" (or (%current-target-system) ,@(if (equal? "mips64el-linux" (or (%current-target-system)
(%current-system))) (%current-system)))
'((substitute* "extension/configure" '((substitute* "extension/configure"
(("\\$emul") "elf32ltsmipn32"))) (("/usr/bin/file") (which "file"))))
'()))) '())))
%standard-phases))) %standard-phases)))
(inputs `(("libsigsegv" ,libsigsegv) (inputs `(("libsigsegv" ,libsigsegv)

View File

@ -268,7 +268,8 @@ Go. It also includes runtime support libraries for these languages.")
version "/gcc-" version ".tar.bz2")) version "/gcc-" version ".tar.bz2"))
(sha256 (sha256
(base32 (base32
"07hg10zs7gnqz58my10ch0zygizqh0z0bz6pv4pgxx45n48lz3ka")))))) "07hg10zs7gnqz58my10ch0zygizqh0z0bz6pv4pgxx45n48lz3ka"))
(patches (list (search-patch "gcc-fix-pr61801.patch")))))))
(define-public gcc-4.9 (define-public gcc-4.9
(package (inherit gcc-4.7) (package (inherit gcc-4.7)

View File

@ -63,7 +63,7 @@ specifications.")
(define-public gnutls (define-public gnutls
(package (package
(name "gnutls") (name "gnutls")
(version "3.2.15") (version "3.2.16")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -75,12 +75,8 @@ specifications.")
"/gnutls-" version ".tar.xz")) "/gnutls-" version ".tar.xz"))
(sha256 (sha256
(base32 (base32
"1fbpr9r1r2y803s3avwjpy1higqsz85dyb302kvmh0i29frwgg9h")))) "1bmwhg8y3mz5w2klclf5dz9502477kaj8r8db7k45fwb9ah3c63q"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments
;; Work around build issue reported at
;; <https://lists.gnu.org/archive/html/guix-devel/2014-03/msg00027.html>.
'(#:make-flags '("CPPFLAGS=-DENABLE_RSA_EXPORT")))
(native-inputs (native-inputs
`(("pkg-config" ,pkg-config))) `(("pkg-config" ,pkg-config)))
(inputs (inputs

View File

@ -122,11 +122,7 @@ without requiring the source code to be rewritten.")
(native-inputs `(("pkgconfig" ,pkg-config))) (native-inputs `(("pkgconfig" ,pkg-config)))
(inputs `(("libffi" ,libffi) (inputs `(("libffi" ,libffi)
("readline" ,readline) ("readline" ,readline)
("bash" ,bash)))
;; TODO: On next core-updates, make Bash input unconditional.
,@(if (%current-target-system)
`(("bash" ,bash))
'())))
(propagated-inputs (propagated-inputs
`( ;; These ones aren't normally needed here, but since `libguile-2.0.la' `( ;; These ones aren't normally needed here, but since `libguile-2.0.la'

View File

@ -19,7 +19,6 @@
(define-module (gnu packages image) (define-module (gnu packages image)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages file)
#:use-module (gnu packages fontutils) #:use-module (gnu packages fontutils)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages xml) #:use-module (gnu packages xml)
@ -102,20 +101,11 @@ image files in PBMPLUS PPM/PGM, GIF, BMP, and Targa file formats.")
(inputs `(("zlib" ,zlib) (inputs `(("zlib" ,zlib)
("libjpeg-8" ,libjpeg-8))) ("libjpeg-8" ,libjpeg-8)))
;; currently does not compile with libjpeg version 9 ;; currently does not compile with libjpeg version 9
(native-inputs `(("file" ,file)))
(arguments (arguments
`(#:configure-flags `(#:configure-flags
(list (string-append "--with-jpeg-include-dir=" (list (string-append "--with-jpeg-include-dir="
(assoc-ref %build-inputs "libjpeg-8") (assoc-ref %build-inputs "libjpeg-8")
"/include")) "/include"))))
#:phases
(alist-cons-before
'configure 'patch-configure
(lambda _
(substitute* "configure"
(("`/usr/bin/file")
(string-append "`" (which "file")))))
%standard-phases)))
(synopsis "Libtiff, a library for handling TIFF files") (synopsis "Libtiff, a library for handling TIFF files")
(description (description
"Libtiff provides support for the Tag Image File Format (TIFF), a format "Libtiff provides support for the Tag Image File Format (TIFF), a format

View File

@ -29,11 +29,11 @@
;; available in $includedir where some users expect them. ;; available in $includedir where some users expect them.
'(lambda* (#:key outputs #:allow-other-keys) '(lambda* (#:key outputs #:allow-other-keys)
(define out (assoc-ref outputs "out")) (define out (assoc-ref outputs "out"))
(symlink (string-append out "/lib/libffi-3.0.13/include") (symlink (string-append out "/lib/libffi-3.1/include")
(string-append out "/include"))))) (string-append out "/include")))))
(package (package
(name "libffi") (name "libffi")
(version "3.0.13") (version "3.1")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (uri
@ -41,8 +41,7 @@
name "-" version ".tar.gz")) name "-" version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"077ibkf84bvcd6rw1m6jb107br63i2pp301rkmsbgg6300adxp8x")) "1sznmrhcswwbyqla9y2ximlkzbxks59wjfs3lh7qf8ayranyxzlp"))))
(patches (list (search-patch "libffi-mips-n32-fix.patch")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments `(#:phases (alist-cons-after 'install 'post-install (arguments `(#:phases (alist-cons-after 'install 'post-install
,post-install-phase ,post-install-phase

View File

@ -25,7 +25,7 @@
(define-public libunistring (define-public libunistring
(package (package
(name "libunistring") (name "libunistring")
(version "0.9.3") (version "0.9.4")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (string-append (uri (string-append
@ -33,7 +33,7 @@
version ".tar.gz")) version ".tar.gz"))
(sha256 (sha256
(base32 (base32
"18q620269xzpw39dwvr9zpilnl2dkw5z5kz3mxaadnpv4k3kw3b1")))) "19nqvn19hz25ig9dbmh2di5j1r7v852x9mlnq0nr0hka51ins97m"))))
(propagated-inputs '()) ; FIXME: add libiconv when !glibc (propagated-inputs '()) ; FIXME: add libiconv when !glibc
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments

View File

@ -379,7 +379,16 @@ providing the system administrator with some help in common tasks.")
(sha256 (sha256
(base32 (base32
"1rpgghf7n0zx0cdy8hibr41wvkm2qp1yvd8ab1rxr193l1jmgcir")) "1rpgghf7n0zx0cdy8hibr41wvkm2qp1yvd8ab1rxr193l1jmgcir"))
(patches (list (search-patch "util-linux-perl.patch"))))) (patches (list (search-patch "util-linux-perl.patch")))
(modules '((guix build utils)))
(snippet
;; We take the 'logger' program from GNU Inetutils, so remove
;; it from here.
'(substitute* "misc-utils/Makefile.in"
(("PROGRAMS =(.*) logger(.*)" _ before after)
(string-append "PROGRAMS =" before " " after))
(("MANS =(.*) logger\\.1(.*)" _ before after)
(string-append "MANS =" before " " after))))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
`(#:configure-flags '("--disable-use-tty-group" `(#:configure-flags '("--disable-use-tty-group"

View File

@ -28,7 +28,6 @@
#:use-module (gnu packages ssh) #:use-module (gnu packages ssh)
#:use-module (gnu packages pkg-config) #:use-module (gnu packages pkg-config)
#:use-module (gnu packages check) #:use-module (gnu packages check)
#:use-module (gnu packages file)
#:use-module (gnu packages perl)) #:use-module (gnu packages perl))
(define-public mc (define-public mc
@ -46,7 +45,6 @@
(patches (list (search-patch "mc-fix-ncurses-build.patch"))))) (patches (list (search-patch "mc-fix-ncurses-build.patch")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config) (native-inputs `(("pkg-config" ,pkg-config)
("file" ,file)
("perl" ,perl))) ("perl" ,perl)))
(inputs `(("aspell" ,aspell) (inputs `(("aspell" ,aspell)
("ncurses" ,ncurses) ("ncurses" ,ncurses)
@ -55,14 +53,7 @@
("check" ,check))) ("check" ,check)))
(arguments (arguments
`(#:configure-flags `(#:configure-flags
'("--with-screen=ncurses" "--enable-aspell") '("--with-screen=ncurses" "--enable-aspell")))
#:phases
(alist-cons-before
'configure 'patch-configure
(lambda _
(substitute* "configure"
(("/usr/bin/file") (which "file"))))
%standard-phases)))
(home-page "http://www.midnight-commander.org") (home-page "http://www.midnight-commander.org")
(synopsis "Graphical file manager") (synopsis "Graphical file manager")
(description (description

View File

@ -23,8 +23,7 @@
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages perl) #:use-module (gnu packages perl))
#:use-module (gnu packages file))
(define-public mcrypt (define-public mcrypt
(package (package
@ -68,7 +67,6 @@ them.")
(base32 (base32
"0gipgb939vy9m66d3k8il98rvvwczyaw2ixr8yn6icds9c3nrsz4")))) "0gipgb939vy9m66d3k8il98rvvwczyaw2ixr8yn6icds9c3nrsz4"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("file" ,file)))
(home-page "http://mcrypt.sourceforge.net/") (home-page "http://mcrypt.sourceforge.net/")
(synopsis "Encryption algorithm library") (synopsis "Encryption algorithm library")
(description (description
@ -95,8 +93,7 @@ XTEA, 3WAY, TWOFISH, BLOWFISH, ARCFOUR, WAKE and more.")
(patches (list (search-patch "mhash-keygen-test-segfault.patch"))))) (patches (list (search-patch "mhash-keygen-test-segfault.patch")))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs (native-inputs
`(("file" ,file) `(("perl" ,perl))) ;for tests
("perl" ,perl))) ;for tests
(home-page "http://mhash.sourceforge.net/") (home-page "http://mhash.sourceforge.net/")
(synopsis "Thread-safe hash library") (synopsis "Thread-safe hash library")
(description (description

View File

@ -7,15 +7,15 @@ would appear when compiling:
dummy-man: too many non-option arguments dummy-man: too many non-option arguments
--- coreutils-8.22/Makefile.in 2013-12-13 16:20:00.000000000 +0100 --- coreutils-8.23/Makefile.in 2014-07-18 18:22:24.000000000 -0400
+++ coreutils-8.22/Makefile.in 2014-02-28 10:53:27.000000000 +0100 +++ coreutils-8.23/Makefile.in 2014-08-03 20:21:10.849158313 -0400
@@ -9977,8 +9977,8 @@ man/yes.1: src/yes @@ -14076,8 +14076,8 @@
&& $(run_help2man) \ && $(run_help2man) \
--source='$(PACKAGE_STRING)' \ --source='$(PACKAGE_STRING)' \
--include=$(srcdir)/man/$$name.x \ --include=$(srcdir)/man/$$name.x \
- --output=$$t/$$name.1 $$t/$$name \ - --output=$$t/$$name.1 $$t/$$argv \
--info-page='coreutils \(aq'$$name' invocation\(aq' \ --info-page='coreutils \(aq'$$name' invocation\(aq' \
+ --output=$$t/$$name.1 $$t/$$name \ + --output=$$t/$$name.1 $$t/$$argv \
&& sed \ && sed \
-e 's|$*\.td/||g' \ -e 's|$*\.td/||g' \
-e '/For complete documentation/d' \ -e '/For complete documentation/d' \

View File

@ -1,28 +0,0 @@
commit 5dce6bdfafc930dfd17d5d16aea7d1add3472066
Author: Pádraig Brady <P@draigBrady.com>
Date: Wed Mar 5 15:14:07 2014 +0000
tests: fix false failure in nohup.sh in non tty builds
* tests/misc/nohup.sh: When running tests without a controlling tty,
an exec failure is triggered in a subshell, which causes POSIX
shells to immediately exit the subshell. This was brought
to notice by the newly conforming bash 4.3.
Fixes http:/bugs.gnu.org/16940
diff --git a/tests/misc/nohup.sh b/tests/misc/nohup.sh
index 6d2b515..2328b43 100755
--- a/tests/misc/nohup.sh
+++ b/tests/misc/nohup.sh
@@ -63,6 +63,11 @@ rm -f nohup.out err
# to stderr must be fatal. Requires stdout to be terminal.
if test -w /dev/full && test -c /dev/full; then
(
+ # POSIX shells immediately exit the subshell on exec error.
+ # So check we can write to /dev/tty before the exec, which
+ # isn't possible if we've no controlling tty for example.
+ test -c /dev/tty && >/dev/tty || exit 0
+
exec >/dev/tty
test -t 1 || exit 0
nohup echo hi 2> /dev/full

View File

@ -0,0 +1,16 @@
Fixes CVE-2014-3587. Copied from upstream commit
0641e56be1af003aa02c7c6b0184466540637233.
--- file-5.19/src/cdf.c.orig 2014-06-09 09:04:37.000000000 -0400
+++ file-5.19/src/cdf.c 2014-08-26 11:55:23.887118898 -0400
@@ -824,6 +824,10 @@
q = (const uint8_t *)(const void *)
((const char *)(const void *)p + ofs
- 2 * sizeof(uint32_t));
+ if (q < p) {
+ DPRINTF(("Wrapped around %p < %p\n", q, p));
+ goto out;
+ }
if (q > e) {
DPRINTF(("Ran of the end %p > %p\n", q, e));
goto out;

View File

@ -0,0 +1,25 @@
GCC bug fix for <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=61801>.
Initially discussed at
<http://lists.gnu.org/archive/html/guix-devel/2014-09/msg00283.html>.
Patch from <https://gcc.gnu.org/viewcvs/gcc?view=revision&revision=212740>.
2014-07-17 Richard Biener <rguenther@suse.de>
PR rtl-optimization/61801
* sched-deps.c (sched_analyze_2): For ASM_OPERANDS and
ASM_INPUT don't set reg_pending_barrier if it appears in a
debug-insn.
--- gcc-4_8-branch/gcc/sched-deps.c 2014/07/17 07:48:49 212739
+++ gcc-4_8-branch/gcc/sched-deps.c 2014/07/17 07:49:44 212740
@@ -2744,7 +2744,8 @@
Consider for instance a volatile asm that changes the fpu rounding
mode. An insn should not be moved across this even if it only uses
pseudo-regs because it might give an incorrectly rounded result. */
- if (code != ASM_OPERANDS || MEM_VOLATILE_P (x))
+ if ((code != ASM_OPERANDS || MEM_VOLATILE_P (x))
+ && !DEBUG_INSN_P (insn))
reg_pending_barrier = TRUE_BARRIER;
/* For all ASM_OPERANDS, we must traverse the vector of input operands.

View File

@ -1,21 +0,0 @@
Fix handling of uint32_t arguments on the MIPS N32 ABI.
Patch by Mark H Weaver <mhw@netris.org>.
--- libffi/src/mips/ffi.c.orig 2013-03-16 07:19:39.000000000 -0400
+++ libffi/src/mips/ffi.c 2013-10-22 01:11:03.111985247 -0400
@@ -170,7 +170,14 @@
break;
case FFI_TYPE_UINT32:
+#ifdef FFI_MIPS_N32
+ /* The N32 ABI requires that 32-bit integers
+ be sign-extended to 64-bits, regardless of
+ whether they are signed or unsigned. */
+ *(ffi_arg *)argp = *(SINT32 *)(* p_argv);
+#else
*(ffi_arg *)argp = *(UINT32 *)(* p_argv);
+#endif
break;
/* This can only happen with 64bit slots. */

View File

@ -30,8 +30,7 @@
#:use-module (gnu packages bison) #:use-module (gnu packages bison)
#:use-module (gnu packages flex) #:use-module (gnu packages flex)
#:use-module (gnu packages gperf) #:use-module (gnu packages gperf)
#:use-module (gnu packages perl) #:use-module (gnu packages perl))
#:use-module (gnu packages file))
(define-public a2ps (define-public a2ps
(package (package
@ -53,45 +52,39 @@
("imagemagick" ,imagemagick))) ("imagemagick" ,imagemagick)))
(native-inputs (native-inputs
`(("gperf" ,gperf) `(("gperf" ,gperf)
("perl" ,perl) ("perl" ,perl)))
("file" ,file)))
(arguments (arguments
'(#:phases (alist-cons-before '(#:phases (alist-cons-before
'configure 'patch-configure 'build 'patch-scripts
(lambda _ (lambda _
(substitute* "configure" (substitute*
(("/usr/bin/file") (which "file")))) '("afm/make_fonts_map.sh"
"tests/defs"
"tests/backup.tst"
"tests/styles.tst")
(("/bin/rm") (which "rm"))))
(alist-cons-before (alist-cons-before
'build 'patch-scripts 'check 'patch-test-files
(lambda _ ;; Alternatively, we could unpatch the shebangs in tstfiles
(substitute* (lambda* (#:key inputs #:allow-other-keys)
'("afm/make_fonts_map.sh" (let ((perl (assoc-ref inputs "perl")))
"tests/defs" (substitute* '("tests/ps-ref/includeres.ps"
"tests/backup.tst" "tests/gps-ref/includeres.ps")
"tests/styles.tst") (("/usr/local/bin/perl")
(("/bin/rm") (which "rm")))) (string-append perl "/bin/perl"))))
(alist-cons-before ;; Some of the reference postscript contain a 'version 3'
'check 'patch-test-files ;; string that in inconsistent with the source text in the
;; Alternatively, we could unpatch the shebangs in tstfiles ;; tstfiles directory. Erroneous search-and-replace?
(lambda* (#:key inputs #:allow-other-keys) (substitute* '("tests/ps-ref/InsertBlock.ps"
(let ((perl (assoc-ref inputs "perl"))) "tests/gps-ref/InsertBlock.ps"
(substitute* '("tests/ps-ref/includeres.ps" "tests/ps-ref/bookie.ps"
"tests/gps-ref/includeres.ps") "tests/gps-ref/bookie.ps")
(("/usr/local/bin/perl") (("version 3") "version 2"))
(string-append perl "/bin/perl")))) (substitute* '("tests/ps-ref/psmandup.ps"
;; Some of the reference postscript contain a 'version 3' "tests/gps-ref/psmandup.ps")
;; string that in inconsistent with the source text in the (("#! */bin/sh") (string-append
;; tstfiles directory. Erroneous search-and-replace? "#!" (which "sh")))))
(substitute* '("tests/ps-ref/InsertBlock.ps" %standard-phases))))
"tests/gps-ref/InsertBlock.ps"
"tests/ps-ref/bookie.ps"
"tests/gps-ref/bookie.ps")
(("version 3") "version 2"))
(substitute* '("tests/ps-ref/psmandup.ps"
"tests/gps-ref/psmandup.ps")
(("#! */bin/sh") (string-append
"#!" (which "sh")))))
%standard-phases)))))
(home-page "http://www.gnu.org/software/a2ps") (home-page "http://www.gnu.org/software/a2ps")
(synopsis "Any file to PostScript, including pretty-printing") (synopsis "Any file to PostScript, including pretty-printing")
(description (description
@ -115,16 +108,9 @@ special cases, such as pretty-printing \"--help\" output.")
(base32 (base32
"13rkc0fga10xyf56yy9dnq95zndnfadkhxflnp24skszj21y8jqh")))) "13rkc0fga10xyf56yy9dnq95zndnfadkhxflnp24skszj21y8jqh"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs `(("file" ,file)))
(arguments (arguments
;; Must define DIFF_CMD for tests to pass ;; Must define DIFF_CMD for tests to pass
'(#:configure-flags '("CPPFLAGS=-DDIFF_CMD=\\\"diff\\\"") '(#:configure-flags '("CPPFLAGS=-DDIFF_CMD=\\\"diff\\\"")))
#:phases (alist-cons-before
'configure 'patch-configure
(lambda _
(substitute* "configure"
(("/usr/bin/file") (which "file"))))
%standard-phases)))
(home-page "http://www.gnu.org/software/trueprint") (home-page "http://www.gnu.org/software/trueprint")
(synopsis "Pretty-print C sources and other plain text to PostScript") (synopsis "Pretty-print C sources and other plain text to PostScript")
(description (description
@ -178,34 +164,28 @@ different programming languages.")
`(("boost" ,boost))) `(("boost" ,boost)))
(native-inputs (native-inputs
`(("bison" ,bison) `(("bison" ,bison)
("flex" ,flex) ("flex" ,flex)))
("file" ,file)))
(arguments (arguments
`(#:configure-flags `(#:configure-flags
(list (string-append "--with-boost=" (list (string-append "--with-boost="
(assoc-ref %build-inputs "boost"))) (assoc-ref %build-inputs "boost")))
#:parallel-tests? #f ;There appear to be race conditions #:parallel-tests? #f ;There appear to be race conditions
#:phases (alist-cons-before #:phases (alist-cons-before
'configure 'patch-configure 'check 'patch-test-files
(lambda _ (lambda _
(substitute* "configure" ;; Unpatch shebangs in test input so that source-highlight
(("/usr/bin/file") (which "file")))) ;; is still able to infer input language
(alist-cons-before (substitute* '("tests/test.sh"
'check 'patch-test-files "tests/test2.sh"
(lambda _ "tests/test.tcl")
;; Unpatch shebangs in test input so that source-highlight (((string-append "#! *" (which "sh"))) "#!/bin/sh"))
;; is still able to infer input language ;; Initial patching unrecoverably removes whitespace, so
(substitute* '("tests/test.sh" ;; remove it also in the comparison output.
"tests/test2.sh" (substitute* '("tests/test.sh.html"
"tests/test.tcl") "tests/test2.sh.html"
(((string-append "#! *" (which "sh"))) "#!/bin/sh")) "tests/test.tcl.html")
;; Initial patching unrecoverably removes whitespace, so (("#! */bin/sh") "#!/bin/sh")))
;; remove it also in the comparison output. %standard-phases)))
(substitute* '("tests/test.sh.html"
"tests/test2.sh.html"
"tests/test.tcl.html")
(("#! */bin/sh") "#!/bin/sh")))
%standard-phases))))
(home-page "http://www.gnu.org/software/src-highlite") (home-page "http://www.gnu.org/software/src-highlite")
(synopsis "Produce a document with syntax highlighting from a source file") (synopsis "Produce a document with syntax highlighting from a source file")
(description (description

View File

@ -106,6 +106,35 @@ working directory."
(and (zero? (system* "tar" "xvf" source)) (and (zero? (system* "tar" "xvf" source))
(chdir (first-subdirectory "."))))) (chdir (first-subdirectory ".")))))
;; See <http://bugs.gnu.org/17840>.
(define* (patch-usr-bin-file #:key native-inputs inputs
(patch-/usr/bin/file? #t)
#:allow-other-keys)
"Patch occurrences of /usr/bin/file in configure, if present."
(when patch-/usr/bin/file?
(let ((file "configure")
(file-command (or (and=> (assoc-ref (or native-inputs inputs) "file")
(cut string-append <> "/bin/file"))
(which "file"))))
(cond ((not (file-exists? file))
(format (current-error-port)
"patch-usr-bin-file: warning: `~a' not found~%"
file))
((not file-command)
(format (current-error-port)
"patch-usr-bin-file: warning: `file' not found in PATH~%"))
(else
(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)))
(set-file-time file st))))))
#t)
(define* (patch-source-shebangs #:key source #:allow-other-keys) (define* (patch-source-shebangs #:key source #:allow-other-keys)
"Patch shebangs in all source files; this includes non-executable "Patch shebangs in all source files; this includes non-executable
files such as `.in' templates. Most scripts honor $SHELL and files such as `.in' templates. Most scripts honor $SHELL and
@ -353,6 +382,7 @@ makefiles."
(let-syntax ((phases (syntax-rules () (let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...))))) ((_ p ...) `((p . ,p) ...)))))
(phases set-paths unpack (phases set-paths unpack
patch-usr-bin-file
patch-source-shebangs configure patch-generated-file-shebangs patch-source-shebangs configure patch-generated-file-shebangs
build check install build check install
patch-shebangs strip))) patch-shebangs strip)))

View File

@ -25,6 +25,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 format)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:re-export (alist-cons #:re-export (alist-cons
@ -582,14 +583,15 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged."
(let ((st (stat file))) (let ((st (stat file)))
(substitute* file (substitute* file
(("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)[[:blank:]]*" _ dir shell) (("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$"
_ dir shell args)
(let* ((old (string-append dir shell)) (let* ((old (string-append dir shell))
(new (or (find-shell shell) old))) (new (or (find-shell shell) old)))
(unless (string=? new old) (unless (string=? new old)
(format (current-error-port) (format (current-error-port)
"patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%" "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
file old new)) file old new))
(string-append "SHELL = " new "\n")))) (string-append "SHELL = " new args))))
(when keep-mtime? (when keep-mtime?
(set-file-time file st)))) (set-file-time file st))))
@ -686,8 +688,7 @@ known as `nuke-refs' in Nixpkgs."
result)))))) result))))))
(define* (wrap-program prog #:rest vars) (define* (wrap-program prog #:rest vars)
"Rename PROG to .PROG-real and make PROG a wrapper. VARS should look like "Make a wrapper for PROG. VARS should look like this:
this:
'(VARIABLE DELIMITER POSITION LIST-OF-DIRECTORIES) '(VARIABLE DELIMITER POSITION LIST-OF-DIRECTORIES)
@ -696,23 +697,44 @@ where DELIMITER is optional. ':' will be used if DELIMITER is not given.
For example, this command: For example, this command:
(wrap-program \"foo\" (wrap-program \"foo\"
'(\"PATH\" \":\" = (\"/nix/.../bar/bin\")) '(\"PATH\" \":\" = (\"/gnu/.../bar/bin\"))
'(\"CERT_PATH\" suffix (\"/nix/.../baz/certs\" '(\"CERT_PATH\" suffix (\"/gnu/.../baz/certs\"
\"/qux/certs\"))) \"/qux/certs\")))
will copy 'foo' to '.foo-real' and create the file 'foo' with the following will copy 'foo' to '.foo-real' and create the file 'foo' with the following
contents: contents:
#!location/of/bin/bash #!location/of/bin/bash
export PATH=\"/nix/.../bar/bin\" export PATH=\"/gnu/.../bar/bin\"
export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/nix/.../baz/certs:/qux/certs\" export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/gnu/.../baz/certs:/qux/certs\"
exec location/of/.foo-real exec location/of/.foo-real
This is useful for scripts that expect particular programs to be in $PATH, for 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 programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or
modules in $GUILE_LOAD_PATH, etc." modules in $GUILE_LOAD_PATH, etc.
(let ((prog-real (string-append (dirname prog) "/." (basename prog) "-real"))
(prog-tmp (string-append (dirname prog) "/." (basename prog) "-tmp"))) If PROG has previously been wrapped by wrap-program the wrapper will point to
the previous wrapper."
(define (wrapper-file-name number)
(format #f "~a/.~a-wrap-~2'0d" (dirname prog) (basename prog) number))
(define (next-wrapper-number)
(let ((wrappers
(find-files (dirname prog)
(string-append "\\." (basename prog) "-wrap-.*"))))
(if (null? wrappers)
0
(string->number (string-take-right (last wrappers) 2)))))
(define (wrapper-target number)
(if (zero? number)
(let ((prog-real (string-append (dirname prog) "/."
(basename prog) "-real")))
(copy-file prog prog-real)
prog-real)
(wrapper-file-name number)))
(let* ((number (next-wrapper-number))
(target (wrapper-target number))
(wrapper (wrapper-file-name (1+ number)))
(prog-tmp (string-append target "-tmp")))
(define (export-variable lst) (define (export-variable lst)
;; Return a string that exports an environment variable. ;; Return a string that exports an environment variable.
(match lst (match lst
@ -735,8 +757,6 @@ modules in $GUILE_LOAD_PATH, etc."
(format #f "export ~a=\"$~a${~a:+:}~a\"" (format #f "export ~a=\"$~a${~a:+:}~a\""
var var var (string-join rest ":"))))) var var var (string-join rest ":")))))
(copy-file prog prog-real)
(with-output-to-file prog-tmp (with-output-to-file prog-tmp
(lambda () (lambda ()
(format #t (format #t
@ -744,9 +764,11 @@ modules in $GUILE_LOAD_PATH, etc."
(which "bash") (which "bash")
(string-join (map export-variable vars) (string-join (map export-variable vars)
"\n") "\n")
(canonicalize-path prog-real)))) (canonicalize-path target))))
(chmod prog-tmp #o755) (chmod prog-tmp #o755)
(rename-file prog-tmp wrapper)
(symlink wrapper prog-tmp)
(rename-file prog-tmp prog))) (rename-file prog-tmp prog)))
;;; Local Variables: ;;; Local Variables:

View File

@ -18,9 +18,24 @@
(define-module (test-build-utils) (define-module (test-build-utils)
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (srfi srfi-64)) #:use-module (guix packages)
#:use-module (guix build-system)
#:use-module (guix build-system trivial)
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
#:use-module (rnrs io ports)
#:use-module (ice-9 popen))
(define %store
(open-connection-for-tests))
(test-begin "build-utils") (test-begin "build-utils")
(test-equal "alist-cons-before" (test-equal "alist-cons-before"
@ -80,6 +95,46 @@
port port
cons))))) cons)))))
(test-assert "wrap-program, one input, multiple calls"
(let* ((p (package
(name "test-wrap-program") (version "0") (source #f)
(synopsis #f) (description #f) (license #f) (home-page #f)
(build-system trivial-build-system)
(arguments
`(#:guile ,%bootstrap-guile
#:modules ((guix build utils))
#:builder
(let* ((out (assoc-ref %outputs "out"))
(bash (assoc-ref %build-inputs "bash"))
(foo (string-append out "/foo")))
(begin
(use-modules (guix build utils))
(mkdir out)
(call-with-output-file foo
(lambda (p)
(format p
"#!~a~%echo \"${GUIX_FOO} ${GUIX_BAR}\"~%"
bash)))
(chmod foo #o777)
;; wrap-program uses `which' to find bash for the wrapper
;; shebang, but it can't know about the bootstrap bash in
;; the store, since it's not named "bash". Help it out a
;; bit by providing a symlink it this package's output.
(symlink bash (string-append out "/bash"))
(setenv "PATH" out)
(wrap-program foo `("GUIX_FOO" prefix ("hello")))
(wrap-program foo `("GUIX_BAR" prefix ("world")))
#t))))
(inputs `(("bash" ,(search-bootstrap-binary "bash"
(%current-system)))))))
(d (package-derivation %store p)))
(and (build-derivations %store (pk 'drv d (list d)))
(let* ((p (derivation->output-path d))
(foo (string-append p "/foo"))
(pipe (open-input-pipe foo))
(str (get-string-all pipe)))
(equal? str "hello world\n")))))
(test-end) (test-end)