Merge branch 'core-updates'

16 files changed, 569 insertions, 150 deletions

diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm
index ee116c5a4c..ca88fadddf 100644
--- a/guix/build-system/cmake.scm
+++ b/guix/build-system/cmake.scm
@@ -48,7 +48,7 @@
 
   ;; Do not use `@' to avoid introducing circular dependencies.
   (let ((module (resolve-interface '(gnu packages cmake))))
-    (module-ref module 'cmake)))
+    (module-ref module 'cmake-minimal)))
 
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm
index 370d185545..b29f2f4ecf 100644
--- a/guix/build-system/meson.scm
+++ b/guix/build-system/meson.scm
@@ -90,7 +90,7 @@
                       (outputs '("out"))
                       (configure-flags ''())
                       (search-paths '())
-                      (build-type "plain")
+                      (build-type "debugoptimized")
                       (tests? #t)
                       (test-target "test")
                       (glib-or-gtk? #f)
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index e5f3197b0a..4df0bb4904 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -25,6 +25,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 ftw)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-34)
@@ -58,19 +59,14 @@ See https://reproducible-builds.org/specs/source-date-epoch/."
   (setenv "SOURCE_DATE_EPOCH" "1")
   #t)
 
-(define (first-subdirectory dir)
-  "Return the path of the first sub-directory of DIR."
-  (file-system-fold (lambda (path stat result)
-                      (string=? path dir))
-                    (lambda (path stat result) result) ; leaf
-                    (lambda (path stat result) result) ; down
-                    (lambda (path stat result) result) ; up
-                    (lambda (path stat result)         ; skip
-                      (or result path))
-                    (lambda (path stat errno result)   ; error
-                      (error "first-subdirectory" (strerror errno)))
-                    #f
-                    dir))
+(define (first-subdirectory directory)
+  "Return the file name of the first sub-directory of DIRECTORY."
+  (match (scandir directory
+                  (lambda (file)
+                    (and (not (member file '("." "..")))
+                         (file-is-directory? (string-append directory "/"
+                                                            file)))))
+    ((first . _) first)))
 
 (define* (set-paths #:key target inputs native-inputs
                     (search-paths '()) (native-search-paths '())
@@ -735,23 +731,64 @@ which cannot be found~%"
 
 (define* (install-license-files #:key outputs
                                 (license-file-regexp %license-file-regexp)
+                                out-of-source?
                                 #:allow-other-keys)
   "Install license files matching LICENSE-FILE-REGEXP to 'share/doc'."
+  (define (find-source-directory package)
+    ;; For an out-of-source build, guess the source directory location
+    ;; relative to the current directory.  Return #f on failure.
+    (match (scandir ".."
+                    (lambda (file)
+                      (and (not (member file '("." ".." "build")))
+                           (file-is-directory?
+                            (string-append "../" file)))))
+      (()                                         ;hmm, no source
+       #f)
+      ((source)                                   ;only one other file
+       (string-append "../" source))
+      ((directories ...)                          ;pick the most likely one
+       ;; This happens for example with libstdc++, which lives within the GCC
+       ;; source tree.
+       (any (lambda (directory)
+              (and (string-prefix? package directory)
+                   (string-append "../" directory)))
+            directories))))
+
+  (define (copy-to-directories directories sub-directory)
+    (lambda (file)
+      (for-each (if (file-is-directory? file)
+                    (cut copy-recursively file <>)
+                    (cut install-file file <>))
+                (map (cut string-append <> "/" sub-directory)
+                     directories))))
+
   (let* ((regexp    (make-regexp license-file-regexp))
          (out       (or (assoc-ref outputs "out")
                         (match outputs
                           (((_ . output) _ ...)
                            output))))
          (package   (strip-store-file-name out))
-         (directory (string-append out "/share/doc/" package))
-         (files     (scandir "." (lambda (file)
-                                   (regexp-exec regexp file)))))
-    (format #t "installing ~a license files~%" (length files))
-    (for-each (lambda (file)
-                (if (file-is-directory? file)
-                    (copy-recursively file directory)
-                    (install-file file directory)))
-              files)
+         (outputs   (match outputs
+                      (((_ . outputs) ...)
+                       outputs)))
+         (source    (if out-of-source?
+                        (find-source-directory
+                         (package-name->name+version package))
+                        "."))
+         (files     (and source
+                         (scandir source
+                                  (lambda (file)
+                                    (regexp-exec regexp file))))))
+    (if files
+        (begin
+          (format #t "installing ~a license files from '~a'~%"
+                  (length files) source)
+          (for-each (copy-to-directories outputs
+                                         (string-append "share/doc/"
+                                                        package))
+                    (map (cut string-append source "/" <>) files)))
+        (format (current-error-port)
+                "failed to find license files~%"))
     #t))
 
 (define %standard-phases
@@ -784,34 +821,37 @@ in order.  Return #t if all the PHASES succeeded, #f otherwise."
       (+ (time-second diff)
          (/ (time-nanosecond diff) 1e9))))
 
-  (setvbuf (current-output-port) _IOLBF)
-  (setvbuf (current-error-port) _IOLBF)
+  (setvbuf (current-output-port) 'line)
+  (setvbuf (current-error-port) 'line)
 
   ;; Encoding/decoding errors shouldn't be silent.
   (fluid-set! %default-port-conversion-strategy 'error)
 
-  ;; The trick is to #:allow-other-keys everywhere, so that each procedure in
-  ;; PHASES can pick the keyword arguments it's interested in.
-  (every (match-lambda
-           ((name . proc)
-            (let ((start (current-time time-monotonic)))
-              (format #t "starting phase `~a'~%" name)
-              (let ((result (apply proc args))
-                    (end    (current-time time-monotonic)))
-                (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
-                        name result
-                        (elapsed-time end start))
-
-                ;; Issue a warning unless the result is #t.
-                (unless (eqv? result #t)
-                  (format (current-error-port) "\
+  (guard (c ((invoke-error? c)
+             (report-invoke-error c)
+             (exit 1)))
+    ;; The trick is to #:allow-other-keys everywhere, so that each procedure in
+    ;; PHASES can pick the keyword arguments it's interested in.
+    (every (match-lambda
+             ((name . proc)
+              (let ((start (current-time time-monotonic)))
+                (format #t "starting phase `~a'~%" name)
+                (let ((result (apply proc args))
+                      (end    (current-time time-monotonic)))
+                  (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
+                          name result
+                          (elapsed-time end start))
+
+                  ;; Issue a warning unless the result is #t.
+                  (unless (eqv? result #t)
+                    (format (current-error-port) "\
 ## WARNING: phase `~a' returned `~s'.  Return values other than #t
 ## are deprecated.  Please migrate this package so that its phase
 ## procedures report errors by raising an exception, and otherwise
 ## always return #t.~%"
-                          name result))
+                            name result))
 
-                ;; Dump the environment variables as a shell script, for handy debugging.
-                (system "export > $NIX_BUILD_TOP/environment-variables")
-                result))))
-         phases))
+                  ;; Dump the environment variables as a shell script, for handy debugging.
+                  (system "export > $NIX_BUILD_TOP/environment-variables")
+                  result))))
+           phases)))
diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm
index 3dac43c18a..4bc0156a88 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -237,7 +237,7 @@ unpacking."
   "Install the source code of IMPORT-PATH to the primary output directory.
 Compiled executable files (Go \"commands\") should have already been installed
 to the store based on $GOBIN in the build phase.
-XXX We can't make us of compiled libraries (Go \"packages\")."
+XXX We can't make use of compiled libraries (Go \"packages\")."
   (when install-source?
     (if (string-null? import-path)
         ((display "WARNING: The Go import path is unset.\n")))
diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm
index d0975fcab0..8043a84abb 100644
--- a/guix/build/meson-build-system.scm
+++ b/guix/build/meson-build-system.scm
@@ -108,6 +108,7 @@ for example libraries only needed for the tests."
   ;; from the gnu-build-system.  If the glib-or-gtk? key is #f (the default)
   ;; then the extra phases will be removed again in (guix build-system meson).
   (modify-phases glib-or-gtk:%standard-phases
+    (delete 'bootstrap)
     (replace 'configure configure)
     (replace 'build build)
     (replace 'check check)
diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm
index 5bb0ba49d5..09bd8465c8 100644
--- a/guix/build/python-build-system.scm
+++ b/guix/build/python-build-system.scm
@@ -1,10 +1,11 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,6 +32,7 @@
   #:export (%standard-phases
             add-installed-pythonpath
             site-packages
+            python-version
             python-build))
 
 ;; Commentary:
@@ -146,7 +148,7 @@
       (format #t "test suite not run~%"))
   #t)
 
-(define (get-python-version python)
+(define (python-version python)
   (let* ((version     (last (string-split python #\-)))
          (components  (string-split version #\.))
          (major+minor (take components 2)))
@@ -157,7 +159,7 @@
   (let* ((out (assoc-ref outputs "out"))
          (python (assoc-ref inputs "python")))
     (string-append out "/lib/python"
-                   (get-python-version python)
+                   (python-version python)
                    "/site-packages/")))
 
 (define (add-installed-pythonpath inputs outputs)
@@ -186,11 +188,9 @@ when running checks after installing the package."
 
 (define* (wrap #:key inputs outputs #:allow-other-keys)
   (define (list-of-files dir)
-    (map (cut string-append dir "/" <>)
-         (or (scandir dir (lambda (f)
-                            (let ((s (stat (string-append dir "/" f))))
-                              (eq? 'regular (stat:type s)))))
-             '())))
+    (find-files dir (lambda (file stat)
+                      (and (eq? 'regular (stat:type stat))
+                           (not (wrapper? file))))))
 
   (define bindirs
     (append-map (match-lambda
@@ -203,7 +203,7 @@ when running checks after installing the package."
          (python (assoc-ref inputs "python"))
          (var `("PYTHONPATH" prefix
                 ,(cons (string-append out "/lib/python"
-                                      (get-python-version python)
+                                      (python-version python)
                                       "/site-packages")
                        (search-path-as-string->list
                         (or (getenv "PYTHONPATH") ""))))))
@@ -223,7 +223,7 @@ installed with setuptools."
   (let* ((out (assoc-ref outputs "out"))
          (python (assoc-ref inputs "python"))
          (site-packages (string-append out "/lib/python"
-                                       (get-python-version python)
+                                       (python-version python)
                                        "/site-packages"))
          (easy-install-pth (string-append site-packages "/easy-install.pth"))
          (new-pth (string-append site-packages "/" name ".pth")))
@@ -251,16 +251,21 @@ installed with setuptools."
   #t)
 
 (define %standard-phases
-  ;; 'configure' phase is not needed.
+  ;; The build phase only builds C extensions and copies the Python sources,
+  ;; while the install phase byte-compiles and copies them to the prefix
+  ;; directory.  The tests are run after the install phase because otherwise
+  ;; the cached .pyc generated during the tests execution seem to interfere
+  ;; with the byte compilation of the install phase.
   (modify-phases gnu:%standard-phases
     (add-after 'unpack 'ensure-no-mtimes-pre-1980 ensure-no-mtimes-pre-1980)
     (add-after 'ensure-no-mtimes-pre-1980 'enable-bytecode-determinism
       enable-bytecode-determinism)
     (delete 'bootstrap)
-    (delete 'configure)
-    (replace 'install install)
-    (replace 'check check)
+    (delete 'configure)                 ;not needed
     (replace 'build build)
+    (delete 'check)                     ;moved after the install phase
+    (replace 'install install)
+    (add-after 'install 'check check)
     (add-after 'install 'wrap wrap)
     (add-before 'strip 'rename-pth-file rename-pth-file)))
 
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index f2fdb4d9d1..bbf2531c79 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -68,6 +68,7 @@
             statfs
             free-disk-space
             device-in-use?
+            add-to-entropy-count
 
             processes
             mkdtemp!
@@ -708,6 +709,33 @@ backend device."
 
 
 ;;;
+;;; Random.
+;;;
+
+;; From <uapi/linux/random.h>.
+(define RNDADDTOENTCNT #x40045201)
+
+(define (add-to-entropy-count port-or-fd n)
+  "Add N to the kernel's entropy count (the value that can be read from
+/proc/sys/kernel/random/entropy_avail).  PORT-OR-FD must correspond to
+/dev/urandom or /dev/random.  Raise to 'system-error with EPERM when the
+caller lacks root privileges."
+  (let ((fd  (if (port? port-or-fd)
+                 (fileno port-or-fd)
+                 port-or-fd))
+        (box (make-bytevector (sizeof int))))
+    (bytevector-sint-set! box 0 n (native-endianness)
+                          (sizeof int))
+    (let-values (((ret err)
+                  (%ioctl fd RNDADDTOENTCNT
+                          (bytevector->pointer box))))
+      (unless (zero? err)
+        (throw 'system-error "add-to-entropy-count" "~A"
+               (list (strerror err))
+               (list err))))))
+
+
+;;;
 ;;; Containers.
 ;;;
 
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 5fe3286843..b8be73ead4 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -1,8 +1,10 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -87,7 +89,13 @@
             patch-/usr/bin/file
             fold-port-matches
             remove-store-references
+            wrapper?
             wrap-program
+            wrap-script
+
+            wrap-error?
+            wrap-error-program
+            wrap-error-type
 
             invoke
             invoke-error?
@@ -96,10 +104,33 @@
             invoke-error-exit-status
             invoke-error-term-signal
             invoke-error-stop-signal
+            report-invoke-error
+
+            invoke/quiet
 
             locale-category->string))
 
+
+;;;
+;;; Guile 2.0 compatibility later.
+;;;
 
+;; The bootstrap Guile is Guile 2.0, so provide a compatibility layer.
+(cond-expand
+  ((and guile-2 (not guile-2.2))
+   (define (setvbuf port mode . rest)
+     (apply (@ (guile) setvbuf) port
+            (match mode
+              ('line _IOLBF)
+              ('block _IOFBF)
+              ('none _IONBF)
+              (_ mode))                           ;an _IO* integer
+            rest))
+
+   (module-replace! (current-module) '(setvbuf)))
+  (else #f))
+
+
 ;;;
 ;;; Directories.
 ;;;
@@ -600,6 +631,11 @@ Where every <*-phase-name> is an expression evaluating to a symbol, and
     ((_ phases (add-after old-phase-name new-phase-name new-phase))
      (alist-cons-after old-phase-name new-phase-name new-phase phases))))
 
+
+;;;
+;;; Program invocation.
+;;;
+
 (define-condition-type &invoke-error &error
   invoke-error?
   (program      invoke-error-program)
@@ -621,6 +657,68 @@ if the exit code is non-zero; otherwise return #t."
                          (stop-signal (status:stop-sig code))))))
     #t))
 
+(define* (report-invoke-error c #:optional (port (current-error-port)))
+  "Report to PORT about C, an '&invoke-error' condition, in a human-friendly
+way."
+  (format port "command~{ ~s~} failed with ~:[signal~;status~] ~a~%"
+          (cons (invoke-error-program c)
+                (invoke-error-arguments c))
+          (invoke-error-exit-status c)
+          (or (invoke-error-exit-status c)
+              (invoke-error-term-signal c)
+              (invoke-error-stop-signal c))))
+
+(define (open-pipe-with-stderr program . args)
+  "Run PROGRAM with ARGS in an input pipe, but, unlike 'open-pipe*', redirect
+both its standard output and standard error to the pipe.  Return two value:
+the pipe to read PROGRAM's data from, and the PID of the child process running
+PROGRAM."
+  ;; 'open-pipe*' doesn't attempt to capture stderr in any way, which is why
+  ;; we need to roll our own.
+  (match (pipe)
+    ((input .  output)
+     (match (primitive-fork)
+       (0
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (close-port input)
+            (dup2 (fileno output) 1)
+            (dup2 (fileno output) 2)
+            (apply execlp program program args))
+          (lambda ()
+            (primitive-exit 127))))
+       (pid
+        (close-port output)
+        (values input pid))))))
+
+(define (invoke/quiet program . args)
+  "Invoke PROGRAM with ARGS and capture PROGRAM's standard output and standard
+error.  If PROGRAM succeeds, print nothing and return the unspecified value;
+otherwise, raise a '&message' error condition that includes the status code
+and the output of PROGRAM."
+  (let-values (((pipe pid)
+                (apply open-pipe-with-stderr program args)))
+    (let loop ((lines '()))
+      (match (read-line pipe)
+        ((? eof-object?)
+         (close-port pipe)
+         (match (waitpid pid)
+           ((_ . status)
+            (unless (zero? status)
+              (let-syntax ((G_ (syntax-rules ()   ;for xgettext
+                                 ((_ str) str))))
+                (raise (condition
+                        (&message
+                         (message (format #f (G_ "'~a~{ ~a~}' exited \
+with status ~a; output follows:~%~%~{  ~a~%~}")
+                                          program args
+                                          (or (status:exit-val status)
+                                              status)
+                                          (reverse lines)))))))))))
+        (line
+         (loop (cons line lines)))))))
+
 
 ;;;
 ;;; Text substitution (aka. sed).
@@ -987,8 +1085,8 @@ known as `nuke-refs' in Nixpkgs."
         ;; We cannot use `regexp-exec' here because it cannot deal with
         ;; strings containing NUL characters.
         (format #t "removing store references from `~a'...~%" file)
-        (setvbuf in _IOFBF 65536)
-        (setvbuf out _IOFBF 65536)
+        (setvbuf in 'block 65536)
+        (setvbuf out 'block 65536)
         (fold-port-matches (lambda (match result)
                              (put-bytevector out (string->utf8 store))
                              (put-u8 out (char->integer #\/))
@@ -1003,6 +1101,18 @@ known as `nuke-refs' in Nixpkgs."
                              (put-u8 out (char->integer char))
                              result))))))
 
+(define-condition-type &wrap-error &error
+  wrap-error?
+  (program    wrap-error-program)
+  (type       wrap-error-type))
+
+(define (wrapper? prog)
+  "Return #t if PROG is a wrapper as produced by 'wrap-program'."
+  (and (file-exists? prog)
+       (let ((base (basename prog)))
+         (and (string-prefix? "." base)
+              (string-suffix? "-real" base)))))
+
 (define* (wrap-program prog #:rest vars)
   "Make a wrapper for PROG.  VARS should look like this:
 
@@ -1100,6 +1210,120 @@ with definitions for VARS."
         (chmod prog-tmp #o755)
         (rename-file prog-tmp prog))))
 
+(define wrap-script
+  (let ((interpreter-regex
+         (make-regexp
+          (string-append "^#! ?(/[^ ]+/bin/("
+                         (string-join '("python[^ ]*"
+                                        "Rscript"
+                                        "perl"
+                                        "ruby"
+                                        "bash"
+                                        "sh") "|")
+                         "))( ?.*)")))
+        (coding-line-regex
+         (make-regexp
+          ".*#.*coding[=:][[:space:]]*([-a-zA-Z_0-9.]+)")))
+    (lambda* (prog #:key (guile (which "guile")) #:rest vars)
+      "Wrap the script PROG such that VARS are set first.  The format of VARS
+is the same as in the WRAP-PROGRAM procedure.  This procedure differs from
+WRAP-PROGRAM in that it does not create a separate shell script.  Instead,
+PROG is modified directly by prepending a Guile script, which is interpreted
+as a comment in the script's language.
+
+Special encoding comments as supported by Python are recreated on the second
+line.
+
+Note that this procedure can only be used once per file as Guile scripts are
+not supported."
+      (define update-env
+        (match-lambda
+          ((var sep '= rest)
+           `(setenv ,var ,(string-join rest sep)))
+          ((var sep 'prefix rest)
+           `(let ((current (getenv ,var)))
+              (setenv ,var (if current
+                               (string-append ,(string-join rest sep)
+                                              ,sep current)
+                               ,(string-join rest sep)))))
+          ((var sep 'suffix rest)
+           `(let ((current (getenv ,var)))
+              (setenv ,var (if current
+                               (string-append current ,sep
+                                              ,(string-join rest sep))
+                               ,(string-join rest sep)))))
+          ((var '= rest)
+           `(setenv ,var ,(string-join rest ":")))
+          ((var 'prefix rest)
+           `(let ((current (getenv ,var)))
+              (setenv ,var (if current
+                               (string-append ,(string-join rest ":")
+                                              ":" current)
+                               ,(string-join rest ":")))))
+          ((var 'suffix rest)
+           `(let ((current (getenv ,var)))
+              (setenv ,var (if current
+                               (string-append current ":"
+                                              ,(string-join rest ":"))
+                               ,(string-join rest ":")))))))
+      (let-values (((interpreter args coding-line)
+                    (call-with-ascii-input-file prog
+                      (lambda (p)
+                        (let ((first-match
+                               (false-if-exception
+                                (regexp-exec interpreter-regex (read-line p)))))
+                          (values (and first-match (match:substring first-match 1))
+                                  (and first-match (match:substring first-match 3))
+                                  (false-if-exception
+                                   (and=> (regexp-exec coding-line-regex (read-line p))
+                                          (lambda (m) (match:substring m 0))))))))))
+        (if interpreter
+            (let* ((header (format #f "\
+#!~a --no-auto-compile
+#!#; ~a
+#\\-~s
+#\\-~s
+"
+                                   guile
+                                   (or coding-line "Guix wrapper")
+                                   (cons 'begin (map update-env
+                                                     (match vars
+                                                       ((#:guile _ . vars) vars)
+                                                       (_ vars))))
+                                   `(let ((cl (command-line)))
+                                      (apply execl ,interpreter
+                                             (car cl)
+                                             (cons (car cl)
+                                                   (append
+                                                    ',(string-split args #\space)
+                                                    cl))))))
+                   (template (string-append prog ".XXXXXX"))
+                   (out      (mkstemp! template))
+                   (st       (stat prog))
+                   (mode     (stat:mode st)))
+              (with-throw-handler #t
+                (lambda ()
+                  (call-with-ascii-input-file prog
+                    (lambda (p)
+                      (format out header)
+                      (dump-port p out)
+                      (close out)
+                      (chmod template mode)
+                      (rename-file template prog)
+                      (set-file-time prog st))))
+                (lambda (key . args)
+                  (format (current-error-port)
+                          "wrap-script: ~a: error: ~a ~s~%"
+                          prog key args)
+                  (false-if-exception (delete-file template))
+                  (raise (condition
+                          (&wrap-error (program prog)
+                                       (type key))))
+                  #f)))
+            (raise (condition
+                    (&wrap-error (program prog)
+                                 (type 'no-interpreter-found)))))))))
+
 
 ;;;
 ;;; Locales.
diff --git a/guix/channels.scm b/guix/channels.scm
index 4e6e7090ac..2c28dccbcb 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -27,6 +27,7 @@
   #:use-module (guix discovery)
   #:use-module (guix monads)
   #:use-module (guix profiles)
+  #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (guix combinators)
   #:use-module (guix diagnostics)
@@ -47,6 +48,7 @@
   #:autoload   (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
+  #:use-module ((ice-9 rdelim) #:select (read-string))
   #:export (channel
             channel?
             channel-name
@@ -306,6 +308,46 @@ to '%package-module-path'."
 
     (gexp->derivation-in-inferior name build core)))
 
+(define (syscalls-reexports-local-variables? source)
+  "Return true if (guix build syscalls) contains the bug described at
+<https://bugs.gnu.org/36723>."
+  (catch 'system-error
+    (lambda ()
+      (define content
+        (call-with-input-file (string-append source
+                                             "/guix/build/syscalls.scm")
+          read-string))
+
+      ;; The faulty code would use the 're-export' macro, causing the
+      ;; 'AT_SYMLINK_NOFOLLOW' local variable to be re-exported when using
+      ;; Guile > 2.2.4.
+      (string-contains content "(re-export variable)"))
+    (lambda args
+      (if (= ENOENT (system-error-errno args))
+          #f
+          (apply throw args)))))
+
+(define (guile-2.2.4)
+  (module-ref (resolve-interface '(gnu packages guile))
+              'guile-2.2.4))
+
+(define %quirks
+  ;; List of predicate/package pairs.  This allows us 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* (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."
+  (let loop ((quirks quirks))
+    (match quirks
+      (()
+       #f)
+      (((predicate . guile) rest ...)
+       (if (predicate source) (guile) (loop rest))))))
+
 (define* (build-from-source name source
                             #:key core verbose? commit
                             (dependencies '()))
@@ -327,15 +369,19 @@ package modules under SOURCE using CORE, an instance of Guix."
                       ;; about it.
                       (parameterize ((guix-warning-port
                                       (%make-void-port "w")))
-                        (primitive-load script))))))
+                        (primitive-load script)))))
+            (guile (guile-for-source source)))
         ;; BUILD must be a monadic procedure of at least one argument: the
         ;; source tree.
         ;;
         ;; Note: BUILD can return #f if it does not support %PULL-VERSION.  In
         ;; the future we'll fall back to a previous version of the protocol
         ;; when that happens.
-        (build source #:verbose? verbose? #:version commit
-               #:pull-version %pull-version))
+        (mbegin %store-monad
+          (mwhen guile
+            (set-guile-for-build guile))
+          (build source #:verbose? verbose? #:version commit
+                 #:pull-version %pull-version)))
 
       ;; Build a set of modules that extend Guix using the standard method.
       (standard-module-derivation name source core dependencies)))
diff --git a/guix/download.scm b/guix/download.scm
index b24aaa0a86..47c8087732 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -36,6 +36,7 @@
   #:use-module (srfi srfi-26)
   #:export (%mirrors
             url-fetch
+            url-fetch/executable
             url-fetch/tarbomb
             url-fetch/zipbomb
             download-to-store))
@@ -419,8 +420,10 @@
 (define* (built-in-download file-name url
                             #:key system hash-algo hash
                             mirrors content-addressed-mirrors
+                            executable?
                             (guile 'unused))
-  "Download FILE-NAME from URL using the built-in 'download' builder.
+  "Download FILE-NAME from URL using the built-in 'download' builder.  When
+EXECUTABLE? is true, make the downloaded file executable.
 
 This is an \"out-of-band\" download in that the returned derivation does not
 explicitly depend on Guile, GnuTLS, etc.  Instead, the daemon performs the
@@ -432,6 +435,7 @@ download by itself using its own dependencies."
                     #:system system
                     #:hash-algo hash-algo
                     #:hash hash
+                    #:recursive? executable?
                     #:sources (list mirrors content-addressed-mirrors)
 
                     ;; Honor the user's proxy and locale settings.
@@ -442,7 +446,10 @@ download by itself using its own dependencies."
                     #:env-vars `(("url" . ,(object->string url))
                                  ("mirrors" . ,mirrors)
                                  ("content-addressed-mirrors"
-                                  . ,content-addressed-mirrors))
+                                  . ,content-addressed-mirrors)
+                                 ,@(if executable?
+                                       '(("executable" . "1"))
+                                       '()))
 
                     ;; Do not offload this derivation because we cannot be
                     ;; sure that the remote daemon supports the 'download'
@@ -453,11 +460,13 @@ download by itself using its own dependencies."
 (define* (url-fetch url hash-algo hash
                     #:optional name
                     #:key (system (%current-system))
-                    (guile (default-guile)))
+                    (guile (default-guile))
+                    executable?)
   "Return a fixed-output derivation that fetches URL (a string, or a list of
 strings denoting alternate URLs), which is expected to have hash HASH of type
 HASH-ALGO (a symbol).  By default, the file name is the base name of URL;
-optionally, NAME can specify a different file name.
+optionally, NAME can specify a different file name.  When EXECUTABLE? is true,
+make the downloaded file executable.
 
 When one of the URL starts with mirror://, then its host part is
 interpreted as the name of a mirror scheme, taken from %MIRROR-FILE.
@@ -488,10 +497,21 @@ in the store."
                              #:system system
                              #:hash-algo hash-algo
                              #:hash hash
+                             #:executable? executable?
                              #:mirrors %mirror-file
                              #:content-addressed-mirrors
                              %content-addressed-mirror-file)))))
 
+(define* (url-fetch/executable url hash-algo hash
+                               #:optional name
+                               #:key (system (%current-system))
+                               (guile (default-guile)))
+  "Like 'url-fetch', but make the downloaded file executable."
+  (url-fetch url hash-algo hash name
+             #:system system
+             #:guile guile
+             #:executable? #t))
+
 (define* (url-fetch/tarbomb url hash-algo hash
                             #:optional name
                             #:key (system (%current-system))
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 26881ce16c..600750e846 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -663,8 +663,7 @@ names and file names suitable for the #:allowed-references argument to
                      (guile-for-build (%guile-for-build))
                      (effective-version "2.2")
 
-                     deprecation-warnings
-                     (pre-load-modules? #t))      ;transitional
+                     deprecation-warnings)
   "*Note: This API is subject to change; use at your own risk!*
 
 Lower EXP, a gexp, instantiating it for SYSTEM and TARGET.  Return a
@@ -731,8 +730,6 @@ derivations--e.g., code evaluated for its side effects."
                                                        #:module-path module-path
                                                        #:extensions extensions
                                                        #:guile guile
-                                                       #:pre-load-modules?
-                                                       pre-load-modules?
                                                        #:deprecation-warnings
                                                        deprecation-warnings)
                                      (return #f))))
@@ -776,12 +773,6 @@ derivations--e.g., code evaluated for its side effects."
                            leaked-env-vars
                            local-build? (substitutable? #t)
                            (properties '())
-
-                           ;; TODO: This parameter is transitional; it's here
-                           ;; to avoid a full rebuild.  Remove it on the next
-                           ;; rebuild cycle.
-                           (pre-load-modules? #t)
-
                            deprecation-warnings
                            (script-name (string-append name "-builder")))
   "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
@@ -865,9 +856,7 @@ The other arguments are as for 'derivation'."
                                               #:effective-version
                                               effective-version
                                               #:deprecation-warnings
-                                              deprecation-warnings
-                                              #:pre-load-modules?
-                                              pre-load-modules?))
+                                              deprecation-warnings))
 
                        (graphs   (if references-graphs
                                      (lower-reference-graphs references-graphs
@@ -1349,11 +1338,7 @@ last one is created from the given <scheme-file> object."
                            (guile (%guile-for-build))
                            (module-path %load-path)
                            (extensions '())
-                           (deprecation-warnings #f)
-
-                           ;; TODO: This flag is here to prevent a full
-                           ;; rebuild.  Remove it on the next rebuild cycle.
-                           (pre-load-modules? #t))
+                           (deprecation-warnings #f))
   "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.  When TARGET is true, cross-compile MODULES for
@@ -1393,11 +1378,8 @@ TARGET, a GNU triplet."
                (let* ((base   (basename entry ".scm"))
                       (output (string-append output "/" base ".go")))
                  (format #t "[~2@a/~2@a] Compiling '~a'...~%"
-                         (+ 1 processed
-                              (ungexp-splicing (if pre-load-modules?
-                                                   (gexp ((ungexp total)))
-                                                   (gexp ()))))
-                         (ungexp (* total (if pre-load-modules? 2 1)))
+                         (+ 1 processed (ungexp total))
+                         (ungexp (* total 2))
                          entry)
 
                  (ungexp-splicing
@@ -1421,6 +1403,26 @@ TARGET, a GNU triplet."
                    processed
                    entries)))
 
+         (define* (load-from-directory directory
+                                       #:optional (loaded 0))
+           "Load all the source files found in DIRECTORY."
+           ;; XXX: This works around <https://bugs.gnu.org/15602>.
+           (let ((entries (map (cut string-append directory "/" <>)
+                               (scandir directory regular?))))
+             (fold (lambda (file loaded)
+                     (if (file-is-directory? file)
+                         (load-from-directory file loaded)
+                         (begin
+                           (format #t "[~2@a/~2@a] Loading '~a'...~%"
+                                   (+ 1 loaded) (ungexp (* 2 total))
+                                   file)
+                           (save-module-excursion
+                            (lambda ()
+                              (primitive-load file)))
+                           (+ 1 loaded))))
+                   loaded
+                   entries)))
+
          (setvbuf (current-output-port)
                   (cond-expand (guile-2.2 'line) (else _IOLBF)))
 
@@ -1456,32 +1458,7 @@ TARGET, a GNU triplet."
          (mkdir (ungexp output))
          (chdir (ungexp modules))
 
-         (ungexp-splicing
-          (if pre-load-modules?
-              (gexp ((define* (load-from-directory directory
-                                                   #:optional (loaded 0))
-                       "Load all the source files found in DIRECTORY."
-                       ;; XXX: This works around <https://bugs.gnu.org/15602>.
-                       (let ((entries (map (cut string-append directory "/" <>)
-                                           (scandir directory regular?))))
-                         (fold (lambda (file loaded)
-                                 (if (file-is-directory? file)
-                                     (load-from-directory file loaded)
-                                     (begin
-                                       (format #t "[~2@a/~2@a] Loading '~a'...~%"
-                                               (+ 1 loaded)
-                                               (ungexp (* 2 total))
-                                               file)
-                                       (save-module-excursion
-                                        (lambda ()
-                                          (primitive-load file)))
-                                       (+ 1 loaded))))
-                               loaded
-                               entries)))
-
-                     (load-from-directory ".")))
-              (gexp ())))
-
+         (load-from-directory ".")
          (process-directory "." (ungexp output) 0))))
 
     ;; TODO: Pass MODULES as an environment variable.
diff --git a/guix/packages.scm b/guix/packages.scm
index b92ed0ab0c..f2c94c7bc2 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -505,11 +506,17 @@ specifies modules in scope when evaluating SNIPPET."
     (and=> (file-extension file-name)
            (cut string-every char-set:hex-digit <>)))
 
+  (define (checkout? directory)
+    ;; Return true if DIRECTORY is a checkout (git, svn, etc).
+    (string-suffix? "-checkout" directory))
+
   (define (tarxz-name file-name)
     ;; Return a '.tar.xz' file name based on FILE-NAME.
-    (let ((base (if (numeric-extension? file-name)
-                    original-file-name
-                    (file-sans-extension file-name))))
+    (let ((base (cond ((numeric-extension? file-name)
+                       original-file-name)
+                      ((checkout? file-name)
+                       (string-drop-right file-name 9))
+                      (else (file-sans-extension file-name)))))
       (string-append base
                      (if (equal? (file-extension base) "tar")
                          ".xz"
@@ -642,13 +649,11 @@ specifies modules in scope when evaluating SNIPPET."
 
     (let ((name (tarxz-name original-file-name)))
       (gexp->derivation name build
-                        ;; TODO: Remove this on the next rebuild cycle.
-                        #:pre-load-modules? #f
-
                         #:graft? #f
                         #:system system
-                        #:deprecation-warnings #t ;to avoid a rebuild
-                        #:guile-for-build guile-for-build))))
+                        #:guile-for-build guile-for-build
+                        #:properties `((type . origin)
+                                       (patches . ,(length patches)))))))
 
 (define (transitive-inputs inputs)
   "Return the closure of INPUTS when considering the 'propagated-inputs'
@@ -762,23 +767,29 @@ in INPUTS and their transitive propagated inputs."
        (transitive-inputs inputs)))
 
 (define package-transitive-supported-systems
-  (mlambdaq (package)
-    "Return the intersection of the systems supported by PACKAGE and those
+  (let ()
+    (define supported-systems
+      (mlambda (package system)
+        (parameterize ((%current-system system))
+          (fold (lambda (input systems)
+                  (match input
+                    ((label (? package? package) . _)
+                     (lset-intersection string=? systems
+                                        (supported-systems package system)))
+                    (_
+                     systems)))
+                (package-supported-systems package)
+                (bag-direct-inputs (package->bag package))))))
+
+    (lambda* (package #:optional (system (%current-system)))
+      "Return the intersection of the systems supported by PACKAGE and those
 supported by its dependencies."
-    (fold (lambda (input systems)
-            (match input
-              ((label (? package? p) . _)
-               (lset-intersection
-                string=? systems (package-transitive-supported-systems p)))
-              (_
-               systems)))
-          (package-supported-systems package)
-          (bag-direct-inputs (package->bag package)))))
+      (supported-systems package system))))
 
 (define* (supported-package? package #:optional (system (%current-system)))
   "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its
 dependencies are known to build on SYSTEM."
-  (member system (package-transitive-supported-systems package)))
+  (member system (package-transitive-supported-systems package system)))
 
 (define (bag-direct-inputs bag)
   "Same as 'package-direct-inputs', but applied to a bag."
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 4a51654ce6..d78ca0f303 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -29,7 +29,7 @@
   #:use-module (guix search-paths)
   #:use-module (guix build utils)
   #:use-module (guix monads)
-  #:use-module ((guix gexp) #:select (lower-inputs))
+  #:use-module ((guix gexp) #:select (lower-object))
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (gnu build linux-container)
@@ -40,7 +40,8 @@
   #:use-module (gnu packages bash)
   #:use-module (gnu packages commencement)
   #:use-module (gnu packages guile)
-  #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
+  #:use-module ((gnu packages bootstrap)
+                #:select (bootstrap-executable %bootstrap-guile))
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -630,8 +631,7 @@ Otherwise, return the derivation for the Bash package."
       (package->derivation bash))
      ;; Use the bootstrap Bash instead.
      ((and container? bootstrap?)
-      (interned-file
-       (search-bootstrap-binary "bash" system)))
+      (lower-object (bootstrap-executable "bash" system)))
      (else
       (return #f)))))
 
@@ -764,7 +764,7 @@ message if any test fails."
                    (container?
                     (let ((bash-binary
                            (if bootstrap?
-                               bash
+                               (derivation->output-path bash)
                                (string-append (derivation->output-path bash)
                                               "/bin/sh"))))
                       (launch-environment/container #:command command
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 2543f0c0b5..920d6c01fe 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -574,9 +574,9 @@ the image."
   "Return the C compiler that uses the bootstrap toolchain.  This is used only
 by '--bootstrap', for testing purposes."
   (define bootstrap-toolchain
-    (list (first (assoc-ref %bootstrap-inputs "gcc"))
-          (first (assoc-ref %bootstrap-inputs "binutils"))
-          (first (assoc-ref %bootstrap-inputs "libc"))))
+    (list (first (assoc-ref (%bootstrap-inputs) "gcc"))
+          (first (assoc-ref (%bootstrap-inputs) "binutils"))
+          (first (assoc-ref (%bootstrap-inputs) "libc"))))
 
   (c-compiler bootstrap-toolchain
               #:guile %bootstrap-guile))
diff --git a/guix/self.scm b/guix/self.scm
index 142c834137..207e80d842 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -733,6 +733,7 @@ Info manual."
                  (filter-map (match-lambda
                                (('guix 'scripts _ ..1) #f)
                                (('guix 'man-db) #f)
+                               (('guix 'tests _ ...) #f)
                                (name name))
                              (scheme-modules* source "guix"))
                  (list *core-modules*)
diff --git a/guix/tests.scm b/guix/tests.scm
index 66d60e964e..ff31bcad44 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -23,12 +23,18 @@
   #:use-module (guix packages)
   #:use-module (guix base32)
   #:use-module (guix serialization)
+  #:use-module (guix monads)
+  #:use-module ((guix utils) #:select (substitute-keyword-arguments))
+  #:use-module ((guix build utils) #:select (mkdir-p))
   #:use-module (gcrypt hash)
   #:use-module (guix build-system gnu)
+  #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 binary-ports)
   #:use-module (web uri)
   #:export (open-connection-for-tests
@@ -42,6 +48,8 @@
             shebang-too-long?
             with-environment-variable
 
+            search-bootstrap-binary
+
             mock
             %test-substitute-urls
             test-assertm
@@ -50,7 +58,9 @@
             with-derivation-narinfo
             with-derivation-substitute
             dummy-package
-            dummy-origin))
+            dummy-origin
+
+            gnu-make-for-tests))
 
 ;;; Commentary:
 ;;;
@@ -83,6 +93,35 @@
 
       store)))
 
+(define (bootstrap-binary-file program system)
+  "Return the absolute file name where bootstrap binary PROGRAM for SYSTEM is
+stored."
+  (string-append (dirname (search-path %load-path
+                                       "gnu/packages/bootstrap.scm"))
+                 "/bootstrap/" system "/" program))
+
+(define (search-bootstrap-binary file-name system)
+  "Search the bootstrap binary FILE-NAME for SYSTEM.  Raise an error if not
+found."
+  ;; Note: Keep bootstrap binaries on the local file system so that the 'guix'
+  ;; package can provide them as inputs and copy them to the right place.
+  (let* ((system (match system
+                   ("x86_64-linux" "i686-linux")
+                   (_ system)))
+         (file   (bootstrap-binary-file file-name system)))
+    (if (file-exists? file)
+        file
+        (with-store store
+          (run-with-store store
+            (mlet %store-monad ((drv (origin->derivation
+                                      (bootstrap-executable file-name system))))
+              (mbegin %store-monad
+                (built-derivations (list drv))
+                (begin
+                  (mkdir-p (dirname file))
+                  (copy-file (derivation->output-path drv) file)
+                  (return file)))))))))
+
 (define (call-with-external-store proc)
   "Call PROC with an open connection to the external store or #f it there is
 no external store to talk to."
@@ -364,6 +403,33 @@ default values, and with EXTRA-FIELDS set as specified."
                    (sha256 (base32 (make-string 52 #\x))))))
     (origin (inherit o) extra-fields ...)))
 
+(define gnu-make-for-tests
+  ;; This is a variant of 'gnu-make-boot0' that can be built with minimal
+  ;; resources.
+  (package-with-bootstrap-guile
+   (package
+     (inherit gnu-make)
+     (name "make-test-boot0")
+     (arguments
+      `(#:guile ,%bootstrap-guile
+        #:implicit-inputs? #f
+        #:tests? #f                               ;cannot run "make check"
+        ,@(substitute-keyword-arguments (package-arguments gnu-make)
+            ((#:phases phases)
+             `(modify-phases ,phases
+                (replace 'build
+                  (lambda _
+                    (invoke "./build.sh")
+                    #t))
+                (replace 'install
+                  (lambda* (#:key outputs #:allow-other-keys)
+                    (let* ((out (assoc-ref outputs "out"))
+                           (bin (string-append out "/bin")))
+                      (install-file "make" bin)
+                      #t))))))))
+     (native-inputs '())                          ;no need for 'pkg-config'
+     (inputs %bootstrap-inputs-for-tests))))
+
 ;; Local Variables:
 ;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1)
 ;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2)