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>
This commit is contained in:
parent
0d200206ca
commit
10e51d6dde
2 changed files with 44 additions and 14 deletions
|
@ -315,7 +315,8 @@ (define* (glibc-dynamic-linker
|
|||
(%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))
|
||||
|
|
|
@ -22,6 +22,8 @@ (define-module (guix platform)
|
|||
#: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 @@ (define-module (guix platform)
|
|||
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 @@ (define-record-type* <platform> platform make-platform
|
|||
(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 @@ (define platforms
|
|||
(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
|
||||
|
|
Loading…
Reference in a new issue