summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2020-05-08 21:40:51 +0200
committerMarius Bakke <mbakke@fastmail.com>2020-05-08 21:40:51 +0200
commit4bdf4182fe080c3409f6ef9b410146b67cfa2595 (patch)
treef1123ddb8c57eda6de026982904f6c5309adaca6 /guix
parentc81457a5883ea43950eb2ecdcbb58a5b144bcd11 (diff)
parent23a59b180b28b9fa22120c2b8305b9324442b94d (diff)
downloadpatches-4bdf4182fe080c3409f6ef9b410146b67cfa2595.tar
patches-4bdf4182fe080c3409f6ef9b410146b67cfa2595.tar.gz
Merge branch 'core-updates'
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/cmake.scm18
-rw-r--r--guix/build-system/glib-or-gtk.scm16
-rw-r--r--guix/build-system/gnu.scm16
-rw-r--r--guix/build-system/meson.scm14
-rw-r--r--guix/build-system/texlive.scm4
-rw-r--r--guix/build/cmake-build-system.scm2
-rw-r--r--guix/build/emacs-build-system.scm2
-rw-r--r--guix/build/gnu-bootstrap.scm114
-rw-r--r--guix/build/gnu-build-system.scm14
-rw-r--r--guix/build/utils.scm103
-rw-r--r--guix/channels.scm97
-rw-r--r--guix/derivations.scm59
-rw-r--r--guix/gexp.scm58
-rw-r--r--guix/git.scm1
-rw-r--r--guix/packages.scm10
-rw-r--r--guix/profiles.scm10
-rw-r--r--guix/scripts/environment.scm4
-rw-r--r--guix/scripts/pack.scm2
-rw-r--r--guix/scripts/package.scm4
-rw-r--r--guix/scripts/pull.scm2
-rw-r--r--guix/self.scm12
-rw-r--r--guix/store.scm40
-rw-r--r--guix/store/database.scm13
-rw-r--r--guix/tests.scm5
24 files changed, 447 insertions, 173 deletions
diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm
index ca88fadddf..29259c5785 100644
--- a/guix/build-system/cmake.scm
+++ b/guix/build-system/cmake.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
@@ -43,16 +43,19 @@
`((guix build cmake-build-system)
,@%gnu-build-system-modules))
-(define (default-cmake)
+(define (default-cmake target)
"Return the default CMake package."
;; Do not use `@' to avoid introducing circular dependencies.
(let ((module (resolve-interface '(gnu packages cmake))))
- (module-ref module 'cmake-minimal)))
+ (module-ref module
+ (if target
+ 'cmake-minimal-cross
+ 'cmake-minimal))))
(define* (lower name
#:key source inputs native-inputs outputs system target
- (cmake (default-cmake))
+ (cmake (default-cmake target))
#:allow-other-keys
#:rest arguments)
"Return a bag for NAME."
@@ -69,6 +72,7 @@
'())
,@`(("cmake" ,cmake))
,@native-inputs
+ ,@(if target '() inputs)
,@(if target
;; Use the standard cross inputs of
;; 'gnu-build-system'.
@@ -76,7 +80,7 @@
'())
;; Keep the standard inputs of 'gnu-build-system'.
,@(standard-packages)))
- (host-inputs inputs)
+ (host-inputs (if target inputs '()))
;; The cross-libc is really a target package, but for bootstrapping
;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a
@@ -99,7 +103,7 @@
(build-type "RelWithDebInfo")
(tests? #t)
(test-target "test")
- (parallel-build? #t) (parallel-tests? #f)
+ (parallel-build? #t) (parallel-tests? #t)
(validate-runpath? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
@@ -178,7 +182,7 @@ provides a 'CMakeLists.txt' file as its build system."
(build-type "RelWithDebInfo")
(tests? #f) ; nothing can be done
(test-target "test")
- (parallel-build? #t) (parallel-tests? #f)
+ (parallel-build? #t) (parallel-tests? #t)
(validate-runpath? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm
index 8de7dfbfc2..fb1f8fb930 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
;;;
@@ -92,15 +92,15 @@
(bag
(name name)
(system system)
- (host-inputs `(,@(if source
- `(("source" ,source))
- '())
- ,@inputs))
- (build-inputs `(("glib:bin" ,glib "bin") ; to compile schemas
+ (host-inputs (if source
+ `(("source" ,source))
+ '()))
+ (build-inputs `(,@native-inputs
+ ,@inputs
+ ("glib:bin" ,glib "bin") ; to compile schemas
,@(if implicit-inputs?
(standard-packages)
- '())
- ,@native-inputs))
+ '())))
(outputs outputs)
(build glib-or-gtk-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 7266fa0009..f59567febb 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -296,13 +296,19 @@ standard packages used as implicit inputs of the GNU build system."
`(("source" ,source))
'())
,@native-inputs
+
+ ;; When not cross-compiling, ensure implicit inputs come
+ ;; last. That way, libc headers come last, which allows
+ ;; #include_next to work correctly; see
+ ;; <https://bugs.gnu.org/30756>.
+ ,@(if target '() inputs)
,@(if (and target implicit-cross-inputs?)
(standard-cross-packages target 'host)
'())
,@(if implicit-inputs?
(standard-packages)
'())))
- (host-inputs inputs)
+ (host-inputs (if target inputs '()))
;; The cross-libc is really a target package, but for bootstrapping
;; reasons, we can't put it in 'host-inputs'. Namely, 'cross-gcc' is a
@@ -454,13 +460,19 @@ is one of `host' or `target'."
(libc (module-ref cross 'cross-libc)))
(case kind
((host)
+ ;; Cross-GCC appears once here, so that it's in $PATH...
`(("cross-gcc" ,(gcc target
#:xbinutils (binutils target)
#:libc (libc target)))
("cross-binutils" ,(binutils target))))
((target)
(let ((libc (libc target)))
- `(("cross-libc" ,libc)
+ ;; ... and once here, so that libstdc++ & co. are in
+ ;; CROSS_CPLUS_INCLUDE_PATH, etc.
+ `(("cross-gcc" ,(gcc target
+ #:xbinutils (binutils target)
+ #:libc libc))
+ ("cross-libc" ,libc)
;; MinGW's libc doesn't have a "static" output.
,@(if (member "static" (package-outputs libc))
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm
index b29f2f4ecf..b68bcb80de 100644
--- a/guix/build-system/meson.scm
+++ b/guix/build-system/meson.scm
@@ -74,13 +74,13 @@
(system system)
(build-inputs `(("meson" ,meson)
("ninja" ,ninja)
- ,@native-inputs))
- (host-inputs `(,@(if source
- `(("source" ,source))
- '())
- ,@inputs
- ;; Keep the standard inputs of 'gnu-build-system'.
- ,@(standard-packages)))
+ ,@native-inputs
+ ,@inputs
+ ;; Keep the standard inputs of 'gnu-build-system'.
+ ,@(standard-packages)))
+ (host-inputs (if source
+ `(("source" ,source))
+ '()))
(outputs outputs)
(build meson-build)
(arguments (strip-keyword-arguments private-keywords arguments)))))
diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm
index ad99d1e2d0..8bbca0ccb7 100644
--- a/guix/build-system/texlive.scm
+++ b/guix/build-system/texlive.scm
@@ -42,8 +42,8 @@
;; These variables specify the SVN tag and the matching SVN revision. They
;; are taken from https://www.tug.org/svn/texlive/tags/
-(define %texlive-tag "texlive-2018.2")
-(define %texlive-revision 49435)
+(define %texlive-tag "texlive-2019.3")
+(define %texlive-revision 51265)
(define (texlive-origin name version locations hash)
"Return an <origin> object for a TeX Live package consisting of multiple
diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm
index 9b1112f2d6..d1ff5071be 100644
--- a/guix/build/cmake-build-system.scm
+++ b/guix/build/cmake-build-system.scm
@@ -67,6 +67,8 @@
,@(if target
(list (string-append "-DCMAKE_C_COMPILER="
target "-gcc")
+ (string-append "-DCMAKE_CXX_COMPILER="
+ target "-g++")
(if (string-contains target "mingw")
"-DCMAKE_SYSTEM_NAME=Windows"
"-DCMAKE_SYSTEM_NAME=Linux"))
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index 219310cf08..26ea59bc25 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -21,7 +21,7 @@
(define-module (guix build emacs-build-system)
#:use-module ((guix build gnu-build-system) #:prefix gnu:)
- #:use-module (guix build utils)
+ #:use-module ((guix build utils) #:hide (delete))
#:use-module (guix build emacs-utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
diff --git a/guix/build/gnu-bootstrap.scm b/guix/build/gnu-bootstrap.scm
new file mode 100644
index 0000000000..1cb9dc5512
--- /dev/null
+++ b/guix/build/gnu-bootstrap.scm
@@ -0,0 +1,114 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
+;;;
+;;; 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/>.
+
+;; Commentary:
+;;
+;; These procedures can be used to adapt the GNU Build System to build
+;; pure Scheme packages targeting the bootstrap Guile.
+;;
+;; Code:
+
+(define-module (guix build gnu-bootstrap)
+ #:use-module (guix build utils)
+ #:use-module (system base compile)
+ #:export (bootstrap-configure
+ bootstrap-build
+ bootstrap-install))
+
+(define (bootstrap-configure version modules scripts)
+ "Create a procedure that configures an early bootstrap package. The
+procedure will search the MODULES directory and configure all of the
+'.in' files with VERSION. It will then search the SCRIPTS directory and
+configure all of the '.in' files with the bootstrap Guile and its module
+and object directories."
+ (lambda* (#:key inputs outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (guile-dir (assoc-ref inputs "guile"))
+ (guile (string-append guile-dir "/bin/guile"))
+ (moddir (string-append out "/share/guile/site/"
+ (effective-version)))
+ (godir (string-append out "/lib/guile/"
+ (effective-version)
+ "/site-ccache")))
+ (for-each (lambda (template)
+ (format #t "Configuring ~a~%" template)
+ (let ((target (string-drop-right template 3)))
+ (copy-file template target)
+ (substitute* target
+ (("@VERSION@") version))))
+ (find-files modules
+ (lambda (fn st)
+ (string-suffix? ".in" fn))))
+ (for-each (lambda (template)
+ (format #t "Configuring ~a~%" template)
+ (let ((target (string-drop-right template 3)))
+ (copy-file template target)
+ (substitute* target
+ (("@GUILE@") guile)
+ (("@MODDIR@") moddir)
+ (("@GODIR@") godir))
+ (chmod target #o755)))
+ (find-files scripts
+ (lambda (fn st)
+ (string-suffix? ".in" fn))))
+ #t)))
+
+(define (bootstrap-build modules)
+ "Create a procedure that builds an early bootstrap package. The
+procedure will search the MODULES directory and compile all of the
+'.scm' files."
+ (lambda _
+ (add-to-load-path (getcwd))
+ (for-each (lambda (scm)
+ (let* ((base (string-drop-right scm 4))
+ (go (string-append base ".go"))
+ (dir (dirname scm)))
+ (format #t "Compiling ~a~%" scm)
+ (compile-file scm #:output-file go)))
+ (find-files modules "\\.scm$"))
+ #t))
+
+(define (bootstrap-install modules scripts)
+ "Create a procedure that installs an early bootstrap package. The
+procedure will install all of the '.scm' and '.go' files in the MODULES
+directory, and all the executable files in the SCRIPTS directory."
+ (lambda* (#:key inputs outputs #:allow-other-keys)
+ (let* ((out (assoc-ref outputs "out"))
+ (guile-dir (assoc-ref inputs "guile"))
+ (guile (string-append guile-dir "/bin/guile"))
+ (moddir (string-append out "/share/guile/site/"
+ (effective-version)))
+ (godir (string-append out "/lib/guile/"
+ (effective-version)
+ "/site-ccache")))
+ (for-each (lambda (scm)
+ (let* ((base (string-drop-right scm 4))
+ (go (string-append base ".go"))
+ (dir (dirname scm)))
+ (format #t "Installing ~a~%" scm)
+ (install-file scm (string-append moddir "/" dir))
+ (format #t "Installing ~a~%" go)
+ (install-file go (string-append godir "/" dir))))
+ (find-files modules "\\.scm$"))
+ (for-each (lambda (script)
+ (format #t "Installing ~a~%" script)
+ (install-file script (string-append out "/bin")))
+ (find-files scripts
+ (lambda (fn st)
+ (executable-file? fn))))
+ #t)))
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 4df0bb4904..2e7dff2034 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2020 Brendan Tildesley <mail@brendan.scot>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -173,12 +174,16 @@ working directory."
\"autoreconf\". Otherwise do nothing."
;; Note: Run that right after 'unpack' so that the generated files are
;; visible when the 'patch-source-shebangs' phase runs.
- (if (not (file-exists? "configure"))
+ (define (script-exists? file)
+ (and (file-exists? file)
+ (not (file-is-directory? file))))
+
+ (if (not (script-exists? "configure"))
;; First try one of the BOOTSTRAP-SCRIPTS. If none exists, and it's
;; clearly an Autoconf-based project, run 'autoreconf'. Otherwise, do
;; nothing (perhaps the user removed or overrode the 'configure' phase.)
- (let ((script (find file-exists? bootstrap-scripts)))
+ (let ((script (find script-exists? bootstrap-scripts)))
;; GNU packages often invoke the 'git-version-gen' script from
;; 'configure.ac' so make sure it has a valid shebang.
(false-if-file-not-found
@@ -186,12 +191,15 @@ working directory."
(if script
(let ((script (string-append "./" script)))
+ (setenv "NOCONFIGURE" "true")
(format #t "running '~a'~%" script)
(if (executable-file? script)
(begin
(patch-shebang script)
(invoke script))
- (invoke "sh" script)))
+ (invoke "sh" script))
+ ;; Let's clean up after ourselves.
+ (unsetenv "NOCONFIGURE"))
(if (or (file-exists? "configure.ac")
(file-exists? "configure.in"))
(invoke "autoreconf" "-vif")
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index b8be73ead4..419c10195b 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -108,6 +108,8 @@
invoke/quiet
+ make-desktop-entry-file
+
locale-category->string))
@@ -892,7 +894,7 @@ transferred and the continuation of the transfer as a thunk."
(x x)))
(define patch-shebang
- (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$")))
+ (let ((shebang-rx (make-regexp "^[[:blank:]]*(/[[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$")))
(lambda* (file
#:optional
(path (search-path-as-string->list (getenv "PATH")))
@@ -1324,6 +1326,105 @@ not supported."
(&wrap-error (program prog)
(type 'no-interpreter-found)))))))))
+(define* (make-desktop-entry-file destination #:key
+ (type "Application") ; One of "Application", "Link" or "Directory".
+ (version "1.1")
+ name
+ (generic-name name)
+ (no-display #f)
+ comment
+ icon
+ (hidden #f)
+ only-show-in
+ not-show-in
+ (d-bus-activatable #f)
+ try-exec
+ exec
+ path
+ (terminal #f)
+ actions
+ mime-type
+ (categories "Application")
+ implements
+ keywords
+ (startup-notify #t)
+ startup-w-m-class
+ #:rest all-args)
+ "Create a desktop entry file at DESTINATION.
+You must specify NAME.
+
+Values can be booleans, numbers, strings or list of strings.
+
+Additionally, locales can be specified with an alist where the key is the
+locale. The #f key specifies the default. Example:
+
+ #:name '((#f \"I love Guix\") (\"fr\" \"J'aime Guix\"))
+
+produces
+
+ Name=I love Guix
+ Name[fr]=J'aime Guix
+
+For a complete description of the format, see the specifications at
+https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-latest.html."
+ (define (escape-semicolon s)
+ (string-join (string-split s #\;) "\\;"))
+ (define* (parse key value #:optional locale)
+ (set! value (match value
+ (#t "true")
+ (#f "false")
+ ((? number? n) n)
+ ((? string? s) (escape-semicolon s))
+ ((? list? value)
+ (catch 'wrong-type-arg
+ (lambda () (string-join (map escape-semicolon value) ";"))
+ (lambda args (error "List arguments can only contain strings: ~a" args))))
+ (_ (error "Value must be a boolean, number, string or list of strings"))))
+ (format #t "~a=~a~%"
+ (if locale
+ (format #f "~a[~a]" key locale)
+ key)
+ value))
+
+ (define key-error-message "This procedure only takes key arguments beside DESTINATION")
+
+ (unless name
+ (error "Missing NAME key argument"))
+ (unless (member #:type all-args)
+ (set! all-args (append (list #:type type) all-args)))
+ (mkdir-p (dirname destination))
+
+ (with-output-to-file destination
+ (lambda ()
+ (format #t "[Desktop Entry]~%")
+ (let loop ((args all-args))
+ (match args
+ (() #t)
+ ((_) (error key-error-message))
+ ((key value . ...)
+ (unless (keyword? key)
+ (error key-error-message))
+ (set! key
+ (string-join (map string-titlecase
+ (string-split (symbol->string
+ (keyword->symbol key))
+ #\-))
+ ""))
+ (match value
+ (((_ . _) . _)
+ (for-each (lambda (locale-subvalue)
+ (parse key
+ (if (and (list? (cdr locale-subvalue))
+ (= 1 (length (cdr locale-subvalue))))
+ ;; Support both proper and improper lists for convenience.
+ (cadr locale-subvalue)
+ (cdr locale-subvalue))
+ (car locale-subvalue)))
+ value))
+ (_
+ (parse key value)))
+ (loop (cddr args))))))))
+
;;;
;;; Locales.
diff --git a/guix/channels.scm b/guix/channels.scm
index 041fae2a9c..0fa036446c 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -38,6 +38,7 @@
#:select (source-properties->location
&error-location
&fix-hint))
+ #:use-module ((guix build utils) #:select (substitute*))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
#:use-module (srfi srfi-9)
@@ -199,6 +200,46 @@ description file or its default value."
channel INSTANCE."
(channel-metadata-dependencies (channel-instance-metadata instance)))
+;; Patch to apply to a source tree.
+(define-record-type <patch>
+ (patch predicate application)
+ patch?
+ (predicate patch-predicate) ;procedure
+ (application patch-application)) ;procedure
+
+(define (apply-patches checkout commit patches)
+ "Apply the matching PATCHES to CHECKOUT, modifying files in place. The
+result is unspecified."
+ (let loop ((patches patches))
+ (match patches
+ (() #t)
+ ((($ <patch> predicate modify) rest ...)
+ ;; PREDICATE is passed COMMIT so that it can choose to only apply to
+ ;; ancestors.
+ (when (predicate checkout commit)
+ (modify checkout))
+ (loop rest)))))
+
+(define* (latest-channel-instance store channel
+ #:key (patches %patches))
+ "Return the latest channel instance for CHANNEL."
+ (define (dot-git? file stat)
+ (and (string=? (basename file) ".git")
+ (eq? 'directory (stat:type stat))))
+
+ (let-values (((checkout commit)
+ (update-cached-checkout (channel-url channel)
+ #:ref (channel-reference channel))))
+ (when (guix-channel? channel)
+ ;; Apply the relevant subset of PATCHES directly in CHECKOUT. This is
+ ;; safe to do because 'switch-to-ref' eventually does a hard reset.
+ (apply-patches checkout commit patches))
+
+ (let* ((name (url+commit->name (channel-url channel) commit))
+ (checkout (add-to-store store name #t "sha256" checkout
+ #:select? (negate dot-git?))))
+ (channel-instance channel commit checkout))))
+
(define* (latest-channel-instances store channels #:optional (previous-channels '()))
"Return a list of channel instances corresponding to the latest checkouts of
CHANNELS and the channels on which they depend. PREVIOUS-CHANNELS is a list
@@ -224,20 +265,16 @@ of previously processed channels."
(G_ "Updating channel '~a' from Git repository at '~a'...~%")
(channel-name channel)
(channel-url channel))
- (let-values (((checkout commit)
- (latest-repository-commit store (channel-url channel)
- #:ref (channel-reference
- channel))))
- (let ((instance (channel-instance channel commit checkout)))
- (let-values (((new-instances new-channels)
- (latest-channel-instances
- store
- (channel-instance-dependencies instance)
- previous-channels)))
- (values (append (cons channel new-channels)
- previous-channels)
- (append (cons instance new-instances)
- instances))))))))
+ (let ((instance (latest-channel-instance store channel)))
+ (let-values (((new-instances new-channels)
+ (latest-channel-instances
+ store
+ (channel-instance-dependencies instance)
+ previous-channels)))
+ (values (append (cons channel new-channels)
+ previous-channels)
+ (append (cons instance new-instances)
+ instances)))))))
previous-channels
'() ;instances
channels))
@@ -333,12 +370,42 @@ to '%package-module-path'."
'guile-2.2.4))
(define %quirks
- ;; List of predicate/package pairs. This allows us provide information
+ ;; List of predicate/package pairs. This allows us to provide information
;; about specific Guile versions that old Guix revisions might need to use
;; just to be able to build and run the trampoline in %SELF-BUILD-FILE. See
;; <https://bugs.gnu.org/37506>
`((,syscalls-reexports-local-variables? . ,guile-2.2.4)))
+
+(define %bug-41028-patch
+ ;; Patch for <https://bugs.gnu.org/41028>. The faulty code is the
+ ;; 'compute-guix-derivation' body, which uses 'call-with-new-thread' without
+ ;; importing (ice-9 threads). However, the 'call-with-new-thread' binding
+ ;; is no longer available in the default name space on Guile 3.0.
+ (let ()
+ (define (missing-ice-9-threads-import? source commit)
+ ;; Return true if %SELF-BUILD-FILE is missing an (ice-9 threads) import.
+ (define content
+ (call-with-input-file (string-append source "/" %self-build-file)
+ read-string))
+
+ (and (string-contains content "(call-with-new-thread")
+ (not (string-contains content "(ice-9 threads)"))))
+
+ (define (add-missing-ice-9-threads-import source)
+ ;; Add (ice-9 threads) import in the gexp of 'compute-guix-derivation'.
+ (substitute* (string-append source "/" %self-build-file)
+ (("^ +\\(use-modules \\(ice-9 match\\)\\)")
+ (object->string '(use-modules (ice-9 match) (ice-9 threads))))))
+
+ (patch missing-ice-9-threads-import? add-missing-ice-9-threads-import)))
+
+(define %patches
+ ;; Bits of past Guix revisions can become incompatible with newer Guix and
+ ;; Guile. This variable lists <patch> records for the Guix source tree that
+ ;; apply to the Guix source.
+ (list %bug-41028-patch))
+
(define* (guile-for-source source #:optional (quirks %quirks))
"Return the Guile package to use when building SOURCE or #f if the default
'%guile-for-build' should be good enough."
diff --git a/guix/derivations.scm b/guix/derivations.scm
index f6d6f7db25..7db61d272f 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1105,39 +1105,13 @@ recursively."
(string-tokenize (dirname file-name) not-slash))))))
(define* (imported-files store files ;deprecated
- #:key (name "file-import")
- (system (%current-system))
- (guile (%guile-for-build)))
- "Return a derivation that imports FILES into STORE. FILES must be a list
+ #:key (name "file-import"))
+ "Return a store item that contains FILES. FILES must be a list
of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
system, imported, and appears under FINAL-PATH in the resulting store path."
- (let* ((files (map (match-lambda
- ((final-path . file-name)
- (list final-path
- (add-to-store store (basename final-path) #f
- "sha256" file-name))))
- files))
- (builder
- `(begin
- (mkdir %output) (chdir %output)
- ,@(append-map (match-lambda
- ((final-path store-path)
- (append (match (parent-directories final-path)
- (() '())
- ((head ... tail)
- (append (map (lambda (d)
- `(false-if-exception
- (mkdir ,d)))
- head)
- `((or (file-exists? ,tail)
- (mkdir ,tail))))))
- `((symlink ,store-path ,final-path)))))
- files))))
- (build-expression->derivation store name builder
- #:system system
- #:inputs files
- #:guile-for-build guile
- #:local-build? #t)))
+ (add-file-tree-to-store store
+ `(,name directory
+ ,@(file-mapping->tree files))))
;; The "file not found" error condition.
(define-condition-type &file-search-error &error
@@ -1164,10 +1138,8 @@ of symbols.)"
(define* (%imported-modules store modules ;deprecated
#:key (name "module-import")
- (system (%current-system))
- (guile (%guile-for-build))
(module-path %load-path))
- "Return a derivation that contains the source files of MODULES, a list of
+ "Return a store item that contains the source files of MODULES, a list of
module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH
search path."
;; TODO: Determine the closure of MODULES, build the `.go' files,
@@ -1176,8 +1148,7 @@ search path."
(let ((f (module->source-file-name m)))
(cons f (search-path* module-path f))))
modules)))
- (imported-files store files #:name name #:system system
- #:guile guile)))
+ (imported-files store files #:name name)))
(define* (%compiled-modules store modules ;deprecated
#:key (name "module-import-compiled")
@@ -1187,11 +1158,8 @@ search path."
"Return a derivation that builds a tree containing the `.go' files
corresponding to MODULES. All the MODULES are built in a context where
they can refer to each other."
- (let* ((module-drv (%imported-modules store modules
- #:system system
- #:guile guile
+ (let* ((module-dir (%imported-modules store modules
#:module-path module-path))
- (module-dir (derivation->output-path module-drv))
(files (map (lambda (m)
(let ((f (string-join (map symbol->string m)
"/")))
@@ -1222,7 +1190,7 @@ they can refer to each other."
files)))
(build-expression->derivation store name builder
- #:inputs `(("modules" ,module-drv))
+ #:inputs `(("modules" ,module-dir))
#:system system
#:guile-for-build guile
#:local-build? #t)))
@@ -1240,8 +1208,7 @@ MODULES are compiled."
(list modules (derivation-file-name guile) system))
(or (hash-ref %module-cache key)
- (let ((result (cons (%imported-modules store modules
- #:system system #:guile guile)
+ (let ((result (cons (%imported-modules store modules)
(%compiled-modules store modules
#:system system #:guile guile))))
(hash-set! %module-cache key result)
@@ -1375,10 +1342,8 @@ and PROPERTIES."
#:guile guile-drv
#:system system)
'(#f . #f)))
- (mod-drv (car mod+go-drv))
+ (mod-dir (car mod+go-drv))
(go-drv (cdr mod+go-drv))
- (mod-dir (and mod-drv
- (derivation->output-path mod-drv)))
(go-dir (and go-drv
(derivation->output-path go-drv))))
(derivation store name guile
@@ -1395,7 +1360,7 @@ and PROPERTIES."
#:inputs `((,(or guile-for-build (%guile-for-build)))
(,builder)
,@(map cdr inputs)
- ,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
+ ,@(if mod-dir `((,mod-dir) (,go-drv)) '()))
;; When MODULES is non-empty, shamelessly clobber
;; $GUILE_LOAD_COMPILED_PATH.
diff --git a/guix/gexp.scm b/guix/gexp.scm
index c320065546..2a4b36519c 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -787,7 +787,7 @@ second element is the derivation to compile them."
(target 'current)
(graft? (%graft?))
(guile-for-build (%guile-for-build))
- (effective-version "2.2")
+ (effective-version "3.0")
deprecation-warnings)
"*Note: This API is subject to change; use at your own risk!*
@@ -888,7 +888,7 @@ derivations--e.g., code evaluated for its side effects."
(modules '())
(module-path %load-path)
(guile-for-build (%guile-for-build))
- (effective-version "2.2")
+ (effective-version "3.0")
(graft? (%graft?))
references-graphs
allowed-references disallowed-references
@@ -1304,49 +1304,6 @@ execution environment."
;;; Module handling.
;;;
-(define %not-slash
- (char-set-complement (char-set #\/)))
-
-(define (file-mapping->tree mapping)
- "Convert MAPPING, an alist like:
-
- ((\"guix/build/utils.scm\" . \"…/utils.scm\"))
-
-to a tree suitable for 'interned-file-tree'."
- (let ((mapping (map (match-lambda
- ((destination . source)
- (cons (string-tokenize destination
- %not-slash)
- source)))
- mapping)))
- (fold (lambda (pair result)
- (match pair
- ((destination . source)
- (let loop ((destination destination)
- (result result))
- (match destination
- ((file)
- (let* ((mode (stat:mode (stat source)))
- (type (if (zero? (logand mode #o100))
- 'regular
- 'executable)))
- (alist-cons file
- `(,type (file ,source))
- result)))
- ((file rest ...)
- (let ((directory (assoc-ref result file)))
- (alist-cons file
- `(directory
- ,@(loop rest
- (match directory
- (('directory . entries) entries)
- (#f '()))))
- (if directory
- (alist-delete file result)
- result)))))))))
- '()
- mapping)))
-
(define %utils-module
;; This file provides 'mkdir-p', needed to implement 'imported-files' and
;; other primitives below. Note: We give the file name relative to this
@@ -1481,14 +1438,9 @@ TARGET, a GNU triplet."
(ice-9 format)
(srfi srfi-1)
(srfi srfi-26)
+ (system base target)
(system base compile))
- ;; TODO: Inline this on the next rebuild cycle.
- (ungexp-splicing
- (if target
- (gexp ((use-modules (system base target))))
- (gexp ())))
-
(define (regular? file)
(not (member file '("." ".."))))
@@ -1603,12 +1555,12 @@ TARGET, a GNU triplet."
;;;
(define (default-guile)
- ;; Lazily resolve 'guile-2.2' (not 'guile-final' because this is for
+ ;; Lazily resolve 'guile-3.0' (not 'guile-final' because this is for
;; programs returned by 'program-file' and we don't want to keep references
;; to several Guile packages). This module must not refer to (gnu …)
;; modules directly, to avoid circular dependencies, hence this hack.
(module-ref (resolve-interface '(gnu packages guile))
- 'guile-2.2))
+ 'guile-3.0))
(define* (load-path-expression modules #:optional (path %load-path)
#:key (extensions '()) system target)
diff --git a/guix/git.scm b/guix/git.scm
index 5fffd429bd..92121156cf 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -40,6 +40,7 @@
with-repository
update-cached-checkout
+ url+commit->name
latest-repository-commit
commit-difference
diff --git a/guix/packages.scm b/guix/packages.scm
index 2fa4fd05d7..9fdc679f9a 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2014, 2015, 2017, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -234,7 +234,7 @@ name of its URI."
(define %supported-systems
;; This is the list of system types that are supported. By default, we
;; expect all packages to build successfully here.
- '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux"))
+ '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu"))
(define %hurd-systems
;; The GNU/Hurd systems for which support is being developed.
@@ -638,8 +638,10 @@ specifies modules in scope when evaluating SNIPPET."
(apply invoke
(string-append #+tar "/bin/tar")
"cvfa" #$output
- ;; avoid non-determinism in the archive
- "--mtime=@0"
+ ;; Avoid non-determinism in the archive. Set the mtime
+ ;; to 1 as is the case in the store (software like gzip
+ ;; behaves differently when it stumbles upon mtime = 0).
+ "--mtime=@1"
"--owner=root:0"
"--group=root:0"
(if tar-supports-sort?
diff --git a/guix/profiles.scm b/guix/profiles.scm
index b3a3db0e84..25ff146bdf 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1171,6 +1171,8 @@ for both major versions of GTK+."
;; Don't run the hook when there's nothing to do.
(let* ((pkg-gtk+ (module-ref ; lazy reference
(resolve-interface '(gnu packages gtk)) 'gtk+))
+ (pkg-gtk+2 (module-ref ; lazy reference
+ (resolve-interface '(gnu packages gtk)) 'gtk+-2))
(gexp #~(begin
#$(if gtk+
(build
@@ -1184,7 +1186,7 @@ for both major versions of GTK+."
(build
gtk+-2 "2.10.0"
#~(string-append
- #$gtk+-2 "/bin/gtk-query-immodules-2.0"))
+ #$pkg-gtk+2:bin "/bin/gtk-query-immodules-2.0"))
#t))))
(if (or gtk+ gtk+-2)
(gexp->derivation "gtk-im-modules" gexp
@@ -1625,8 +1627,10 @@ are cross-built for TARGET."
(guix search-paths)
(srfi srfi-1))
- (setvbuf (current-output-port) _IOLBF)
- (setvbuf (current-error-port) _IOLBF)
+ (let ((line (cond-expand (guile-2.2 'line)
+ (else _IOLBF)))) ;Guile 2.0
+ (setvbuf (current-output-port) line)
+ (setvbuf (current-error-port) line))
#+(if locales? set-utf8-locale #t)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index bfc4039c2b..03f455ab7b 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -38,8 +38,6 @@
#:use-module (gnu system file-systems)
#:use-module (gnu packages)
#:use-module (gnu packages bash)
- #:use-module (gnu packages commencement)
- #:use-module (gnu packages guile)
#:use-module ((gnu packages bootstrap)
#:select (bootstrap-executable %bootstrap-guile))
#:use-module (ice-9 format)
@@ -724,7 +722,7 @@ message if any test fails."
store
(if bootstrap?
%bootstrap-guile
- (canonical-package guile-2.2)))))
+ (default-guile)))))
(run-with-store store
;; Containers need a Bourne shell at /bin/sh.
(mlet* %store-monad ((bash (environment-bash container?
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index f3d1b41c6f..580f696b41 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -1035,7 +1035,7 @@ Create a bundle of PACKAGE.\n"))
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
- (canonical-package guile-2.2))
+ (default-guile))
(assoc-ref opts 'system)
#:graft? (assoc-ref opts 'graft?))))
(let* ((derivation? (assoc-ref opts 'derivation-only?))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 2eb18919cc..dce9256bf5 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -55,8 +55,6 @@
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (gnu packages)
- #:autoload (gnu packages base) (canonical-package)
- #:autoload (gnu packages guile) (guile-2.2)
#:autoload (gnu packages bootstrap) (%bootstrap-guile)
#:export (build-and-use-profile
delete-generations
@@ -963,5 +961,5 @@ option processing with 'parse-command-line'."
(%store)
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
- (canonical-package guile-2.2)))))
+ (default-guile)))))
(process-actions (%store) opts))))))))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 42c9956136..dfe7ee7ad5 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -787,7 +787,7 @@ Use '~/.config/guix/channels.scm' instead."))
store
(if (assoc-ref opts 'bootstrap?)
%bootstrap-guile
- (canonical-package guile-2.2)))))
+ (default-guile)))))
(with-profile-lock profile
(run-with-store store
(build-and-install instances profile)))))))))))))))
diff --git a/guix/self.scm b/guix/self.scm
index 4682cd221c..a9568049b2 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -48,12 +48,12 @@
(let ((ref (lambda (module variable)
(module-ref (resolve-interface module) variable))))
(match-lambda
- ("guile" (ref '(gnu packages guile) 'guile-3.0))
- ("guile-json" (ref '(gnu packages guile) 'guile3.0-json))
- ("guile-ssh" (ref '(gnu packages ssh) 'guile3.0-ssh))
- ("guile-git" (ref '(gnu packages guile) 'guile3.0-git))
- ("guile-sqlite3" (ref '(gnu packages guile) 'guile3.0-sqlite3))
- ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile3.0-gcrypt))
+ ("guile" (ref '(gnu packages guile) 'guile-3.0/libgc-7))
+ ("guile-json" (ref '(gnu packages guile) 'guile-json-3))
+ ("guile-ssh" (ref '(gnu packages ssh) 'guile-ssh))
+ ("guile-git" (ref '(gnu packages guile) 'guile-git))
+ ("guile-sqlite3" (ref '(gnu packages guile) 'guile-sqlite3))
+ ("guile-gcrypt" (ref '(gnu packages gnupg) 'guile-gcrypt))
("gnutls" (ref '(gnu packages tls) 'guile3.0-gnutls))
("zlib" (ref '(gnu packages compression) 'zlib))
("lzlib" (ref '(gnu packages compression) 'lzlib))
diff --git a/guix/store.scm b/guix/store.scm
index fb4b92e0c4..6c7c07fd2d 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -103,6 +103,7 @@
add-text-to-store
add-to-store
add-file-tree-to-store
+ file-mapping->tree
binary-file
with-build-handler
map/accumulate-builds
@@ -1237,6 +1238,45 @@ an arbitrary directory layout in the store without creating a derivation."
(hash-set! cache tree result)
result)))))
+(define (file-mapping->tree mapping)
+ "Convert MAPPING, an alist like:
+
+ ((\"guix/build/utils.scm\" . \"…/utils.scm\"))
+
+to a tree suitable for 'add-file-tree-to-store' and 'interned-file-tree'."
+ (let ((mapping (map (match-lambda
+ ((destination . source)
+ (cons (string-tokenize destination %not-slash)
+ source)))
+ mapping)))
+ (fold (lambda (pair result)
+ (match pair
+ ((destination . source)
+ (let loop ((destination destination)
+ (result result))
+ (match destination
+ ((file)
+ (let* ((mode (stat:mode (stat source)))
+ (type (if (zero? (logand mode #o100))
+ 'regular
+ 'executable)))
+ (alist-cons file
+ `(,type (file ,source))
+ result)))
+ ((file rest ...)
+ (let ((directory (assoc-ref result file)))
+ (alist-cons file
+ `(directory
+ ,@(loop rest
+ (match directory
+ (('directory . entries) entries)
+ (#f '()))))
+ (if directory
+ (alist-delete file result)
+ result)))))))))
+ '()
+ mapping)))
+
(define current-build-prompt
;; When true, this is the prompt to abort to when 'build-things' is called.
(make-parameter #f))
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 88d05dc42e..ef52036ede 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2019 Caleb Ristvedt <caleb.ristvedt@cune.org>
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -228,16 +228,18 @@ Every store item in REFERENCES must already be registered."
;;; High-level interface.
;;;
-(define (reset-timestamps file)
+(define* (reset-timestamps file #:key preserve-permissions?)
"Reset the modification time on FILE and on all the files it contains, if
-it's a directory. While at it, canonicalize file permissions."
+it's a directory. Canonicalize file permissions unless PRESERVE-PERMISSIONS?
+is true."
;; Note: We're resetting to one second after the Epoch like 'guix-daemon'
;; has always done.
(let loop ((file file)
(type (stat:type (lstat file))))
(case type
((directory)
- (chmod file #o555)
+ (unless preserve-permissions?
+ (chmod file #o555))
(utime file 1 1 0 0)
(let ((parent file))
(for-each (match-lambda
@@ -254,7 +256,8 @@ it's a directory. While at it, canonicalize file permissions."
((symlink)
(utime file 1 1 0 0 AT_SYMLINK_NOFOLLOW))
(else
- (chmod file (if (executable-file? file) #o555 #o444))
+ (unless preserve-permissions?
+ (chmod file (if (executable-file? file) #o555 #o444)))
(utime file 1 1 0 0)))))
(define* (register-path path
diff --git a/guix/tests.scm b/guix/tests.scm
index ff31bcad44..95a7d7c4b8 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -415,6 +415,9 @@ default values, and with EXTRA-FIELDS set as specified."
#:implicit-inputs? #f
#:tests? #f ;cannot run "make check"
,@(substitute-keyword-arguments (package-arguments gnu-make)
+ ((#:configure-flags flags ''())
+ ;; As in 'gnu-make-boot0', work around a 'config.status' defect.
+ `(cons "--disable-dependency-tracking" ,flags))
((#:phases phases)
`(modify-phases ,phases
(replace 'build