tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

system: Improve 'read-boot-parameters' incompatibility diagnostic.

Browse Source 
Previously, when reading an incompatible "parameters" file, 'guix
system' would print a warning and then crash with a wrong-type-arg
backtrace because code expects 'read-boot-parameters' to always return a
<boot-parameters> record.

* gnu/system.scm (read-boot-parameters): Upon incompatibility, raise an
error instead of returning #f.  Also raise a '&fix-hint' condition.
* tests/boot-parameters.scm ("read, construction, mandatory fields"):
Define 'test-read-boot-parameters' as a macro; expect
'formatted-message?' exceptions rather than #f returns.
This commit is contained in:
Ludovic Courtès
2022-03-16 15:03:01 +01:00
parent 5d4af22ef2
commit 47960b5526
2 changed files with 29 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
gnu/system.scm
View File

@@ -354,7 +354,7 @@ file system labels."
(define (read-boot-parameters port)
"Read boot parameters from PORT and return the corresponding
<boot-parameters> object or #f if the format is unrecognized."
<boot-parameters> object. Raise an error if the format is unrecognized."
(define device-sexp->device
(match-lambda
(('uuid (? symbol? type) (? bytevector? bv))
@@ -481,9 +481,20 @@ file system labels."
(_ ;the old format
"/")))))
(x ;unsupported format
(warning (G_ "unrecognized boot parameters at '~a'~%")
(port-filename port))
#f)))
(raise
(make-compound-condition
(formatted-message
(G_ "unrecognized boot parameters at '~a'~%")
(port-filename port))
(condition
(&fix-hint (hint (format #f (G_ "This probably means that this version
of Guix is older than the one that created @file{~a}. To address this, you
need to update Guix:
@example
guix pull
@end example")
(port-filename port))))))))))
(define (read-boot-parameters-file system)
"Read boot parameters from SYSTEM's (system or generation) \"parameters\"

21
tests/boot-parameters.scm
View File

@@ -28,9 +28,11 @@
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((guix diagnostics) #:select (formatted-message?))
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix tests)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors))
@@ -151,13 +153,18 @@
;; XXX: <warning: unrecognized boot parameters at '#f'>
(test-assert "read, construction, mandatory fields"
(not (or (test-read-boot-parameters #:version #false)
(test-read-boot-parameters #:version 'false)
(test-read-boot-parameters #:version -1)
(test-read-boot-parameters #:version "0")
(test-read-boot-parameters #:root-device #false)
(test-read-boot-parameters #:kernel #false)
(test-read-boot-parameters #:label #false))))
(let-syntax ((test-read-boot-parameters
(syntax-rules ()
((_ args ...)
(guard (c ((formatted-message? c) #f))
(test-read-boot-parameters args ...))))))
(not (or (test-read-boot-parameters #:version #false)
(test-read-boot-parameters #:version 'false)
(test-read-boot-parameters #:version -1)
(test-read-boot-parameters #:version "0")
(test-read-boot-parameters #:root-device #false)
(test-read-boot-parameters #:kernel #false)
(test-read-boot-parameters #:label #false)))))
(test-assert "read, construction, optional fields"
(and (test-read-boot-parameters #:bootloader-name #false)