From 10e51d6dde2293ed5f5bf95d505c0b89c5db8f89 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 13 Jan 2023 17:27:38 -0500 Subject: 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 --- 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 @@ -70,6 +76,20 @@ (default #false)) (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 -- cgit v1.2.3