[bug#48044] [PATCH v3] build/go: Support cross compiling.

[Efraim Flashner <efraim@flashner.co.il>]

* guix/build-system/go.scm (lower): Only add target to private-keywords
when not cross compiling. Adjust bag depending if doing a native or
cross compile.
(%go-build-system-modules): Use source-module-closure, add (guix utils).
(go-cross-build): New procedure.
* guix/build/go-build-system.scm (setup-go-environment): Accept target
keyword. Add logic to choose correct target architecture when cross
compiling.
---

Third version of this patch. I think I'm ready to push it. I don't love
using source-module-closure to include (guix utils), but I need it for
gnu-triplet->nix-system in setup-go-environment instead of the custom
parsing I was doing before.

---

 guix/build-system/go.scm       | 146 ++++++++++++++++++++++++++++-----
 guix/build/go-build-system.scm |  37 ++++++++-
 2 files changed, 162 insertions(+), 21 deletions(-)

diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index 8f55796e86..fe0c884b62 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016 Petter <petter@mykolab.ch>
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
 
 (define-module (guix build-system go)
   #:use-module (guix utils)
+  #:use-module (guix modules)
   #:use-module (guix derivations)
   #:use-module (guix search-paths)
   #:use-module (guix build-system)
@@ -80,9 +82,11 @@ commit hash and its date rather than a proper release tag."
 
 (define %go-build-system-modules
   ;; Build-side modules imported and used by default.
-  `((guix build go-build-system)
-    (guix build union)
-    ,@%gnu-build-system-modules))
+  (source-module-closure
+    `((guix build go-build-system)
+      (guix utils)
+      (guix build union)
+      ,@%gnu-build-system-modules)))
 
 (define (default-go)
   ;; Lazily resolve the binding to avoid a circular dependency.
@@ -96,24 +100,40 @@ commit hash and its date rather than a proper release tag."
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:source #:target #:go #:inputs #:native-inputs))
+    `(#:source #:go #:inputs #:native-inputs
+      ,@(if target '() '(#:target))))
 
-  (and (not target)                               ;XXX: no cross-compilation
-       (bag
-         (name name)
-         (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
+  (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 '()))
 
-                        ;; 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)))))
+    ;; 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 store name inputs
                    #:key
@@ -174,6 +194,94 @@ commit hash and its date rather than a proper release tag."
                                 #:outputs outputs
                                 #:guile-for-build guile-for-build))
 
+(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))
+                         (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
+                   #: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/go-build-system.scm b/guix/build/go-build-system.scm
index 227df820db..701ccf0011 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -4,7 +4,7 @@
 ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2020 Jack Hill <jackhill@jackhill.us>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
-;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +25,7 @@
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build union)
   #:use-module (guix build utils)
+  #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
   #:use-module (srfi srfi-1)
@@ -131,7 +132,7 @@
 ;;
 ;; Code:
 
-(define* (setup-go-environment #:key inputs outputs #:allow-other-keys)
+(define* (setup-go-environment #:key inputs outputs target #:allow-other-keys)
   "Prepare a Go build environment for INPUTS and OUTPUTS.  Build a file system
 union of INPUTS.  Export GOPATH, which helps the compiler find the source code
 of the package being built and its dependencies, and GOBIN, which determines
@@ -149,6 +150,38 @@ dependencies, so it should be self-contained."
   ;; GOPATH behavior.
   (setenv "GO111MODULE" "off")
   (setenv "GOBIN" (string-append (assoc-ref outputs "out") "/bin"))
+
+  ;; Cross-build
+  (when target
+    ;; Parse the nix-system equivalent of the target and set the
+    ;; target for compilation accordingly.
+    (let* ((system (gnu-triplet->nix-system target))
+           (dash   (string-index system #\-))
+           (arch   (substring system 0 dash))
+           (os     (substring system (+ 1 dash))))
+      (setenv "GOARCH" (match arch
+                         ("aarch64" "arm64")
+                         ("armhf" "arm")
+                         ("powerpc64le" "ppc64le")
+                         ("powerpc64" "ppc64")
+                         ("i686" "386")
+                         ("x86_64" "amd64")
+                         ("mips64el" "mips64le")
+                         (_ arch)))
+      (setenv "GOOS" (match os
+                       ((or "mingw" "cygwin") "windows")
+                       (_ os)))
+      (match arch
+        ((or "arm" "armhf")
+         (setenv "GOARM" "7"))
+        ((or "mips" "mipsel")
+         (setenv "GOMIPS" "hardfloat"))
+        ((or "mips64" "mips64el")
+         (setenv "GOMIPS64" "hardfloat"))
+        ((or "powerpc64" "powerpc64le")
+         (setenv "GOPPC64" "power8"))
+        (_ #t))))
+
   (let ((tmpdir (tmpnam)))
     (match (go-inputs inputs)
       (((names . directories) ...)

base-commit: 9e3b68203cba2b1bd96e524d3ae9dfc3336a72f7
-- 
2.33.0