01/02: platforms: Raise an exception when no suitable platform is found.

[guix-commits]

apteryx pushed a commit to branch master
in repository guix.

commit 10e51d6dde2293ed5f5bf95d505c0b89c5db8f89
Author: Maxim Cournoyer <maxim.cournoyer@gmail.com>
AuthorDate: Fri Jan 13 17:27:38 2023 -0500

    platforms: Raise an exception when no suitable platform is found.
    
    This was motivated by #60786, which produced a cryptic, hard to understand
    backtrace.
    
    Given the following reproducer:
        (use-modules (guix packages)
                     (gnu packages cross-base))
    
        (define linux-libre-headers-cross-mips64el-linux-gnuabi64
          (cross-kernel-headers "mips64el-linux-gnuabi64"))
    
        (package-arguments linux-libre-headers-cross-mips64el-linux-gnuabi64)
    
    Before this change:
        ice-9/boot-9.scm:1685:16: In procedure raise-exception:
        In procedure struct-vtable: Wrong type argument in position 1 
(expecting struct): #f
    
    After this change:
        ice-9/boot-9.scm:1685:16: In procedure raise-exception:
        ERROR:
          1. &platform-not-found-error: "mips64el-linux-gnuabi64"
    
    * guix/platform.scm (&platform-not-found-error): New condition.
    (platform-not-found-error?): New predicate.
    (false-if-platform-not-found): New syntax.
    (lookup-platform-by-system): Raise an exception when no platform is found.
    Update documentation.
    (lookup-platform-by-target): Likewise.
    (lookup-platform-by-target-or-system): Likewise, and guard lookup calls with
    false-if-platform-not-found.
    * gnu/packages/bootstrap.scm (glibc-dynamic-linker): Handle
    lookup-platform-by-system call to preserve existing behavior.
    
    Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
---
 gnu/packages/bootstrap.scm |  3 ++-
 guix/platform.scm          | 55 +++++++++++++++++++++++++++++++++++-----------
 2 files changed, 44 insertions(+), 14 deletions(-)

diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index d2914fb5a7..9ea1a3e4d1 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -315,7 +315,8 @@ or false to signal an error."
                                  (%current-system))))
   "Return the name of Glibc's dynamic linker for SYSTEM."
   ;; See the 'SYSDEP_KNOWN_INTERPRETER_NAMES' cpp macro in libc.
-  (let ((platform (lookup-platform-by-system system)))
+  (let ((platform (false-if-platform-not-found
+                   (lookup-platform-by-system system))))
     (cond
      ((platform? platform)
       (platform-glibc-dynamic-linker platform))
diff --git a/guix/platform.scm b/guix/platform.scm
index f873913fe0..a2d95ab507 100644
--- a/guix/platform.scm
+++ b/guix/platform.scm
@@ -22,6 +22,8 @@
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:export (platform
             platform?
             platform-target
@@ -29,6 +31,10 @@
             platform-linux-architecture
             platform-glibc-dynamic-linker
 
+            &platform-not-found-error
+            platform-not-found-error?
+            false-if-platform-not-found
+
             platform-modules
             platforms
             lookup-platform-by-system
@@ -71,6 +77,20 @@
   (glibc-dynamic-linker platform-glibc-dynamic-linker))
 
 
+;;;
+;;; Exceptions.
+;;;
+(define-condition-type &platform-not-found-error &error
+  platform-not-found-error?
+  (target-or-system platform-not-found-error-target-or-system))
+
+(define-syntax-rule (false-if-platform-not-found exp)
+  "Evaluate EXP but return #f if it raises a platform-not-found-error?
+exception."
+  (guard (ex ((platform-not-found-error? ex) #f))
+    exp))
+
+
 ;;;
 ;;; Platforms.
 ;;;
@@ -94,23 +114,32 @@
                                    (platform-modules)))))
 
 (define (lookup-platform-by-system system)
-  "Return the platform corresponding to the given SYSTEM."
-  (find (lambda (platform)
-          (let ((s (platform-system platform)))
-            (and (string? s) (string=? s system))))
-        (platforms)))
+  "Return the platform corresponding to the given SYSTEM.  Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+  (or (find (lambda (platform)
+              (let ((s (platform-system platform)))
+                (and (string? s) (string=? s system))))
+            (platforms))
+      (raise-exception (condition (&platform-not-found-error
+                                   (target-or-system system))))))
 
 (define (lookup-platform-by-target target)
-  "Return the platform corresponding to the given TARGET."
-  (find (lambda (platform)
-          (let ((t (platform-target platform)))
-            (and (string? t) (string=? t target))))
-        (platforms)))
+  "Return the platform corresponding to the given TARGET.  Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+  (or (find (lambda (platform)
+              (let ((t (platform-target platform)))
+                (and (string? t) (string=? t target))))
+            (platforms))
+      (raise-exception (condition (&platform-not-found-error
+                                   (target-or-system target))))))
 
 (define (lookup-platform-by-target-or-system target-or-system)
-  "Return the platform corresponding to the given TARGET or SYSTEM."
-  (or (lookup-platform-by-target target-or-system)
-      (lookup-platform-by-system target-or-system)))
+  "Return the platform corresponding to the given TARGET or SYSTEM.  Raise
+&PLATFORM-NOT-FOUND-ERROR when no platform could be found."
+  (or (false-if-platform-not-found (lookup-platform-by-target 
target-or-system))
+      (false-if-platform-not-found (lookup-platform-by-system 
target-or-system))
+      (raise-exception (condition (&platform-not-found-error
+                                   (target-or-system target-or-system))))))
 
 (define (platform-system->target system)
   "Return the target matching the given SYSTEM if it exists or false