@@ -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
@@ -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)
@@ -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.