summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-09-26 15:14:53 +0200
committerLudovic Courtès <ludo@gnu.org>2015-09-26 15:14:53 +0200
commite1556533d3e57950417b2e35a68e95c65fee5042 (patch)
tree41d67b065c7828e164af83254fb447849d9e880d /guix
parent5d8d8f3b0a07edb3bd435830b076749f906537d8 (diff)
parent92f1cefb74f6092c0c70f93140824ab806086272 (diff)
Merge branch 'core-updates'
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/glib-or-gtk.scm18
-rw-r--r--guix/build/emacs-build-system.scm43
-rw-r--r--guix/build/glib-or-gtk-build-system.scm28
-rw-r--r--guix/build/gnu-build-system.scm15
-rw-r--r--guix/build/utils.scm52
-rw-r--r--guix/gexp.scm39
-rw-r--r--guix/packages.scm39
-rw-r--r--guix/utils.scm26
8 files changed, 113 insertions, 147 deletions
diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm
index a1f0a9b8a4..d585d84f20 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -36,7 +36,7 @@
;; 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
-;; three phases run after the 'install' phase:
+;; two phases run after the 'install' phase:
;;
;; 'glib-or-gtk-wrap' phase:
;;
@@ -57,11 +57,6 @@
;; 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
@@ -81,22 +76,16 @@
(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)) (gtk+ (default-gtk+))
+ (glib (default-glib))
(implicit-inputs? #t)
(strip-binaries? #t)
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
(define private-keywords
- '(#:source #:target #:glib #:gtk+ #:inputs #:native-inputs
+ '(#:source #:target #:glib #:inputs #:native-inputs
#:outputs #:implicit-inputs?))
(and (not target) ;XXX: no cross-compilation
@@ -108,7 +97,6 @@
'())
,@inputs))
(build-inputs `(("glib:bin" ,glib "bin") ; to compile schemas
- ("gtk+" ,gtk+) ; to generate icon cache
,@(if implicit-inputs?
(standard-packages)
'())
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index c01b24fe9a..f0a9a6e125 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -83,7 +83,8 @@ store in '.el' files."
(let* ((out (assoc-ref outputs "out"))
(elpa-name-ver (store-directory->elpa-name-version out))
(el-dir (string-append out %install-suffix "/" elpa-name-ver))
- (info-dir (string-append out "/share/info"))
+ (name-ver (strip-store-file-name out))
+ (info-dir (string-append out "/share/info/"))
(info-files (find-files el-dir "\\.info$")))
(unless (null? info-files)
(mkdir-p info-dir)
@@ -115,7 +116,7 @@ store in '.el' files."
(filter (match-lambda
((label . directory)
(emacs-package? ((compose package-name->name+version
- store-directory->name-version)
+ strip-store-file-name)
directory)))
(_ #f))
inputs))
@@ -137,47 +138,17 @@ DIRS."
(define (package-name-version->elpa-name-version name-ver)
"Convert the Guix package NAME-VER to the corresponding ELPA name-version
format. Essnetially drop the prefix used in Guix."
- (let ((name (store-directory->name-version name-ver)))
- (if (emacs-package? name-ver)
- (store-directory->name-version name-ver)
- name-ver)))
+ (if (emacs-package? name-ver) ; checks for "emacs-" prefix
+ (string-drop name-ver (string-length "emacs-"))
+ name-ver))
(define (store-directory->elpa-name-version store-dir)
"Given a store directory STORE-DIR return the part of the basename after the
second hyphen. This corresponds to 'name-version' as used in ELPA packages."
((compose package-name-version->elpa-name-version
- store-directory->name-version)
+ strip-store-file-name)
store-dir))
-(define (store-directory->name-version store-dir)
- "Given a store directory STORE-DIR return the part of the basename
-after the first hyphen. This corresponds to 'name-version' of the package."
- (let* ((base (basename store-dir)))
- (string-drop base
- (+ 1 (string-index base #\-)))))
-
-;; from (guix utils). Should we put it in (guix build utils)?
-(define (package-name->name+version name)
- "Given NAME, a package name like \"foo-0.9.1b\", return two values:
-\"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and
-#f are returned. The first hyphen followed by a digit is considered to
-introduce the version part."
- ;; See also `DrvName' in Nix.
-
- (define number?
- (cut char-set-contains? char-set:digit <>))
-
- (let loop ((chars (string->list name))
- (prefix '()))
- (match chars
- (()
- (values name #f))
- ((#\- (? number? n) rest ...)
- (values (list->string (reverse prefix))
- (list->string (cons n rest))))
- ((head tail ...)
- (loop tail (cons head prefix))))))
-
(define %standard-phases
(modify-phases gnu:%standard-phases
(delete 'configure)
diff --git a/guix/build/glib-or-gtk-build-system.scm b/guix/build/glib-or-gtk-build-system.scm
index 15d7de2236..b6291e735b 100644
--- a/guix/build/glib-or-gtk-build-system.scm
+++ b/guix/build/glib-or-gtk-build-system.scm
@@ -213,37 +213,9 @@ if needed."
#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
(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)
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 102207b022..0a774e1e84 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -25,6 +25,7 @@
#:use-module (ice-9 regex)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (rnrs io ports)
#:export (%standard-phases
@@ -576,6 +577,11 @@ DOCUMENTATION-COMPRESSOR-FLAGS."
#:rest args)
"Build from SOURCE to OUTPUTS, using INPUTS, and by running all of PHASES
in order. Return #t if all the PHASES succeeded, #f otherwise."
+ (define (elapsed-time end start)
+ (let ((diff (time-difference end start)))
+ (+ (time-second diff)
+ (/ (time-nanosecond diff) 1e9))))
+
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
@@ -586,12 +592,13 @@ in order. Return #t if all the PHASES succeeded, #f otherwise."
;; PHASES can pick the keyword arguments it's interested in.
(every (match-lambda
((name . proc)
- (let ((start (gettimeofday)))
+ (let ((start (current-time time-monotonic)))
(format #t "starting phase `~a'~%" name)
(let ((result (apply proc args))
- (end (gettimeofday)))
- (format #t "phase `~a' ~:[failed~;succeeded~] after ~a seconds~%"
- name result (- (car end) (car start)))
+ (end (current-time time-monotonic)))
+ (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
+ name result
+ (elapsed-time end start))
;; Dump the environment variables as a shell script, for handy debugging.
(system "export > $NIX_BUILD_TOP/environment-variables")
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 676a0120e3..971929621a 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,6 +22,7 @@
(define-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-60)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
@@ -33,6 +35,8 @@
alist-delete)
#:export (%store-directory
store-file-name?
+ strip-store-file-name
+ package-name->name+version
parallel-job-count
directory-exists?
@@ -43,6 +47,7 @@
ar-file?
with-directory-excursion
mkdir-p
+ install-file
copy-recursively
delete-file-recursively
file-name-predicate
@@ -86,6 +91,33 @@
"Return true if FILE is in the store."
(string-prefix? (%store-directory) file))
+(define (strip-store-file-name file)
+ "Strip the '/gnu/store' and hash from FILE, a store file name. The result
+is typically a \"PACKAGE-VERSION\" string."
+ (string-drop file
+ (+ 34 (string-length (%store-directory)))))
+
+(define (package-name->name+version name)
+ "Given NAME, a package name like \"foo-0.9.1b\", return two values:
+\"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and
+#f are returned. The first hyphen followed by a digit is considered to
+introduce the version part."
+ ;; See also `DrvName' in Nix.
+
+ (define number?
+ (cut char-set-contains? char-set:digit <>))
+
+ (let loop ((chars (string->list name))
+ (prefix '()))
+ (match chars
+ (()
+ (values name #f))
+ ((#\- (? number? n) rest ...)
+ (values (list->string (reverse prefix))
+ (list->string (cons n rest))))
+ ((head tail ...)
+ (loop tail (cons head prefix))))))
+
(define parallel-job-count
;; Number of processes to be passed next to GNU Make's `-j' argument.
(make-parameter
@@ -197,6 +229,12 @@ with the bytes in HEADER, a bytevector."
(apply throw args))))))
(() #t))))
+(define (install-file file directory)
+ "Create DIRECTORY if it does not exist and copy FILE in there under the same
+name."
+ (mkdir-p directory)
+ (copy-file file (string-append directory "/" (basename file))))
+
(define* (copy-recursively source destination
#:key
(log (current-output-port))
@@ -279,13 +317,16 @@ name matches REGEXP."
(regexp-exec file-rx (basename file)))))
(define* (find-files dir #:optional (pred (const #t))
- #:key (stat lstat))
+ #:key (stat lstat)
+ directories?
+ fail-on-error?)
"Return the lexicographically sorted list of files under DIR for which PRED
returns true. PRED is passed two arguments: the absolute file name, and its
stat buffer; the default predicate always returns true. PRED can also be a
regular expression, in which case it is equivalent to (file-name-predicate
PRED). STAT is used to obtain file information; using 'lstat' means that
-symlinks are not followed."
+symlinks are not followed. If DIRECTORIES? is true, then directories will
+also be included. If FAIL-ON-ERROR? is true, raise an exception upon error."
(let ((pred (if (procedure? pred)
pred
(file-name-predicate pred))))
@@ -296,7 +337,10 @@ symlinks are not followed."
(cons file result)
result))
(lambda (dir stat result) ; down
- result)
+ (if (and directories?
+ (pred dir stat))
+ (cons dir result)
+ result))
(lambda (dir stat result) ; up
result)
(lambda (file stat result) ; skip
@@ -304,6 +348,8 @@ symlinks are not followed."
(lambda (file stat errno result)
(format (current-error-port) "find-files: ~a: ~a~%"
file (strerror errno))
+ (when fail-on-error?
+ (error "find-files failed"))
result)
'()
dir
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 63af40aed9..de49fef088 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -717,32 +717,11 @@ and in the current monad setting (system type, etc.)"
;;; Module handling.
;;;
-(define %mkdir-p-definition
- ;; The code for 'mkdir-p' is copied from (guix build utils). We use it in
- ;; derivations that cannot use the #:modules argument of 'gexp->derivation'
- ;; precisely because they implement that functionality.
- (gexp
- (define (mkdir-p dir)
- (define absolute?
- (string-prefix? "/" dir))
-
- (define not-slash
- (char-set-complement (char-set #\/)))
-
- (let loop ((components (string-tokenize dir not-slash))
- (root (if absolute? "" ".")))
- (match components
- ((head tail ...)
- (let ((path (string-append root "/" head)))
- (catch 'system-error
- (lambda ()
- (mkdir path)
- (loop tail path))
- (lambda args
- (if (= EEXIST (system-error-errno args))
- (loop tail path)
- (apply throw args))))))
- (() #t))))))
+(define %utils-module
+ ;; This file provides 'mkdir-p', needed to implement 'imported-files' and
+ ;; other primitives below.
+ (local-file (search-path %load-path "guix/build/utils.scm")
+ "build-utils.scm"))
(define* (imported-files files
#:key (name "file-import")
@@ -763,10 +742,9 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
(define build
(gexp
(begin
+ (primitive-load (ungexp %utils-module)) ;for 'mkdir-p'
(use-modules (ice-9 match))
- (ungexp %mkdir-p-definition)
-
(mkdir (ungexp output)) (chdir (ungexp output))
(for-each (match-lambda
((final-path store-path)
@@ -822,13 +800,12 @@ they can refer to each other."
(define build
(gexp
(begin
+ (primitive-load (ungexp %utils-module)) ;for 'mkdir-p'
+
(use-modules (ice-9 ftw)
- (ice-9 match)
(srfi srfi-26)
(system base compile))
- (ungexp %mkdir-p-definition)
-
(define (regular? file)
(not (member file '("." ".."))))
diff --git a/guix/packages.scm b/guix/packages.scm
index edcb53ec93..72822b8c97 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -99,6 +99,7 @@
transitive-input-references
%supported-systems
+ %hurd-systems
%hydra-supported-systems
supported-package?
@@ -215,9 +216,13 @@ name of its URI."
;; expect all packages to build successfully here.
'("x86_64-linux" "i686-linux" "armhf-linux" "mips64el-linux"))
+(define %hurd-systems
+ ;; The GNU/Hurd systems for which support is being developed.
+ '("i585-gnu" "i686-gnu"))
+
(define %hydra-supported-systems
;; This is the list of system types for which build slaves are available.
- (delete "armhf-linux" %supported-systems))
+ %supported-systems)
;; A package.
@@ -445,6 +450,13 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
(srfi srfi-1)
(guix build utils))
+ ;; The --sort option was added to GNU tar in version 1.28, released
+ ;; 2014-07-28. During bootstrap we must cope with older versions.
+ (define tar-supports-sort?
+ (zero? (system* (string-append #+tar "/bin/tar")
+ "cf" "/dev/null" "--files-from=/dev/null"
+ "--sort=name")))
+
(define (apply-patch patch)
(format (current-error-port) "applying '~a'...~%" patch)
@@ -504,12 +516,25 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
#~())
(begin (chdir "..") #t)
- (zero? (system* (string-append #+tar "/bin/tar")
- "cvfa" #$output directory
- ;; avoid non-determinism in the archive
- "--mtime=@0"
- "--owner=root:0"
- "--group=root:0")))))))
+
+ (unless tar-supports-sort?
+ (call-with-output-file ".file_list"
+ (lambda (port)
+ (for-each (lambda (name) (format port "~a~%" name))
+ (find-files directory
+ #:directories? #t
+ #:fail-on-error? #t)))))
+ (zero? (apply system* (string-append #+tar "/bin/tar")
+ "cvfa" #$output
+ ;; avoid non-determinism in the archive
+ "--mtime=@0"
+ "--owner=root:0"
+ "--group=root:0"
+ (if tar-supports-sort?
+ `("--sort=name"
+ ,directory)
+ '("--no-recursion"
+ "--files-from=.file_list")))))))))
(let ((name (tarxz-name original-file-name))
(modules (delete-duplicates (cons '(guix build utils) modules))))
diff --git a/guix/utils.scm b/guix/utils.scm
index 1fe11f52f5..b6df5d9cc9 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -29,7 +29,8 @@
#:use-module (srfi srfi-60)
#:use-module (rnrs bytevectors)
#:use-module ((rnrs io ports) #:select (put-bytevector))
- #:use-module ((guix build utils) #:select (dump-port))
+ #:use-module ((guix build utils)
+ #:select (dump-port package-name->name+version))
#:use-module ((guix build syscalls) #:select (errno mkdtemp!))
#:use-module (ice-9 vlist)
#:use-module (ice-9 format)
@@ -39,6 +40,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (system foreign)
+ #:re-export (package-name->name+version)
#:export (bytevector->base16-string
base16-string->bytevector
@@ -71,7 +73,6 @@
version-prefix
version-major+minor
guile-version>?
- package-name->name+version
string-replace-substring
arguments-from-environment-variable
file-extension
@@ -578,27 +579,6 @@ minor version numbers from version-string."
(micro-version))
str))
-(define (package-name->name+version name)
- "Given NAME, a package name like \"foo-0.9.1b\", return two values:
-\"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and
-#f are returned. The first hyphen followed by a digit is considered to
-introduce the version part."
- ;; See also `DrvName' in Nix.
-
- (define number?
- (cut char-set-contains? char-set:digit <>))
-
- (let loop ((chars (string->list name))
- (prefix '()))
- (match chars
- (()
- (values name #f))
- ((#\- (? number? n) rest ...)
- (values (list->string (reverse prefix))
- (list->string (cons n rest))))
- ((head tail ...)
- (loop tail (cons head prefix))))))
-
(define (file-extension file)
"Return the extension of FILE or #f if there is none."
(let ((dot (string-rindex file #\.)))