diff mbox series

[bug#60847,v2,1/1] build: Enable cross-compilation for pyproject-build-system.

Message ID 20230123133217.318-2-maxim.cournoyer@gmail.com
State New
Headers show
Series Enable cross-compilation for the pyproject-build-system | expand

Commit Message

Maxim Cournoyer Jan. 23, 2023, 1:32 p.m. UTC
* guix/build-system/pyproject.scm (lower): Do not return #f when TARGET is
set.  Add the target field.  Separate build-inputs from target-inputs, and
extend these with the standard-packages or standard-cross-packages procedures.
(pyproject-build): Add the target, build-inputs, target-inputs, host-inputs
and native-search-paths arguments.  Remove the inputs argument.  Adjust doc.
Adjust the call to the build-side pyproject-build procedure.  Always pass the
target to the gexp->derivation call.
* guix/packages.scm (bag->derivation): Special case the pyproject-build
builder to always use cross-derivation bags
* guix/build/pyproject-build-system.scm (set-paths): New procedure, overriding
that provided by gnu-build-system.
(check) [TARGET]: New argument.  Disable the phase when it is set.
(install): Adjust to look for Python in the native-inputs instead of inputs.
(compile-bytecode): Likewise.
(create-entrypoints): Likewise.
(set-setuptools-env): New procedure.
(sanity-check): Adjust to look for Python in the native-inputs instead of
inputs.
(add-install-to-pythonpath, wrap, rename-pth-file): Likewise.
(%standard-phases): Override set-paths, add-install-to-pythonpath, wrap,
sanity-check and rename-pth-file.  Register set-setuptools-env.

---

Changes in v2:
- Rebase

 guix/build-system/pyproject.scm       | 115 ++++++++++++++---------
 guix/build/pyproject-build-system.scm | 126 +++++++++++++++++++++++---
 guix/packages.scm                     |  46 +++++-----
 3 files changed, 210 insertions(+), 77 deletions(-)

Comments

jgart Jan. 24, 2023, 2:05 a.m. UTC | #1
Hi Maxim,

Sorry, This week is still too busy for me with work to review this. Looking forward to reviewing future patches or these if still needed.

all best,

jgart
diff mbox series

Patch

diff --git a/guix/build-system/pyproject.scm b/guix/build-system/pyproject.scm
index 8f3b562ca3..74d739023f 100644
--- a/guix/build-system/pyproject.scm
+++ b/guix/build-system/pyproject.scm
@@ -1,6 +1,7 @@ 
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
 ;;; Copyright © 2022 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -69,28 +70,37 @@  (define* (lower name
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:target #:python #: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 `(("python" ,python)
-                         ("sanity-check.py" ,(local-file sanity-check.py))
-                         ,@native-inputs))
-         (outputs (append outputs '(wheel)))
-         (build pyproject-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
-
-(define* (pyproject-build name inputs
-                          #:key source
+    `(#:python #:inputs #:native-inputs
+      ,@(if target '() '(#:target))))
+
+  (bag
+    (name name)
+    (system system)
+    (target target)
+    (build-inputs `(,@(if source
+                          `(("source" ,source))
+                          '())
+                    ("python" ,python)
+                    ("sanity-check.py" ,(local-file sanity-check.py))
+                    ,@native-inputs
+                    ,@(if target
+                          (standard-cross-packages target 'host)
+                          '())
+                    ;; Keep the standard inputs of 'gnu-build-system'.
+                    ,@(standard-packages)))
+    (host-inputs inputs)
+    (target-inputs (if target
+                       (standard-cross-packages target 'target)
+                       '()))
+    (outputs (append outputs '(wheel)))
+    (build pyproject-build)
+    (arguments (strip-keyword-arguments private-keywords arguments))))
+
+(define* (pyproject-build name
+                          #:key
+                          target
+                          build-inputs target-inputs host-inputs
+                          source
                           (tests? #t)
                           (configure-flags ''())
                           (build-backend #f)
@@ -98,44 +108,63 @@  (define* (pyproject-build name inputs
                           (test-flags ''())
                           (phases '%standard-phases)
                           (outputs '("out" "wheel"))
+                          (native-search-paths '())
                           (search-paths '())
                           (system (%current-system))
                           (guile #f)
                           (imported-modules %pyproject-build-system-modules)
                           (modules '((guix build pyproject-build-system)
                                      (guix build utils))))
-  "Build SOURCE using PYTHON, and with INPUTS."
+  "Build SOURCE using PYTHON, and with BUILD-INPUTS, HOST-INPUTS and
+TARGET-INPUTS (if available)."
   (define build
     (with-imported-modules imported-modules
       #~(begin
           (use-modules #$@(sexp->gexp modules))
 
-          #$(with-build-variables inputs outputs
-              #~(pyproject-build
-                 #:name #$name
-                 #:source #+source
-                 #:configure-flags #$configure-flags
-                 #:system #$system
-                 #:build-backend #$build-backend
-                 #:test-backend #$test-backend
-                 #:test-flags #$test-flags
-                 #:tests? #$tests?
-                 #:phases #$(if (pair? phases)
-                                (sexp->gexp phases)
-                                phases)
-                 #:outputs %outputs
-                 #:search-paths '#$(sexp->gexp
-                                    (map search-path-specification->sexp
-                                         search-paths))
-                 #:inputs %build-inputs)))))
+          (define %build-host-inputs
+            #+(input-tuples->gexp build-inputs))
+
+          (define %build-target-inputs
+            (append #$(input-tuples->gexp host-inputs)
+                    #+(input-tuples->gexp target-inputs)))
+
+          (define %build-inputs
+            (append %build-host-inputs %build-target-inputs))
+
+          (define %outputs
+            #$(outputs->gexp outputs))
 
+          (pyproject-build #:name #$name
+                           #:source #+source
+                           #:configure-flags #$configure-flags
+                           #:system #$system
+                           #:target #$target
+                           #:build-backend #$build-backend
+                           #:test-backend #$test-backend
+                           #:test-flags #$test-flags
+                           #:tests? #$tests?
+                           #:phases #$(if (pair? phases)
+                                          (sexp->gexp phases)
+                                          phases)
+                           #:outputs %outputs
+                           #:search-paths
+                           '#$(sexp->gexp
+                               (map search-path-specification->sexp
+                                    search-paths))
+                           #:native-search-paths
+                           '#$(sexp->gexp
+                               (map search-path-specification->sexp
+                                    native-search-paths))
+                           #:native-inputs %build-host-inputs
+                           #:inputs %build-target-inputs))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))
     (gexp->derivation name build
                       #:system system
-                      #:graft? #f                 ;consistent with 'gnu-build'
-                      #:target #f
+                      #:target target
+                      #:graft? #f       ;consistent with 'gnu-build'
                       #:guile-for-build guile)))
 
 (define pyproject-build-system
diff --git a/guix/build/pyproject-build-system.scm b/guix/build/pyproject-build-system.scm
index c69ccc9d64..e51b5cfc43 100644
--- a/guix/build/pyproject-build-system.scm
+++ b/guix/build/pyproject-build-system.scm
@@ -86,6 +86,58 @@  (define-condition-type &cannot-extract-multiple-wheels &python-build-error
 ;; Raised, when no wheel has been built by the build system.
 (define-condition-type &no-wheels-built &python-build-error no-wheels-built?)
 
+;;; XXX: This is the same as in (guix build gnu-build-system), except adjusted
+;;; for the fact that native-inputs always exist now, whether cross-compiling
+;;; or not.  When not cross-compiling, input-directories are appended to
+;;; native-input-directories to so that native-search-paths are computed for
+;;; all inputs.
+(define* (set-paths #:key target inputs native-inputs
+                    search-paths native-search-paths
+                    #:allow-other-keys)
+  (define input-directories
+    ;; The "source" input can be a directory, but we don't want it for search
+    ;; paths.  See <https://issues.guix.gnu.org/44924>.
+    (match (alist-delete "source" inputs)
+      (((_ . dir) ...)
+       dir)))
+
+  (define native-input-directories
+    (match (alist-delete "source" native-inputs)
+      (((_ . dir) ...)
+       dir)))
+
+  ;; Tell 'ld-wrapper' to disallow non-store libraries.
+  (setenv "GUIX_LD_WRAPPER_ALLOW_IMPURITIES" "no")
+
+  ;; When cross building, $PATH must refer only to native (host) inputs since
+  ;; target inputs are not executable.
+  (set-path-environment-variable "PATH" '("bin" "sbin")
+                                 (append native-input-directories
+                                         (if target
+                                             '()
+                                             input-directories)))
+
+  (for-each (match-lambda
+              ((env-var (files ...) separator type pattern)
+               (set-path-environment-variable env-var files
+                                              input-directories
+                                              #:separator separator
+                                              #:type type
+                                              #:pattern pattern)))
+            search-paths)
+
+  (for-each (match-lambda
+              ((env-var (files ...) separator type pattern)
+               (set-path-environment-variable env-var files
+                                              (append native-input-directories
+                                                      (if target
+                                                          '()
+                                                          input-directories))
+                                              #:separator separator
+                                              #:type type
+                                              #:pattern pattern)))
+            native-search-paths))
+
 (define* (build #:key outputs build-backend configure-flags #:allow-other-keys)
   "Build a given Python package."
 
@@ -135,9 +187,9 @@  (define (pyproject.toml->build-backend file)
      wheel-dir
      config-settings)))
 
-(define* (check #:key tests? test-backend test-flags #:allow-other-keys)
+(define* (check #:key target tests? test-backend test-flags #:allow-other-keys)
   "Run the test suite of a given Python package."
-  (if tests?
+  (if (and tests? (not target))
       ;; Unfortunately with PEP 517 there is no common method to specify test
       ;; systems.  Guess test system based on inputs instead.
       (let* ((pytest (which "pytest"))
@@ -172,11 +224,11 @@  (define* (check #:key tests? test-backend test-flags #:allow-other-keys)
           (else (raise (condition (&test-system-not-found))))))
       (format #t "test suite not run~%")))
 
-(define* (install #:key inputs outputs #:allow-other-keys)
+(define* (install #:key native-inputs outputs #:allow-other-keys)
   "Install a wheel file according to PEP 427"
   ;; See https://www.python.org/dev/peps/pep-0427/#installing-a-wheel-distribution-1-0-py32-none-any-whl
-  (let ((site-dir (site-packages inputs outputs))
-        (python (assoc-ref inputs "python"))
+  (let ((site-dir (site-packages native-inputs outputs))
+        (python (assoc-ref native-inputs "python"))
         (out (assoc-ref outputs "out")))
     (define (extract file)
       "Extract wheel (ZIP file) into site-packages directory"
@@ -262,10 +314,10 @@  (define (list-directories base predicate)
                   (expand-data-directory directory)
                   (rmdir directory)) datadirs))))
 
-(define* (compile-bytecode #:key inputs outputs #:allow-other-keys)
+(define* (compile-bytecode #:key native-inputs outputs #:allow-other-keys)
   "Compile installed byte-code in site-packages."
-  (let* ((site-dir (site-packages inputs outputs))
-         (python (assoc-ref inputs "python"))
+  (let* ((site-dir (site-packages native-inputs outputs))
+         (python (assoc-ref native-inputs "python"))
          (major-minor (map string->number
                            (take (string-split (python-version python) #\.) 2)))
          (<3.7? (match major-minor
@@ -281,7 +333,7 @@  (define* (compile-bytecode #:key inputs outputs #:allow-other-keys)
         (invoke "python" "-m" "compileall"
                 "--invalidation-mode=unchecked-hash" site-dir))))
 
-(define* (create-entrypoints #:key inputs outputs #:allow-other-keys)
+(define* (create-entrypoints #:key native-inputs outputs #:allow-other-keys)
   "Implement Entry Points Specification
 (https://packaging.python.org/specifications/entry-points/) by PyPa,
 which creates runnable scripts in bin/ from entry point specification
@@ -337,8 +389,7 @@  (define (create-script path name module function)
 import ~a as mod
 sys.exit (mod.~a ())~%" interpreter module function)))
         (chmod file-path #o755)))
-
-  (let* ((site-dir (site-packages inputs outputs))
+  (let* ((site-dir (site-packages native-inputs outputs))
          (out (assoc-ref outputs "out"))
          (bin-dir (string-append out "/bin"))
          (entry-point-files (find-files site-dir "^entry_points.txt$")))
@@ -358,6 +409,51 @@  (define* (set-SOURCE-DATE-EPOCH* #:rest _)
   ;; not support timestamps before 1980.
   (setenv "SOURCE_DATE_EPOCH" "315619200"))
 
+(define* (set-setuptools-env #:key target #:allow-other-keys)
+  "Set environment variables such as LDSHARED, LDXXSHARED, etc. used by
+setuptools when building native extensions.  This is particularly useful for
+cross-compilation."
+  (define cc-for-target (if target
+                            (string-append target "-gcc")
+                            "gcc"))
+  (define cxx-for-target (if target
+                             (string-append target "-g++")
+                             "g++"))
+  ;; The variables defined here are taken from CPython's configure.ac file.
+  ;; The explanations are those of the Poky (from Yocto) project.
+  (setenv "CC" cc-for-target)
+  (setenv "CXX" cxx-for-target)
+  ;; LDSHARED is the ld *command* used to create shared library.
+  (setenv "LDSHARED" (string-append cc-for-target " -shared"))
+  ;; LDXXSHARED is the ld *command* used to create shared library of C++
+  ;; objects.
+  (setenv "LDCXXSHARED" (string-append cxx-for-target " -shared"))
+  ;; CCSHARED are the C *flags* used to create objects to go into a shared
+  ;; library (module).
+  (setenv "CCSHARED" "-fPIC")
+  ;; LINKFORSHARED are the flags passed to the $(CC) command that links the
+  ;; python executable.
+  (setenv "LINKFORSHARED" "-Xlinker -export-dynamic"))
+
+(define* (sanity-check #:key tests? native-inputs outputs #:allow-other-keys
+                       #:rest args)
+  (apply (assoc-ref python:%standard-phases 'sanity-check)
+         (append args (list #:inputs native-inputs))))
+
+(define* (add-install-to-pythonpath #:key native-inputs outputs
+                                    #:allow-other-keys)
+  "A phase that just wraps the 'add-installed-pythonpath' procedure."
+  (add-installed-pythonpath native-inputs outputs))
+
+(define* (wrap #:key native-inputs outputs #:allow-other-keys #:rest args)
+  (apply (assoc-ref python:%standard-phases 'wrap)
+         (append args (list #:inputs native-inputs))))
+
+(define* (rename-pth-file #:key name native-inputs outputs #:allow-other-keys
+                          #:rest args)
+  (apply (assoc-ref python:%standard-phases 'rename-pth-file)
+         (append args (list #:inputs native-inputs))))
+
 (define %standard-phases
   ;; The build phase only builds C extensions and copies the Python sources,
   ;; while the install phase copies then byte-compiles the sources to the
@@ -365,13 +461,19 @@  (define %standard-phases
   ;; to ease testing the built package.
   (modify-phases python:%standard-phases
     (replace 'set-SOURCE-DATE-EPOCH set-SOURCE-DATE-EPOCH*)
+    (replace 'set-paths set-paths)
+    (add-after 'set-paths 'set-setuptools-env set-setuptools-env)
     (replace 'build build)
     (replace 'install install)
+    (replace 'add-install-to-pythonpath add-install-to-pythonpath)
+    (replace 'wrap wrap)
     (delete 'check)
     ;; Must be before tests, so they can use installed packages’ entry points.
     (add-before 'wrap 'create-entrypoints create-entrypoints)
     (add-after 'wrap 'check check)
-    (add-before 'check 'compile-bytecode compile-bytecode)))
+    (add-before 'check 'compile-bytecode compile-bytecode)
+    (replace 'sanity-check sanity-check)
+    (replace 'rename-pth-file rename-pth-file)))
 
 (define* (pyproject-build #:key inputs (phases %standard-phases)
                           #:allow-other-keys #:rest args)
diff --git a/guix/packages.scm b/guix/packages.scm
index 041a872f9d..6d7df17fc3 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1864,28 +1864,30 @@  (define* (bag->derivation bag #:optional context)
   "Return the derivation to build BAG for SYSTEM.  Optionally, CONTEXT can be
 a package object describing the context in which the call occurs, for improved
 error reporting."
-  (if (bag-target bag)
-      (bag->cross-derivation bag)
-      (mlet* %store-monad ((system ->  (bag-system bag))
-                           (inputs ->  (bag-transitive-inputs bag))
-                           (input-drvs (mapm %store-monad
-                                             (cut expand-input context <> system)
-                                             inputs))
-                           (paths ->   (delete-duplicates
-                                        (append-map (match-lambda
-                                                      ((_ (? package? p) _ ...)
-                                                       (package-native-search-paths
-                                                        p))
-                                                      (_ '()))
-                                                    inputs))))
-        ;; It's possible that INPUTS contains packages that are not 'eq?' but
-        ;; that lead to the same derivation.  Delete those duplicates to avoid
-        ;; issues down the road, such as duplicate entries in '%build-inputs'.
-        (apply (bag-build bag) (bag-name bag)
-               (delete-duplicates input-drvs input=?)
-               #:search-paths paths
-               #:outputs (bag-outputs bag) #:system system
-               (bag-arguments bag)))))
+  (let ((builder-name (procedure-name (bag-build bag))))
+    (if (or (bag-target bag)
+            (eq? 'pyproject-build builder-name))
+        (bag->cross-derivation bag)
+        (mlet* %store-monad ((system ->  (bag-system bag))
+                             (inputs ->  (bag-transitive-inputs bag))
+                             (input-drvs (mapm %store-monad
+                                               (cut expand-input context <> system)
+                                               inputs))
+                             (paths ->   (delete-duplicates
+                                          (append-map (match-lambda
+                                                        ((_ (? package? p) _ ...)
+                                                         (package-native-search-paths
+                                                          p))
+                                                        (_ '()))
+                                                      inputs))))
+          ;; It's possible that INPUTS contains packages that are not 'eq?' but
+          ;; that lead to the same derivation.  Delete those duplicates to avoid
+          ;; issues down the road, such as duplicate entries in '%build-inputs'.
+          (apply (bag-build bag) (bag-name bag)
+                 (delete-duplicates input-drvs input=?)
+                 #:search-paths paths
+                 #:outputs (bag-outputs bag) #:system system
+                 (bag-arguments bag))))))
 
 (define* (bag->cross-derivation bag #:optional context)
   "Return the derivation to build BAG, which is actually a cross build.