file-systems: 'uuid' raises a syntax error for invalid UUIDs.
* gnu/system/file-systems.scm (uuid): Call 'syntax-violation' when 'string->uuid' returns #f. * tests/file-systems.scm ("uuid, syntax error"): New test.
This commit is contained in:
parent
68e88a09b4
commit
1cab9e810e
@ -153,8 +153,10 @@ UUID representation."
|
||||
((_ str)
|
||||
(string? (syntax->datum #'str))
|
||||
;; A literal string: do the conversion at expansion time.
|
||||
(with-syntax ((bv (string->uuid (syntax->datum #'str))))
|
||||
#''bv))
|
||||
(let ((bv (string->uuid (syntax->datum #'str))))
|
||||
(unless bv
|
||||
(syntax-violation 'uuid "invalid UUID" s))
|
||||
(datum->syntax #'str bv)))
|
||||
((_ str)
|
||||
#'(string->uuid str)))))
|
||||
|
||||
|
@ -40,6 +40,16 @@
|
||||
(bytevector=? (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
|
||||
(string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))))
|
||||
|
||||
(test-assert "uuid, syntax error"
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(eval '(uuid "foobar") (current-module))
|
||||
#f)
|
||||
(lambda (key proc message location form . args)
|
||||
(and (eq? proc 'uuid)
|
||||
(string-contains message "invalid UUID")
|
||||
(equal? form '(uuid "foobar"))))))
|
||||
|
||||
(test-end)
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user