[bug#56882] [PATCH 1/4] build-system/perl: Support cross-compilation of some Perl packages.

[Maxime Devos <maximedevos@telenet.be>]

* guix/build-system/perl.scm: Add info on cross-compilation.
(lower)[private-keywords]: Remove #:target when cross-compiling.
(lower)[target]: Set.
(host-inputs)[perl]: New entry.
(host-inputs)[(standard-packages)]: Move to ...
(build-inputs)[(standard-packages)]: ... here when cross-compiling.
(build-inputs)[standard-cross-packages]: Add when cross-compiling.
(target-inputs): New entry when cross-compiling.
(build): Use perl-cross-build when cross-compiling.
(perl-cross-build): New procedure.
---
 guix/build-system/perl.scm | 120 +++++++++++++++++++++++++++++++------
 1 file changed, 103 insertions(+), 17 deletions(-)

diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm
index db0a916fb2..3890cd91ea 100644
--- a/guix/build-system/perl.scm
+++ b/guix/build-system/perl.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,13 +30,17 @@ (define-module (guix build-system perl)
   #:use-module (ice-9 match)
   #:export (%perl-build-system-modules
             perl-build
+            perl-cross-build
             perl-build-system))
 
 ;; Commentary:
 ;;
 ;; Standard build procedure for Perl packages using the "makefile
 ;; maker"---i.e., "perl Makefile.PL".  This is implemented as an extension of
-;; `gnu-build-system'.
+;; `gnu-build-system'.  Cross-compilation is supported for some simple Perl
+;; packages, but not for any Perl packages that do things like XS (Perl's FFI),
+;; which makes C-style shared libraries, as it is currently not known how to
+;; tell Perl to properly cross-compile.
 ;;
 ;; Code:
 
@@ -59,24 +64,43 @@ (define* (lower name
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:target #:perl #:inputs #:native-inputs))
+    `(#:perl #: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)
+    (host-inputs `(,@(if source
+                         `(("source" ,source))
+                         '())
+                   ,@inputs
+                   ;; For interpreters in #! (shebang)
+                   ,@(if target
+                         `(("perl" ,perl))
+                         '())
 
-                        ;; Keep the standard inputs of 'gnu-build-system'.
-                        ,@(standard-packages)))
-         (build-inputs `(("perl" ,perl)
-                         ,@native-inputs))
-         (outputs outputs)
-         (build perl-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+                   ;; Keep the standard inputs of 'gnu-build-system'.
+                   ;; TODO: make this unconditional, putting this into 'build-inputs'.
+                   ,@(if target
+                         '()
+                         (standard-packages))))
+    (build-inputs `(("perl" ,perl)
+                    ,@native-inputs
+                    ,@(if target
+                          (standard-cross-packages target 'host)
+                          '())
+                    ,@(if target
+                          (standard-packages)
+                          '())))
+    ;; Keep the standard inputs of 'gnu-build-system'.
+    (target-inputs (if target
+                       (standard-cross-packages target 'target)
+                       '()))
+    (outputs outputs)
+    (build (if target
+               perl-cross-build
+               perl-build))
+    (arguments (strip-keyword-arguments private-keywords arguments))))
 
 (define* (perl-build name inputs
                      #:key source
@@ -127,6 +151,68 @@ (define build
     (gexp->derivation name build
                       #:system system
                       #:target #f
+                      #:graft? #f
+                      #:guile-for-build guile)))
+
+(define* (perl-cross-build name #:key
+                           source
+                           target
+                           build-inputs host-inputs target-inputs
+                           (search-paths '())
+                           (native-search-paths '())
+                           (tests? #f) ; usually not possible when cross-compiling
+                           (parallel-build? #t)
+                           (parallel-tests? #t)
+                           (make-maker? #f)
+                           (make-maker-flags ''())
+                           (module-build-flags ''())
+                           (phases '(@ (guix build perl-build-system)
+                                       %standard-phases))
+                           (outputs '("out"))
+                           (system (%current-system))
+                           (build (nix-system->gnu-triplet system))
+                           (guile #f)
+                           (imported-modules %perl-build-system-modules)
+                           (modules '((guix build perl-build-system)
+                                      (guix build utils))))
+  "Cross-build SOURCE to TARGET using PERL, and with INPUTS.  This assumes that
+SOURCE provides a `Makefile.PL' file as its build system and does not use XS
+or similar."
+  (define inputs
+    #~(append #$(input-tuples->gexp host-inputs)
+              #+(input-tuples->gexp target-inputs)))
+  (define builder
+    (with-imported-modules imported-modules
+      #~(begin
+          (use-modules #$@(sexp->gexp modules))
+          (perl-build #:name #$name
+                      #:source #+source
+                      #:search-paths '#$(sexp->gexp
+                                         (map search-path-specification->sexp
+                                              search-paths))
+                      #:native-search-paths '#$(sexp->gexp
+                                                (map search-path-specification->sexp
+                                                     native-search-paths))
+                      #:make-maker? #$make-maker?
+                      #:make-maker-flags #$make-maker-flags
+                      #:module-build-flags #$(sexp->gexp module-build-flags)
+                      #:phases #$phases
+                      #:build #$build
+                      #:system #$system
+                      #:target #$target
+                      #:test-target "test"
+                      #:tests? #$tests?
+                      #:parallel-build? #$parallel-build?
+                      #:parallel-tests? #$parallel-tests?
+                      #:outputs #$(outputs->gexp outputs)
+                      #:inputs #$inputs
+                      #:native-inputs #+(input-tuples->gexp build-inputs)))))
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system #:graft? #f)))
+    (gexp->derivation name builder
+                      #:system system
+                      #:target target
+                      #:graft? #false
                       #:guile-for-build guile)))
 
 (define perl-build-system

base-commit: d519305d83d08058e4def2c4d72fe62102d9599d
-- 
2.37.0