TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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:
Maxim Cournoyer 2023-01-13 17:27:38 -05:00
parent 0d200206ca
commit 10e51d6dde
No known key found for this signature in database
GPG Key ID: 1260E46482E63562
2 changed files with 44 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
gnu/packages/bootstrap.scm
View File

@ -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))

55
guix/platform.scm
View File

@ -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