packages: Raise an error condition a cross builder is needed but unavailable.
* guix/packages.scm (&package-cross-build-system-error): New condition type. (package-cross-derivation): Raise &package-cross-build-system-error when the build system doesn't support cross builds. * guix/ui.scm (call-with-error-handling): Add package-cross-build-system-error? case. * tests/packages.scm ("package-cross-derivation, no cross builder"): New test.
This commit is contained in:
parent
ea84ec7711
commit
9b222abe03
|
@ -83,7 +83,9 @@
|
||||||
package-error-package
|
package-error-package
|
||||||
&package-input-error
|
&package-input-error
|
||||||
package-input-error?
|
package-input-error?
|
||||||
package-error-invalid-input))
|
package-error-invalid-input
|
||||||
|
&package-cross-build-system-error
|
||||||
|
package-cross-build-system-error?))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -234,6 +236,9 @@ corresponds to the arguments expected by `set-path-environment-variable'."
|
||||||
package-input-error?
|
package-input-error?
|
||||||
(input package-error-invalid-input))
|
(input package-error-invalid-input))
|
||||||
|
|
||||||
|
(define-condition-type &package-cross-build-system-error &package-error
|
||||||
|
package-cross-build-system-error?)
|
||||||
|
|
||||||
|
|
||||||
(define (package-full-name package)
|
(define (package-full-name package)
|
||||||
"Return the full name of PACKAGE--i.e., `NAME-VERSION'."
|
"Return the full name of PACKAGE--i.e., `NAME-VERSION'."
|
||||||
|
@ -412,6 +417,11 @@ system identifying string)."
|
||||||
(= build-system-cross-builder builder)
|
(= build-system-cross-builder builder)
|
||||||
args inputs propagated-inputs native-inputs self-native-input?
|
args inputs propagated-inputs native-inputs self-native-input?
|
||||||
outputs)
|
outputs)
|
||||||
|
(unless builder
|
||||||
|
(raise (condition
|
||||||
|
(&package-cross-build-system-error
|
||||||
|
(package package)))))
|
||||||
|
|
||||||
(let* ((inputs (package-transitive-target-inputs package))
|
(let* ((inputs (package-transitive-target-inputs package))
|
||||||
(input-drvs (map (cut expand-input
|
(input-drvs (map (cut expand-input
|
||||||
store package <>
|
store package <>
|
||||||
|
|
|
@ -23,6 +23,7 @@
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix config)
|
#:use-module (guix config)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
|
#:use-module (guix build-system)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module ((guix licenses) #:select (license? license-name))
|
#:use-module ((guix licenses) #:select (license? license-name))
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -152,6 +153,14 @@ General help using GNU software: <http://www.gnu.org/gethelp/>"))
|
||||||
(leave (_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
|
(leave (_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
|
||||||
file line column
|
file line column
|
||||||
(package-full-name package) input)))
|
(package-full-name package) input)))
|
||||||
|
((package-cross-build-system-error? c)
|
||||||
|
(let* ((package (package-error-package c))
|
||||||
|
(loc (package-location package))
|
||||||
|
(system (package-build-system package)))
|
||||||
|
(leave (_ "~a: ~a: build system `~a' does not support cross builds~%")
|
||||||
|
(location->string loc)
|
||||||
|
(package-full-name package)
|
||||||
|
(build-system-name system))))
|
||||||
((nix-connection-error? c)
|
((nix-connection-error? c)
|
||||||
(leave (_ "failed to connect to `~a': ~a~%")
|
(leave (_ "failed to connect to `~a': ~a~%")
|
||||||
(nix-connection-error-file c)
|
(nix-connection-error-file c)
|
||||||
|
|
|
@ -30,6 +30,7 @@
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (ice-9 match))
|
#:use-module (ice-9 match))
|
||||||
|
@ -212,6 +213,16 @@
|
||||||
(and (derivation-path? drv-path)
|
(and (derivation-path? drv-path)
|
||||||
(derivation? drv)))))
|
(derivation? drv)))))
|
||||||
|
|
||||||
|
(test-assert "package-cross-derivation, no cross builder"
|
||||||
|
(let* ((b (build-system (inherit trivial-build-system)
|
||||||
|
(cross-build #f)))
|
||||||
|
(p (package (inherit (dummy-package "p"))
|
||||||
|
(build-system b))))
|
||||||
|
(guard (c ((package-cross-build-system-error? c)
|
||||||
|
(eq? (package-error-package c) p)))
|
||||||
|
(package-cross-derivation %store p "mips64el-linux-gnu")
|
||||||
|
#f)))
|
||||||
|
|
||||||
(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))
|
(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))
|
||||||
(test-skip 1))
|
(test-skip 1))
|
||||||
(test-assert "GNU Make, bootstrap"
|
(test-assert "GNU Make, bootstrap"
|
||||||
|
|
Loading…
Reference in New Issue