Subject: [bug#70985] [PATCH 1/4] guix: packages: Add new &package-unsupported-target-error.

From: Christopher Baines <[email-masked]>
Date: Thu, 16 May 2024 16:06:03 +0100

Some packages don't support cross building to specific targets, so add a error
type to signal this.

* guix/packages.scm (&package-unsupported-target-error): New condition type.
[package-unsupported-target-error? package-unsupported-target-error-target):
New procedures.
* guix/ui.scm (call-with-error-handling): Handle this new condition type.

Change-Id: Ib47813399e04b20d616a95f545b6aabe25736e92
---
 guix/packages.scm | 7 +++++++
 guix/ui.scm       | 7 +++++++
 2 files changed, 14 insertions(+)

diff --git a/guix/packages.scm b/guix/packages.scm
index abe89cdb07..7fbb8d126b 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -173,6 +173,9 @@ (define-module (guix packages)
             package-error-invalid-input
             &package-cross-build-system-error
             package-cross-build-system-error?
+            &package-unsupported-target-error
+            package-unsupported-target-error?
+            package-unsupported-target-error-target
 
             package->bag
             bag->derivation
@@ -850,6 +853,10 @@ (define-condition-type &package-cyclic-dependency-error &package-error
 (define-condition-type &package-cross-build-system-error &package-error
   package-cross-build-system-error?)
 
+(define-condition-type &package-unsupported-target-error &package-error
+  package-unsupported-target-error?
+  (target package-unsupported-target-error-target))
+
 (define* (package-full-name package #:optional (delimiter "@"))
   "Return the full name of PACKAGE--i.e., `NAME@VERSION'.  By specifying
 DELIMITER (a string), you can customize what will appear between the name and
diff --git a/guix/ui.scm b/guix/ui.scm
index d82fa533cc..0bb1b3b3ba 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -756,6 +756,13 @@ (define (call-with-error-handling thunk)
                        (location->string loc)
                        (package-full-name package)
                        (build-system-name system))))
+             ((package-unsupported-target-error? c)
+              (let* ((package (package-error-package c))
+                     (loc     (package-location package)))
+                (leave (G_ "~a: ~a: does not support target `~a'~%")
+                       (location->string loc)
+                       (package-full-name package)
+                       (package-unsupported-target-error-target c))))
              ((gexp-input-error? c)
               (let ((input (gexp-error-invalid-input c)))
                 (leave (G_ "~s: invalid G-expression input~%")

base-commit: 5a624adfd7b14c3717237d137bd0766c77f0f570
-- 
2.41.0