Merge branch 'master' into core-updates-frozen

 Conflicts:
	gnu/packages/bioinformatics.scm
	gnu/packages/chez.scm
	gnu/packages/docbook.scm
	gnu/packages/ebook.scm
	gnu/packages/gnome.scm
	gnu/packages/linux.scm
	gnu/packages/networking.scm
	gnu/packages/python-web.scm
	gnu/packages/python-xyz.scm
	gnu/packages/tex.scm
	gnu/packages/version-control.scm
	gnu/packages/xml.scm
	guix/build-system/dune.scm
	guix/build-system/go.scm
	guix/build-system/linux-module.scm
	guix/packages.scm

3 files changed, 165 insertions, 19 deletions

diff --git a/guix/build-system/dune.scm b/guix/build-system/dune.scm
index 303b5f76c6..12100fd8e8 100644
--- a/guix/build-system/dune.scm
+++ b/guix/build-system/dune.scm
@@ -61,6 +61,17 @@
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
+
+  ;; Flags that put dune into reproducible build mode.
+  (define dune-release-flags
+    (if (version>=? (package-version dune) "2.5.0")
+        ;; For dune >= 2.5.0 this is just --release.
+        ''("--release")
+        ;; --release does not exist before 2.5.0.  Replace with flags compatible
+        ;; with our old ocaml4.07-dune (1.11.3)
+        ''("--root" "." "--ignore-promoted-rules" "--no-config"
+           "--profile" "release")))
+
   (define private-keywords
     '(#:target #:dune #:findlib #:ocaml #:inputs #:native-inputs))
 
@@ -80,7 +91,9 @@
            (build-inputs `(("dune" ,dune)
                            ,@(bag-build-inputs base)))
            (build dune-build)
-           (arguments (strip-keyword-arguments private-keywords arguments))))))
+           (arguments (append
+                       `(#:dune-release-flags ,dune-release-flags)
+                       (strip-keyword-arguments private-keywords arguments)))))))
 
 (define* (dune-build name inputs
                      #:key
@@ -91,7 +104,7 @@
                      (out-of-source? #t)
                      (jbuild? #f)
                      (package #f)
-                     (profile "release")
+                     (dune-release-flags ''())
                      (tests? #t)
                      (test-flags ''())
                      (test-target "test")
@@ -131,7 +144,7 @@ provides a 'setup.ml' file as its build system."
                       #:out-of-source? #$out-of-source?
                       #:jbuild? #$jbuild?
                       #:package #$package
-                      #:profile #$profile
+                      #:dune-release-flags #$dune-release-flags
                       #:tests? #$tests?
                       #:test-target #$test-target
                       #:install-target #$install-target
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index 100d1db4b6..b62f2a897b 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +31,7 @@
   #:use-module (guix packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
   #:export (%go-build-system-modules
             go-build
             go-build-system
@@ -81,6 +83,24 @@ present) if a pseudo-version pattern is not recognized."
 commit hash and its date rather than a proper release tag."
   (regexp-exec %go-pseudo-version-rx version))
 
+(define (go-target target)
+    ;; Parse the nix-system equivalent of the target and set the
+    ;; target for compilation accordingly.
+    (match (string-split (gnu-triplet->nix-system target) #\-)
+      ((arch os)
+       (list (match arch
+               ("aarch64" "arm64")
+               ("armhf" "arm")
+               ("powerpc64le" "ppc64le")
+               ("powerpc64" "ppc64")
+               ("i686" "386")
+               ("x86_64" "amd64")
+               ("mips64el" "mips64le")
+               (_ arch))
+             (match os
+               ((or "mingw32" "cygwin") "windows")
+               (_ os))))))
+
 (define %go-build-system-modules
   ;; Build-side modules imported and used by default.
   `((guix build go-build-system)
@@ -101,22 +121,37 @@ commit hash and its date rather than a proper release tag."
   (define private-keywords
     '(#:target #:go #:inputs #:native-inputs))
 
-  (and (not target)                               ;XXX: no cross-compilation
-       (bag
-         (name name)
-         (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
-
-                        ;; Keep the standard inputs of 'gnu-build-system'.
-                        ,@(standard-packages)))
-         (build-inputs `(("go" ,go)
-                         ,@native-inputs))
-         (outputs outputs)
-         (build go-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+  (bag
+    (name name)
+    (system system)
+    (target target)
+    (build-inputs `(,@(if source
+                        `(("source" ,source))
+                        '())
+                     ,@`(("go" ,go))
+                     ,@native-inputs
+                     ,@(if target '() inputs)
+                     ,@(if target
+                         ;; Use the standard cross inputs of
+                         ;; 'gnu-build-system'.
+                         (standard-cross-packages target 'host)
+                         '())
+                     ;; Keep the standard inputs of 'gnu-build-system'.
+                     ,@(standard-packages)))
+    (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
+    ;; native package, so it would end up using a "native" variant of
+    ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
+    ;; would use a target variant (built with 'gnu-cross-build'.)
+    (target-inputs (if target
+                     (standard-cross-packages target 'target)
+                     '()))
+
+    (outputs outputs)
+    (build (if target go-cross-build go-build))
+    (arguments (strip-keyword-arguments private-keywords arguments))))
 
 (define* (go-build name inputs
                    #:key
@@ -131,6 +166,8 @@ commit hash and its date rather than a proper release tag."
                    (tests? #t)
                    (allow-go-reference? #f)
                    (system (%current-system))
+                   (goarch (first (go-target (%current-system))))
+                   (goos (last (go-target (%current-system))))
                    (guile #f)
                    (imported-modules %go-build-system-modules)
                    (modules '((guix build go-build-system)
@@ -145,6 +182,8 @@ commit hash and its date rather than a proper release tag."
                     #:system #$system
                     #:phases #$phases
                     #:outputs #$(outputs->gexp outputs)
+                    #:goarch #$goarch
+                    #:goos #$goos
                     #:search-paths '#$(sexp->gexp
                                        (map search-path-specification->sexp
                                             search-paths))
@@ -162,6 +201,98 @@ commit hash and its date rather than a proper release tag."
                       #:system system
                       #:guile-for-build guile)))
 
+(define* (go-cross-build store name
+                         #:key
+                         target native-drvs target-drvs
+                         (phases '(@ (guix build go-build-system)
+                                     %standard-phases))
+                         (outputs '("out"))
+                         (search-paths '())
+                         (native-search-paths '())
+                         (install-source? #t)
+                         (import-path "")
+                         (unpack-path "")
+                         (build-flags ''())
+                         (tests? #f) ; nothing can be done
+                         (allow-go-reference? #f)
+                         (system (%current-system))
+                         (goarch (first (go-target target)))
+                         (goos (last (go-target target)))
+                         (guile #f)
+                         (imported-modules %go-build-system-modules)
+                         (modules '((guix build go-build-system)
+                                    (guix build union)
+                                    (guix build utils))))
+  "Cross-build NAME using GO, where TARGET is a GNU triplet and with INPUTS."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (let ()
+         (define %build-host-inputs
+           ',(map (match-lambda
+                    ((name (? derivation? drv) sub ...)
+                     `(,name . ,(apply derivation->output-path drv sub)))
+                    ((name path)
+                     `(,name . ,path)))
+                  native-drvs))
+
+         (define %build-target-inputs
+           ',(map (match-lambda
+                    ((name (? derivation? drv) sub ...)
+                     `(,name . ,(apply derivation->output-path drv sub)))
+                    ((name (? package? pkg) sub ...)
+                     (let ((drv (package-cross-derivation store pkg
+                                                          target system)))
+                       `(,name . ,(apply derivation->output-path drv sub))))
+                    ((name path)
+                     `(,name . ,path)))
+                  target-drvs))
+
+         (go-build #:name ,name
+                   #:source ,(match (assoc-ref native-drvs "source")
+                                    (((? derivation? source))
+                                     (derivation->output-path source))
+                                    ((source)
+                                     source)
+                                    (source
+                                      source))
+                   #:system ,system
+                   #:phases ,phases
+                   #:outputs %outputs
+                   #:target ,target
+                   #:goarch ,goarch
+                   #:goos ,goos
+                   #:inputs %build-target-inputs
+                   #:native-inputs %build-host-inputs
+                   #:search-paths ',(map search-path-specification->sexp
+                                         search-paths)
+                   #:native-search-paths ',(map
+                                             search-path-specification->sexp
+                                             native-search-paths)
+                   #:install-source? ,install-source?
+                   #:import-path ,import-path
+                   #:unpack-path ,unpack-path
+                   #:build-flags ,build-flags
+                   #:tests? ,tests?
+                   #:allow-go-reference? ,allow-go-reference?
+                   #:inputs %build-inputs))))
+
+    (define guile-for-build
+      (match guile
+             ((? package?)
+              (package-derivation store guile system #:graft? #f))
+             (#f                               ; the default
+              (let* ((distro (resolve-interface '(gnu packages commencement)))
+                     (guile  (module-ref distro 'guile-final)))
+                (package-derivation store guile system #:graft? #f)))))
+
+    (build-expression->derivation store name builder
+                                  #:system system
+                                  #:inputs (append native-drvs target-drvs)
+                                  #:outputs outputs
+                                  #:modules imported-modules
+                                  #:guile-for-build guile-for-build))
+
 (define go-build-system
   (build-system
     (name 'go)
diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index 84570b923a..7bafee5a7a 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -159,6 +159,7 @@
                              (outputs '("out"))
                              (make-flags ''())
                              (system (%current-system))
+                             (source-directory ".")
                              (guile #f)
                              (substitutable? #t)
                              (imported-modules
@@ -172,6 +173,7 @@
           (use-modules #$@(sexp->gexp modules))
           (linux-module-build #:name #$name
                               #:source #+source
+                              #:source-directory #$source-directory
                               #:search-paths '#$(sexp->gexp
                                                  (map search-path-specification->sexp
                                                       search-paths))