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

Merge branch 'master' into core-updates

Browse source
This commit is contained in:
Mark H Weaver 2015-01-13 12:14:08 -05:00
commit a813710a5f
23 changed files with 637 additions and 269 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Makefile.am
View file

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
# Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
#
# This file is part of GNU Guix.
@ -34,6 +34,7 @@ MODULES = \
guix/pk-crypto.scm \
guix/pki.scm \
guix/utils.scm \
guix/sets.scm \
guix/download.scm \
guix/git-download.scm \
guix/monads.scm \
@ -153,6 +154,7 @@ SCM_TESTS = \
tests/hash.scm \
tests/pk-crypto.scm \
tests/pki.scm \
tests/sets.scm \
tests/substitute-binary.scm \
tests/builders.scm \
tests/derivations.scm \

44
doc/guix.texi
View file

@ -124,7 +124,7 @@ Utilities
GNU Distribution
* System Installation:: Installing the whole operating system.
* System Configuration:: Configuring a GNU system.
* System Configuration:: Configuring the operating system.
* Installing Debugging Files:: Feeding the debugger.
* Security Updates:: Deploying security fixes quickly.
* Package Modules:: Packages from the programmer's viewpoint.
@ -3233,13 +3233,23 @@ build} supports (@pxref{Invoking guix build, common build options}).
@node GNU Distribution
@chapter GNU Distribution
@cindex Guixotic
Guix comes with a distribution of free software@footnote{The term
``free'' here refers to the
@url{http://www.gnu.org/philosophy/free-sw.html,freedom provided to
users of that software}.} that forms the basis of the GNU system. This
includes core GNU packages such as GNU libc, GCC, and Binutils, as well
as many GNU and non-GNU applications. The complete list of available
packages can be browsed
users of that software}.} that forms the basis of the GNU system. The
distribution can be installed on its own (@pxref{System Installation}),
but it is also possible to install Guix as a package manager on top of
an installed GNU/Linux system (@pxref{Installation}). To distinguish
between the two, we refer to the standalone distribution as
``Guixotic''@footnote{``How am I going to pronounce that name?'', you
may ask. Well, we would pronounce it like ``geeks-otic'', for
consistency with Guix---which is quite different from the usual
pronunciation of ``quixotic''.}.
The distribution provides core GNU packages such as GNU libc, GCC, and
Binutils, as well as many GNU and non-GNU applications. The complete
list of available packages can be browsed
@url{http://www.gnu.org/software/guix/package-list.html,on-line} or by
running @command{guix package} (@pxref{Invoking guix package}):
@ -3247,7 +3257,7 @@ running @command{guix package} (@pxref{Invoking guix package}):
guix package --list-available
@end example
Our goal is to build a practical 100% free software distribution of
Our goal has been to provide a practical 100% free software distribution of
Linux-based and other variants of GNU, with a focus on the promotion and
tight integration of GNU components, and an emphasis on programs and
tools that help users exert that freedom.
@ -3278,7 +3288,7 @@ For information on porting to other architectures or kernels,
@menu
* System Installation:: Installing the whole operating system.
* System Configuration:: Configuring a GNU system.
* System Configuration:: Configuring the operating system.
* Installing Debugging Files:: Feeding the debugger.
* Security Updates:: Deploying security fixes quickly.
* Package Modules:: Packages from the programmer's viewpoint.
@ -3293,9 +3303,11 @@ to join! @xref{Contributing}, for information about how you can help.
@node System Installation
@section System Installation
This section explains how to install the complete GNU operating system
on a machine. The Guix package manager can also be installed on top of
a running GNU/Linux system, @pxref{Installation}.
@cindex Guixotic
This section explains how to install the standalone distribution,
code-named ``Guixotic'', on a machine. The Guix package manager can
also be installed on top of a running GNU/Linux system,
@pxref{Installation}.
@ifinfo
@c This paragraph is for people reading this from tty2 of the
@ -3308,13 +3320,13 @@ link that follows: @pxref{Help,,, info, Info: An Introduction}. Hit
@subsection Limitations
As of version @value{VERSION}, GNU@tie{}Guix and the GNU system
distribution are alpha software. It may contain bugs and lack important
As of version @value{VERSION}, GNU@tie{}Guix and Guixotic are
not production-ready. They may contain bugs and lack important
features. Thus, if you are looking for a stable production system that
respects your freedom as a computer user, a good solution at this point
is to consider @url{http://www.gnu.org/distros/free-distros.html, one of
more established GNU/Linux distributions}. We hope you can soon switch
to the GNU system without fear, of course. In the meantime, you can
to Guixotic without fear, of course. In the meantime, you can
also keep using your distribution and try out the package manager on top
of it (@pxref{Installation}).
@ -3498,7 +3510,7 @@ about the installation image.
@section System Configuration
@cindex system configuration
The GNU system supports a consistent whole-system configuration
Guixotic supports a consistent whole-system configuration
mechanism. By that we mean that all aspects of the global system
configuration---such as the available system services, timezone and
locale settings, user accounts---are declared in a single place. Such
@ -4639,7 +4651,7 @@ The type of an entry in the GRUB boot menu.
@table @asis
@item @code{label}
The label to show in the menu---e.g., @code{"GNU System"}.
The label to show in the menu---e.g., @code{"GNU"}.
@item @code{linux}
The Linux kernel to boot.
@ -4709,7 +4721,7 @@ This action does not actually install anything.
@item init
Populate the given directory with all the files necessary to run the
operating system specified in @var{file}. This is useful for first-time
installations of the GNU system. For instance:
installations of Guixotic. For instance:
@example
guix system init my-os-config.scm /mnt

1
gnu-system.am
View file

@ -277,7 +277,6 @@ GNU_SYSTEM_MODULES = \
gnu/packages/wv.scm \
gnu/packages/xfig.scm \
gnu/packages/xiph.scm \
gnu/packages/xlockmore.scm \
gnu/packages/xml.scm \
gnu/packages/xnee.scm \
gnu/packages/xdisorg.scm \

10
gnu/packages/algebra.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012, 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
@ -83,14 +83,14 @@ (define-public fplll
(define-public pari-gp
(package
(name "pari-gp")
(version "2.7.1")
(version "2.7.2")
(source (origin
(method url-fetch)
(uri (string-append
"http://pari.math.u-bordeaux.fr/pub/pari/unix/pari-"
version ".tar.gz"))
(sha256 (base32
"1gj1rddi22hinzwy7r6hljgbi252wwwyd6gapg4hvcn0ycc7jqyc"))))
"1b0hzyhafpxhmiljyhnsh6c27ydsvb2599fshwq2fjfm96awjxmc"))))
(build-system gnu-build-system)
(inputs `(("gmp" ,gmp)
("perl" ,perl)
@ -123,14 +123,14 @@ (define-public pari-gp
(define-public gp2c
(package
(name "gp2c")
(version "0.0.9pl1")
(version "0.0.9pl2")
(source (origin
(method url-fetch)
(uri (string-append
"http://pari.math.u-bordeaux.fr/pub/pari/GP2C/gp2c-"
version ".tar.gz"))
(sha256 (base32
"1p36060vwhn38j77r4c3jqyaslvhvgm6fdw2486k7krxk5ai7ph5"))))
"02h35fwz1caicii7fj8zb9ky4hcrd8rqmzkyvhbls0r05yg5bwwb"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)))
(inputs `(("pari-gp" ,pari-gp)))

71
gnu/packages/gnome.scm
View file

@ -209,19 +209,7 @@ (define-public evince
;; FIXME: Tests fail with:
;; ImportError: No module named gi.repository
;; Where should that module come from?
#:tests? #f
#:phases (alist-cons-after
'install 'set-mime-search-path
(lambda* (#:key inputs outputs #:allow-other-keys)
;; Wrap 'evince' so that it knows where MIME info is.
(let ((out (assoc-ref outputs "out"))
(mime (assoc-ref inputs "shared-mime-info")))
(wrap-program (string-append out "/bin/evince")
`("XDG_DATA_DIRS" ":" prefix
,(list (string-append mime "/share")
(string-append out "/share"))))))
%standard-phases)))
#:tests? #f))
(inputs
`(("libspectre" ,libspectre)
;; ("djvulibre" ,djvulibre)
@ -240,7 +228,9 @@ (define-public evince
("libsm" ,libsm)
("libice" ,libice)
("shared-mime-info" ,shared-mime-info)
("dconf" ,dconf)
("libcanberra" ,libcanberra)
;; For tests.
("dogtail" ,python2-dogtail)))
(native-inputs
@ -1381,3 +1371,56 @@ (define-public vte/gtk+-2
(propagated-inputs
`(("gtk+" ,gtk+-2) ; required by libvte.pc
("ncurses" ,ncurses))))) ; required by libvte.la
(define-public dconf
(package
(name "dconf")
(version "0.22.0")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://gnome/sources/" name "/"
(version-major+minor version) "/"
name "-" version ".tar.xz"))
(sha256
(base32 "13jb49504bir814v8n8vjip5sazwfwsrnniw87cpg7phqfq7q9qa"))))
(build-system glib-or-gtk-build-system)
(inputs
`(("gtk+" ,gtk+)
("glib" ,glib)
("dbus" ,dbus)
("libxml2" ,libxml2)))
(native-inputs
`(("libxslt" ,libxslt)
("docbook-xml" ,docbook-xml-4.2)
("docbook-xsl" ,docbook-xsl)
("intltool" ,intltool)
("pkg-config" ,pkg-config)))
(arguments
`(#:tests? #f ; To contact dbus it needs to load /var/lib/dbus/machine-id
; or /etc/machine-id.
#:configure-flags
;; Set the correct RUNPATH in binaries.
(list (string-append "LDFLAGS=-Wl,-rpath="
(assoc-ref %outputs "out") "/lib")
"--disable-gtk-doc-html") ; FIXME: requires gtk-doc
#:phases
(alist-cons-before
'configure 'fix-docbook
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "docs/Makefile.in"
(("http://docbook.sourceforge.net/release/xsl/current/manpages/docbook.xsl")
(string-append (assoc-ref inputs "docbook-xsl")
"/xml/xsl/docbook-xsl-"
,(package-version docbook-xsl)
"/manpages/docbook.xsl")))
(setenv "XML_CATALOG_FILES"
(string-append (assoc-ref inputs "docbook-xml")
"/xml/dtd/docbook/catalog.xml")))
%standard-phases)))
(home-page "https://developer.gnome.org/dconf")
(synopsis "Low-level GNOME configuration system")
(description "Dconf is a low-level configuration system. Its main purpose
is to provide a backend to GSettings on platforms that don't already have
configuration storage systems.")
(license license:lgpl2.1)))

31
gnu/packages/libcanberra.scm
View file

@ -19,6 +19,7 @@
(define-module (gnu packages libcanberra)
#:use-module ((guix licenses) #:select (lgpl2.1+))
#:use-module (gnu packages)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
@ -46,7 +47,21 @@ (define-public libcanberra
version ".tar.xz"))
(sha256
(base32
"0wps39h8rx2b00vyvkia5j40fkak3dpipp1kzilqla0cgvk73dn2"))))
"0wps39h8rx2b00vyvkia5j40fkak3dpipp1kzilqla0cgvk73dn2"))
;; "sound-theme-freedesktop" is the default and fall-back sound theme for
;; XDG desktops and should always be present.
;; http://www.freedesktop.org/wiki/Specifications/sound-theme-spec/
;; We make sure libcanberra will find it.
;;
;; We add the default sounds store directory to the code dealing with
;; XDG_DATA_DIRS and not XDG_DATA_HOME. This is because XDG_DATA_HOME
;; can only be a single directory and is inspected first. XDG_DATA_DIRS
;; can list an arbitrary number of directories and is only inspected
;; later. This is designed to allows the user to modify any theme at
;; his pleasure.
(patch-flags '("-p0"))
(patches
(list (search-patch "libcanberra-sound-theme-freedesktop.patch")))))
(build-system gnu-build-system)
(inputs
`(("alsa-lib" ,alsa-lib)
@ -55,9 +70,21 @@ (define-public libcanberra
("libltdl" ,libltdl)
("libvorbis" ,libvorbis)
("pulseaudio" ,pulseaudio)
("udev" ,eudev)))
("udev" ,eudev)
("sound-theme-freedesktop" ,sound-theme-freedesktop)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(arguments
`(#:phases
(alist-cons-before
'build 'patch-default-sounds-directory
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "src/sound-theme-spec.c"
(("@SOUND_THEME_DIRECTORY@")
(string-append
(assoc-ref inputs "sound-theme-freedesktop")
"/share"))))
%standard-phases)))
(home-page "http://0pointer.de/lennart/projects/libcanberra/")
(synopsis
"Implementation of the XDG Sound Theme and Name Specifications")

30
gnu/packages/linux.scm
View file

@ -905,7 +905,7 @@ (define-public bridge-utils
(define-public libnl
(package
(name "libnl")
(version "3.2.13")
(version "3.2.25")
(source (origin
(method url-fetch)
(uri (string-append
@ -913,7 +913,7 @@ (define-public libnl
version ".tar.gz"))
(sha256
(base32
"1ydw42lsd572qwrfgws97n76hyvjdpanwrxm03lysnhfxkna1ssd"))))
"1icfrv8yihcb74as1gcgmp0wfpdq632q2zvbvqqvjms9cy87bswb"))))
(build-system gnu-build-system)
(native-inputs `(("flex" ,flex) ("bison" ,bison)))
(home-page "http://www.infradead.org/~tgr/libnl/")
@ -929,6 +929,32 @@ (define-public libnl
;; 'nl-addr-add.c'), so the result is GPLv2-only.
(license gpl2)))
(define-public iw
(package
(name "iw")
(version "3.17")
(source (origin
(method url-fetch)
(uri (string-append
"https://www.kernel.org/pub/software/network/iw/iw-"
version ".tar.xz"))
(sha256
(base32
"14zsapqhivk0ws5z21y1ys2c2czi05mzk7bl2yb7qxcfrnsjx9j8"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
(inputs `(("libnl" ,libnl)))
(arguments
`(#:make-flags (list (string-append "PREFIX=" (assoc-ref %outputs "out"))
"CC=gcc")
#:phases (alist-delete 'configure %standard-phases)))
(home-page "http://wireless.kernel.org/en/users/Documentation/iw")
(synopsis "Tool for configuring wireless devices")
(description
"iw is a new nl80211 based CLI configuration utility for wireless
devices. It replaces 'iwconfig', which is deprecated.")
(license isc)))
(define-public powertop
(package
(name "powertop")

22
gnu/packages/patches/libcanberra-sound-theme-freedesktop.patch Normal file
View file

@ -0,0 +1,22 @@
# We insert a hook called "@SOUND_THEME_DIRECTORY@" where, at build time, we
# insert the directory of the package "sound-theme-freedesktop" in the store.
--- src/sound-theme-spec.c.orig 2015-01-11 13:13:29.520527358 +0100
+++ src/sound-theme-spec.c 2015-01-11 14:27:23.035046849 +0100
@@ -321,9 +321,13 @@
const char *g;
if (!(g = getenv("XDG_DATA_DIRS")) || *g == 0)
- return "/usr/local/share:/usr/share";
-
- return g;
+ return "@SOUND_THEME_DIRECTORY@";
+ else {
+ const char *stp = ":@SOUND_THEME_DIRECTORY@";
+ size_t len = strlen(stp) + strlen(g) + 1;
+ char *g2 = (char*) malloc(len);
+ return strcat(strcpy(g2, g), stp);
+ }
}
static int load_theme_dir(ca_theme_data *t, const char *name) {

42
gnu/packages/pdf.scm
View file

@ -37,6 +37,8 @@ (define-module (gnu packages pdf)
#:use-module (gnu packages gtk)
#:use-module (gnu packages lua)
#:use-module (gnu packages curl)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (srfi srfi-1))
(define-public poppler
@ -238,3 +240,43 @@ (define-public mupdf
line tools for batch rendering (pdfdraw), examining the file structure
(pdfshow), and rewriting files (pdfclean).")
(license license:agpl3+)))
(define-public qpdf
(package
(name "qpdf")
(version "5.1.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/qpdf/qpdf-"
version ".tar.gz"))
(sha256 (base32
"1zbvhrp0zjzbi6q2bnbxbg6399r47pq5gw3kspzph81j19fqvpg9"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-before
'configure 'patch-paths
(lambda _
(substitute* "make/libtool.mk"
(("SHELL=/bin/bash")
(string-append "SHELL=" (which "bash"))))
(substitute* (append
'("qtest/bin/qtest-driver")
(find-files "." "\\.test"))
(("/usr/bin/env") (which "env"))))
%standard-phases)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(propagated-inputs
`(("pcre" ,pcre)))
(inputs
`(("zlib" ,zlib)
("perl" ,perl)))
(synopsis "Command-line tools and library for transforming PDF files")
(description
"QPDF is a command-line program that does structural, content-preserving
transformations on PDF files. It could have been called something like
pdf-to-pdf. It includes support for merging and splitting PDFs and to
manipulate the list of pages in a PDF file. It is not a PDF viewer or a
program capable of converting PDF into other formats.")
(license license:clarified-artistic)
(home-page "http://qpdf.sourceforge.net/")))

8
gnu/packages/video.scm
View file

@ -58,14 +58,14 @@ (define-module (gnu packages video)
(define-public ffmpeg
(package
(name "ffmpeg")
(version "2.4.3")
(version "2.5.3")
(source (origin
(method url-fetch)
(uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-"
version ".tar.bz2"))
(sha256
(base32
"00p6qi7kwc2rv7h98bczrdssa7nbda3fpz7avjwl77jg1qy3wp6a"))))
"06j1cgw9h9ya5z8gpcf9v9zik3l4xz7sr4wshj06kznzz5z3sf4x"))))
(build-system gnu-build-system)
(inputs
`(("fontconfig" ,fontconfig)
@ -199,14 +199,14 @@ (define-public ffmpeg
;; We need this older ffmpeg because vlc-2.1.5 doesn't work with ffmpeg-2.4.
(define-public ffmpeg-2.2
(package (inherit ffmpeg)
(version "2.2.10")
(version "2.2.11")
(source (origin
(method url-fetch)
(uri (string-append "http://www.ffmpeg.org/releases/ffmpeg-"
version ".tar.bz2"))
(sha256
(base32
"14d83ijp5lxdr6nl9rqhc4598jp020paxrg64r9ifxqhbigl0yqm"))))))
"06sli7xvihh97ss6a2mkdq4dcj3rg1w8zffrmjfc1hvyjxhc8f2r"))))))
(define-public vlc
(package

33
gnu/packages/xdisorg.scm
View file

@ -3,6 +3,7 @@
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -30,6 +31,7 @@ (define-module (gnu packages xdisorg)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages glib)
#:use-module (gnu packages perl)
#:use-module (gnu packages linux)
#:use-module (gnu packages xorg))
;; packages outside the x.org system proper
@ -359,3 +361,34 @@ (define-public unclutter
xedit, for example. The human factors crowd would agree it should make
things less distracting.")
(license license:public-domain)))
(define-public xlockmore
(package
(name "xlockmore")
(version "5.45")
(source (origin
(method url-fetch)
(uri (string-append "http://www.tux.org/~bagleyd/xlock/xlockmore-"
version "/xlockmore-" version ".tar.bz2"))
(sha256
(base32
"1xqm61bbfn5q056w57vp16gvai8nqpcw570ysxlm5h46nh6ai0bz"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags (list (string-append "--enable-appdefaultdir="
(assoc-ref %outputs "out")
"/lib/X11/app-defaults"))
#:tests? #f)) ;no such thing as a test suite
(inputs
`(("libX11" ,libx11)
("libXext" ,libxext)
("libXt" ,libxt)
("linux-pam" ,linux-pam)))
(home-page "http://www.tux.org/~bagleyd/xlockmore.html")
(synopsis "Screen locker for the X Window System")
(description
"XLockMore is a classic screen locker and screen saver for the
X Window System.")
(license (license:bsd-style #f "See xlock.c.")
;; + GPLv2 in modes/glx/biof.c.
)))

52
gnu/packages/xlockmore.scm
View file

@ -1,52 +0,0 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages xlockmore)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (guix licenses)
#:use-module (gnu packages xorg)
#:use-module (gnu packages linux))
(define-public xlockmore
(package
(name "xlockmore")
(version "5.42")
(source (origin
(method url-fetch)
(uri (string-append "http://www.tux.org/~bagleyd/xlock/xlockmore-"
version "/xlockmore-" version ".tar.bz2"))
(sha256
(base32
"17xicps92ah9377zk65k9l1bmvzzj3bpxzzwxx21g9696l71gr0z"))))
(build-system gnu-build-system)
(arguments '(#:tests? #f)) ; no such thing as a test suite
(inputs
`(("libX11" ,libx11)
("libXext" ,libxext)
("libXt" ,libxt)
("linux-pam" ,linux-pam)))
(home-page "http://www.tux.org/~bagleyd/xlockmore.html")
(synopsis "Screen locker for the X Window System")
(description
"XLockMore is a classic screen locker and screen saver for the
X Window System.")
(license (bsd-style #f "See xlock.c.")
;; + GPLv2 in modes/glx/biof.c.
)))

10
gnu/services/base.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -232,13 +232,7 @@ (define omitted-pids
(define lset= (@ (srfi srfi-1) lset=))
;; When this happens, all the processes have been
;; killed, including 'deco', so DMD-OUTPUT-PORT and
;; thus CURRENT-OUTPUT-PORT are dangling.
(call-with-output-file "/dev/console"
(lambda (port)
(display "sending all processes the TERM signal\n"
port)))
(display "sending all processes the TERM signal\n")
(if (null? omitted-pids)
(begin

30
guix/build-system/glib-or-gtk.scm
View file

@ -34,15 +34,14 @@ (define-module (guix build-system glib-or-gtk)
;; This build system is an extension of the 'gnu-build-system'. It
;; accomodates the needs of applications making use of glib or gtk+ (with "or"
;; to be interpreted in the mathematical sense). This is achieved by adding
;; two phases run after the 'install' phase:
;; three phases run after the 'install' phase:
;;
;; 'glib-or-gtk-wrap' phase:
;;
;; a) This phase looks for GSettings schemas by verifying the existence of
;; path "datadir/glib-2.0/schemas" in all input packages. If the path is
;; found in any package, then all programs in "out/bin" are wrapped in scripts
;; where the environment variable "XDG_DATA_DIRS" is set and points to the
;; list of found schemas directories.
;; a) This phase looks for GSettings schemas, GIO modules and theming data.
;; If any of these is found in any input package, then all programs in
;; "out/bin" are wrapped in scripts defining the nedessary environment
;; variables.
;;
;; b) Looks for the existence of "libdir/gtk-3.0" directories in all input
;; packages. If any is found, then the environment variable "GTK_PATH" is
@ -56,6 +55,11 @@ (define-module (guix build-system glib-or-gtk)
;; exists and does not include a file named "gschemas.compiled", then
;; "glib-compile-schemas" is run in that directory.
;;
;; 'glib-or-gtk-icon-cache' phase:
;;
;; Looks for the existence of icon themes and, if no cache exists, generate
;; the "icon-theme.cache" file.
;;
;; Code:
(define %default-modules
@ -76,15 +80,22 @@ (define (default-glib)
(let ((module (resolve-interface '(gnu packages glib))))
(module-ref module 'glib)))
(define (default-gtk+)
"Return the default gtk+ package from which we use
\"gtk-update-icon-cache\"."
(let ((module (resolve-interface '(gnu packages gtk))))
(module-ref module 'gtk+)))
(define* (lower name
#:key source inputs native-inputs outputs system target
(glib (default-glib)) (implicit-inputs? #t)
(glib (default-glib)) (gtk+ (default-gtk+))
(implicit-inputs? #t)
(strip-binaries? #t)
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
'(#:source #:target #:glib #:inputs #:native-inputs
'(#:source #:target #:glib #:gtk+ #:inputs #:native-inputs
#:outputs #:implicit-inputs?))
(and (not target) ;XXX: no cross-compilation
@ -95,7 +106,8 @@ (define private-keywords
`(("source" ,source))
'())
,@inputs))
(build-inputs `(("glib:bin" ,glib)
(build-inputs `(("glib:bin" ,glib "bin") ; to compile schemas
("gtk+" ,gtk+) ; to generate icon cache
,@(if implicit-inputs?
(standard-packages)
'())

139
guix/build/glib-or-gtk-build-system.scm
View file

@ -22,6 +22,7 @@ (define-module (guix build glib-or-gtk-build-system)
#:use-module (guix build utils)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 ftw)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%standard-phases
@ -41,6 +42,9 @@ (define (directory-included? directory directories-list)
(fold (lambda (s p) (or (string-ci=? s directory) p))
#f directories-list))
;; We do not include $HOME/.guix-profile/gtk-v.0 (v=2 or 3) because we do not
;; want to mix gtk+-2 and gtk+-3 modules. See
;; https://developer.gnome.org/gtk3/stable/gtk-running.html
(define (gtk-module-directories inputs)
"Check for the existence of \"libdir/gtk-v.0\" in INPUTS. Return a list
with all found directories."
@ -64,20 +68,60 @@ (define (gtk-module-directories inputs)
prev)))))
(fold gtk-module '() inputs)))
(define (schemas-directories inputs)
"Check for the existence of \"datadir/glib-2.0/schemas\" in INPUTS. Return
a list with all found directories."
(define (glib-schemas input previous)
;; See
;; http://www.freedesktop.org/wiki/DesktopThemeSpec
;; http://freedesktop.org/wiki/Specifications/sound-theme-spec
;; http://freedesktop.org/wiki/Specifications/icon-theme-spec
;;
;; Currently desktop themes are not well supported and do not honor
;; XDG_DATA_DIRS. One example is evince which only looks for desktop themes
;; in $HOME/.themes (for backward compatibility) and in XDG_DATA_HOME (which
;; defaults to $HOME/.local/share). One way to handle these applications
;; appears to be by making $HOME/.themes a symlink to
;; $HOME/.guix-profile/share/themes.
(define (data-directories inputs)
"Check for the existence of \"$datadir/glib-2.0/schemas\" or XDG themes data
in INPUTS. Return a list with all found directories."
(define (data-directory input previous)
(let* ((in (match input
((_ . dir) dir)
(_ "")))
(datadir (string-append in "/share")))
(if (and (subdirectory-exists? datadir "/glib-2.0/schemas")
(if (and (or (subdirectory-exists? datadir "/glib-2.0/schemas")
(subdirectory-exists? datadir "/sounds")
(subdirectory-exists? datadir "/themes")
(subdirectory-exists? datadir "/cursors")
(subdirectory-exists? datadir "/wallpapers")
(subdirectory-exists? datadir "/icons"))
(not (directory-included? datadir previous)))
(cons datadir previous)
previous)))
(fold glib-schemas '() inputs))
(fold data-directory '() inputs))
;; All GIO modules are expected to be installed in GLib's $libdir/gio/modules
;; directory. That directory has to include a file called giomodule.cache
;; listing all available modules. GIO can be made aware of modules in other
;; directories with the help of the environment variable GIO_EXTRA_MODULES.
;; The official GIO documentation states that this environment variable should
;; only be used for testing and not in a production environment. However, it
;; appears that there is no other way of specifying multiple modules
;; directories (NIXOS also does use this variable). See
;; https://developer.gnome.org/gio/stable/running-gio-apps.html
(define (gio-module-directories inputs)
"Check for the existence of \"$libdir/gio/modules\" in the INPUTS and
returns a list with all found directories."
(define (gio-module-directory input previous)
(let* ((in (match input
((_ . dir) dir)
(_ "")))
(gio-mod-dir (string-append in "/lib/gio/modules")))
(if (and (directory-exists? gio-mod-dir)
(not (directory-included? gio-mod-dir previous)))
(cons gio-mod-dir previous)
previous)))
(fold gio-module-directory '() inputs))
(define* (wrap-all-programs #:key inputs outputs
(glib-or-gtk-wrap-excluded-outputs '())
@ -96,27 +140,57 @@ (define handle-output
(unless (member output glib-or-gtk-wrap-excluded-outputs)
(let* ((bindir (string-append directory "/bin"))
(bin-list (find-files bindir ".*"))
(schemas (schemas-directories
(datadirs (data-directories
(alist-cons output directory inputs)))
(gtk-mod-dirs (gtk-module-directories
(alist-cons output directory inputs)))
(schemas-env-var
(if (not (null? schemas))
`("XDG_DATA_DIRS" ":" prefix ,schemas)
(gio-mod-dirs (gio-module-directories
(alist-cons output directory inputs)))
(data-env-var
(if (not (null? datadirs))
`("XDG_DATA_DIRS" ":" prefix ,datadirs)
#f))
(gtk-mod-env-var
(if (not (null? gtk-mod-dirs))
`("GTK_PATH" ":" prefix ,gtk-mod-dirs)
#f))
(gio-mod-env-var
(if (not (null? gio-mod-dirs))
`("GIO_EXTRA_MODULES" ":" prefix ,gio-mod-dirs)
#f)))
(cond
((and schemas-env-var gtk-mod-env-var)
(for-each (cut wrap-program <> schemas-env-var gtk-mod-env-var)
((and data-env-var gtk-mod-env-var gio-mod-env-var)
(for-each (cut wrap-program <>
data-env-var
gtk-mod-env-var
gio-mod-env-var)
bin-list))
(schemas-env-var
(for-each (cut wrap-program <> schemas-env-var)
((and data-env-var gtk-mod-env-var (not gio-mod-env-var))
(for-each (cut wrap-program <>
data-env-var
gtk-mod-env-var)
bin-list))
(gtk-mod-env-var
(for-each (cut wrap-program <> gtk-mod-env-var)
((and data-env-var (not gtk-mod-env-var) gio-mod-env-var)
(for-each (cut wrap-program <>
data-env-var
gio-mod-env-var)
bin-list))
((and (not data-env-var) gtk-mod-env-var gio-mod-env-var)
(for-each (cut wrap-program <>
gio-mod-env-var
gtk-mod-env-var)
bin-list))
((and data-env-var (not gtk-mod-env-var) (not gio-mod-env-var))
(for-each (cut wrap-program <>
data-env-var)
bin-list))
((and (not data-env-var) gtk-mod-env-var (not gio-mod-env-var))
(for-each (cut wrap-program <>
gtk-mod-env-var)
bin-list))
((and (not data-env-var) (not gtk-mod-env-var) gio-mod-env-var)
(for-each (cut wrap-program <>
gio-mod-env-var)
bin-list))))))))
(for-each handle-output outputs)
@ -136,12 +210,41 @@ (define* (compile-glib-schemas #:key outputs #:allow-other-keys)
#t))))
outputs))
(define* (generate-icon-cache #:key outputs #:allow-other-keys)
"Implement phase \"glib-or-gtk-icon-cache\": generate icon cache if
needed."
(every (match-lambda
((output . directory)
(let ((iconsdir (string-append directory
"/share/icons")))
(when (file-exists? iconsdir)
(with-directory-excursion iconsdir
(for-each
(lambda (dir)
(unless (file-exists?
(string-append iconsdir "/" dir "/"
"icon-theme.cache"))
(system* "gtk-update-icon-cache"
"--ignore-theme-index"
(string-append iconsdir "/" dir))))
(scandir "."
(lambda (name)
(and
(not (equal? name "."))
(not (equal? name ".."))
(equal? 'directory
(stat:type (stat name)))))))))
#t)))
outputs))
(define %standard-phases
(alist-cons-after
'install 'glib-or-gtk-wrap wrap-all-programs
(alist-cons-after
'install 'glib-or-gtk-compile-schemas compile-glib-schemas
gnu:%standard-phases)))
'install 'glib-or-gtk-icon-cache generate-icon-cache
(alist-cons-after
'install 'glib-or-gtk-compile-schemas compile-glib-schemas
gnu:%standard-phases))))
(define* (glib-or-gtk-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)

25
guix/derivations.scm
View file

@ -31,6 +31,7 @@ (define-module (guix derivations)
#:use-module (guix hash)
#:use-module (guix base32)
#:use-module (guix records)
#:use-module (guix sets)
#:export (<derivation>
derivation?
derivation-outputs
@ -162,16 +163,18 @@ (define (derivation-input-output-paths input)
(define (derivation-prerequisites drv)
"Return the list of derivation-inputs required to build DRV, recursively."
(let loop ((drv drv)
(result '()))
(let ((inputs (remove (cut member <> result) ; XXX: quadratic
(let loop ((drv drv)
(result '())
(input-set (set)))
(let ((inputs (remove (cut set-contains? input-set <>)
(derivation-inputs drv))))
(fold loop
(append inputs result)
(map (lambda (i)
(call-with-input-file (derivation-input-path i)
read-derivation))
inputs)))))
(fold2 loop
(append inputs result)
(fold set-insert input-set inputs)
(map (lambda (i)
(call-with-input-file (derivation-input-path i)
read-derivation))
inputs)))))
(define (offloadable-derivation? drv)
"Return true if DRV can be offloaded, false otherwise."
@ -214,8 +217,8 @@ (define* (substitution-oracle store drv)
(append self deps result)))
'()
drv)))
(subst (substitutable-paths store paths)))
(cut member <> subst)))
(subst (list->set (substitutable-paths store paths))))
(cut set-contains? subst <>)))
(define* (derivation-prerequisites-to-build store drv
#:key

17
guix/gexp.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -33,7 +33,8 @@ (define-module (guix gexp)
gexp?
gexp->derivation
gexp->file
gexp->script))
gexp->script
text-file*))
;;; Commentary:
;;;
@ -522,6 +523,18 @@ (define (gexp->file name exp)
(write '(ungexp exp) port))))
#:local-build? #t))
(define* (text-file* name #:rest text)
"Return as a monadic value a derivation that builds a text file containing
all of TEXT. TEXT may list, in addition to strings, packages, derivations,
and store file names; the resulting store file holds references to all these."
(define builder
(gexp (call-with-output-file (ungexp output "out")
(lambda (port)
(display (string-append (ungexp-splicing text)) port)))))
(gexp->derivation name builder))
;;;
;;; Syntactic sugar.

73
guix/monads.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -57,7 +57,6 @@ (define-module (guix monads)
store-lift
run-with-store
text-file
text-file*
interned-file
package-file
origin->derivation
@ -357,56 +356,6 @@ (define* (text-file name text)
(lambda (store)
(add-text-to-store store name text '())))
(define* (text-file* name #:rest text)
"Return as a monadic value a derivation that builds a text file containing
all of TEXT. TEXT may list, in addition to strings, packages, derivations,
and store file names; the resulting store file holds references to all these."
(define inputs
;; Transform packages and derivations from TEXT into a valid input list.
(filter-map (match-lambda
((? package? p) `("x" ,p))
((? derivation? d) `("x" ,d))
((x ...) `("x" ,@x))
((? string? s)
(and (direct-store-path? s) `("x" ,s)))
(x x))
text))
(define (computed-text text inputs)
;; Using the lowered INPUTS, return TEXT with derivations replaced with
;; their output file name.
(define (real-string? s)
(and (string? s) (not (direct-store-path? s))))
(let loop ((inputs inputs)
(text text)
(result '()))
(match text
(()
(string-concatenate-reverse result))
(((? real-string? head) rest ...)
(loop inputs rest (cons head result)))
((_ rest ...)
(match inputs
(((_ (? derivation? drv) sub-drv ...) inputs ...)
(loop inputs rest
(cons (apply derivation->output-path drv
sub-drv)
result)))
(((_ file) inputs ...)
;; FILE is the result of 'add-text-to-store' or so.
(loop inputs rest (cons file result))))))))
(define (builder inputs)
`(call-with-output-file (assoc-ref %outputs "out")
(lambda (port)
(display ,(computed-text text inputs) port))))
;; TODO: Rewrite using 'gexp->derivation'.
(mlet %store-monad ((inputs (lower-inputs inputs)))
(derivation-expression name (builder inputs)
#:inputs inputs)))
(define* (interned-file file #:optional name
#:key (recursive? #t))
"Return the name of FILE once interned in the store. Use NAME as its store
@ -440,26 +389,6 @@ (define compute-derivation
(string-append out "/" file)
out))))
(define (lower-inputs inputs)
"Turn any package from INPUTS into a derivation; return the corresponding
input list as a monadic value."
;; XXX: This procedure is bound to disappear with 'derivation-expression'.
(with-monad %store-monad
(sequence %store-monad
(map (match-lambda
((name (? package? package) sub-drv ...)
(mlet %store-monad ((drv (package->derivation package)))
(return `(,name ,drv ,@sub-drv))))
((name (? string? file))
(return `(,name ,file)))
(tuple
(return tuple)))
inputs))))
(define derivation-expression
;; XXX: This procedure is superseded by 'gexp->derivation'.
(store-lift build-expression->derivation))
(define package->derivation
(store-lift package-derivation))

116
guix/sets.scm Normal file
View file

@ -0,0 +1,116 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix sets)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:export (set
setq
set?
set-insert
set-union
set-contains?
set->list
list->set
list->setq))
;;; Commentary:
;;;
;;; A simple (simplistic?) implementation of unordered persistent sets based
;;; on vhashes that seems to be good enough so far.
;;;
;;; Another option would be to use "bounded balance trees" (Adams 1992) as
;;; implemented by Ian Price in 'pfds', which has faster union etc. but needs
;;; an order on the objects of the set.
;;;
;;; Code:
(define-record-type <set>
(%make-set vhash insert ref)
set?
(vhash set-vhash)
(insert set-insert-proc)
(ref set-ref))
(define %insert
(cut vhash-cons <> #t <>))
(define %insertq
(cut vhash-consq <> #t <>))
(define (set . args)
"Return a set containing the ARGS, compared as per 'equal?'."
(list->set args))
(define (setq . args)
"Return a set containing the ARGS, compared as per 'eq?'."
(list->setq args))
(define (list->set lst)
"Return a set with the elements taken from LST. Elements of the set will be
compared with 'equal?'."
(%make-set (fold %insert vlist-null lst)
%insert
vhash-assoc))
(define (list->setq lst)
"Return a set with the elements taken from LST. Elements of the set will be
compared with 'eq?'."
(%make-set (fold %insertq vlist-null lst)
%insertq
vhash-assq))
(define-inlinable (set-contains? set value)
"Return #t if VALUE is a member of SET."
(->bool ((set-ref set) value (set-vhash set))))
(define (set-insert value set)
"Insert VALUE into SET."
(if (set-contains? set value)
set
(let ((vhash ((set-insert-proc set) value (set-vhash set))))
(%make-set vhash (set-insert-proc set) (set-ref set)))))
(define-inlinable (set-size set)
"Return the number of elements in SET."
(vlist-length (set-vhash set)))
(define (set-union set1 set2)
"Return the union of SET1 and SET2. Warning: this is linear in the number
of elements of the smallest."
(unless (eq? (set-insert-proc set1) (set-insert-proc set2))
(error "set-union: incompatible sets"))
(let* ((small (if (> (set-size set1) (set-size set2))
set2 set1))
(large (if (eq? small set1) set2 set1)))
(vlist-fold (match-lambda*
(((item . _) result)
(set-insert item result)))
large
(set-vhash small))))
(define (set->list set)
"Return the list of elements of SET."
(map (match-lambda
((key . _) key))
(vlist->list (set-vhash set))))
;;; sets.scm ends here

26
tests/gexp.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -421,6 +421,30 @@ (define shebang
(return (and (zero? (close-pipe pipe))
(= (expt n 2) (string->number str)))))))
(test-assert "text-file*"
(let ((references (store-lift references)))
(run-with-store %store
(mlet* %store-monad
((drv (package->derivation %bootstrap-guile))
(guile -> (derivation->output-path drv))
(file (text-file "bar" "This is bar."))
(text (text-file* "foo"
%bootstrap-guile "/bin/guile "
`(,%bootstrap-guile "out") "/bin/guile "
drv "/bin/guile "
file))
(done (built-derivations (list text)))
(out -> (derivation->output-path text))
(refs (references out)))
;; Make sure we get the right references and the right content.
(return (and (lset= string=? refs (list guile file))
(equal? (call-with-input-file out get-string-all)
(string-append guile "/bin/guile "
guile "/bin/guile "
guile "/bin/guile "
file)))))
#:guile-for-build (package-derivation %store %bootstrap-guile))))
(test-assert "printer"
(string-match "^#<gexp \\(string-append .*#<package coreutils.*\
\"/bin/uname\"\\) [[:xdigit:]]+>$"

23
tests/lint.scm
View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -75,9 +75,20 @@ (define (http-write server client response body)
(quit #t) ;exit the server thread
(values)))
;; Mutex and condition variable to synchronize with the HTTP server.
(define %http-server-lock (make-mutex))
(define %http-server-ready (make-condition-variable))
(define (http-open . args)
"Start listening for HTTP requests and signal %HTTP-SERVER-READY."
(with-mutex %http-server-lock
(let ((result (apply (@@ (web server http) http-open) args)))
(signal-condition-variable %http-server-ready)
result)))
(define-server-impl stub-http-server
;; Stripped-down version of Guile's built-in HTTP server.
(@@ (web server http) http-open)
http-open
(@@ (web server http) http-read)
http-write
(@@ (web server http) http-close))
@ -97,9 +108,11 @@ (define (handle request body)
`(#:socket ,%http-server-socket)))
(const #t)))
(let* ((server (make-thread server-body)))
;; Normally SERVER exits automatically once it has received a request.
(thunk)))
(with-mutex %http-server-lock
(let ((server (make-thread server-body)))
(wait-condition-variable %http-server-ready %http-server-lock)
;; Normally SERVER exits automatically once it has received a request.
(thunk))))
(define-syntax-rule (with-http-server code body ...)
(call-with-http-server code (lambda () body ...)))

47
tests/monads.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -156,51 +156,6 @@ (define (g x)
(call-with-input-file b get-string-all))))
#:guile-for-build (package-derivation %store %bootstrap-guile)))
(define derivation-expression
(@@ (guix monads) derivation-expression))
(test-assert "mlet* + derivation-expression"
(run-with-store %store
(mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile"))
(gdrv (package->derivation %bootstrap-guile))
(exp -> `(let ((out (assoc-ref %outputs "out")))
(mkdir out)
(symlink ,guile
(string-append out "/guile-rocks"))))
(drv (derivation-expression "rocks" exp
#:inputs
`(("g" ,gdrv))))
(out -> (derivation->output-path drv))
(built? (built-derivations (list drv))))
(return (and built?
(equal? guile
(readlink (string-append out "/guile-rocks"))))))
#:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assert "text-file*"
(let ((references (store-lift references)))
(run-with-store %store
(mlet* %store-monad
((drv (package->derivation %bootstrap-guile))
(guile -> (derivation->output-path drv))
(file (text-file "bar" "This is bar."))
(text (text-file* "foo"
%bootstrap-guile "/bin/guile "
`(,%bootstrap-guile "out") "/bin/guile "
drv "/bin/guile "
file))
(done (built-derivations (list text)))
(out -> (derivation->output-path text))
(refs (references out)))
;; Make sure we get the right references and the right content.
(return (and (lset= string=? refs (list guile file))
(equal? (call-with-input-file out get-string-all)
(string-append guile "/bin/guile "
guile "/bin/guile "
guile "/bin/guile "
file)))))
#:guile-for-build (package-derivation %store %bootstrap-guile))))
(test-assert "mapm"
(every (lambda (monad run)
(with-monad monad

52
tests/sets.scm Normal file
View file

@ -0,0 +1,52 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-sets)
#:use-module (guix sets)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64))
(test-begin "sets")
(test-assert "set-contains?"
(let* ((lst (iota 123))
(set (list->set lst)))
(and (every (cut set-contains? set <>)
lst)
(not (set-contains? set -1)))))
(test-assert "set->list"
(let* ((lst (iota 123))
(set (list->set lst)))
(lset= = lst (set->list set))))
(test-assert "set-union"
(let* ((a (list 'a))
(b (list 'b))
(s1 (setq a))
(s2 (setq b))
(s3 (set-union s1 s2)))
(and (set-contains? s3 a)
(set-contains? s3 b))))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))