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)
|
((_ str)
|
||||||
(string? (syntax->datum #'str))
|
(string? (syntax->datum #'str))
|
||||||
;; A literal string: do the conversion at expansion time.
|
;; A literal string: do the conversion at expansion time.
|
||||||
(with-syntax ((bv (string->uuid (syntax->datum #'str))))
|
(let ((bv (string->uuid (syntax->datum #'str))))
|
||||||
#''bv))
|
(unless bv
|
||||||
|
(syntax-violation 'uuid "invalid UUID" s))
|
||||||
|
(datum->syntax #'str bv)))
|
||||||
((_ str)
|
((_ str)
|
||||||
#'(string->uuid str)))))
|
#'(string->uuid str)))))
|
||||||
|
|
||||||
|
|
|
@ -40,6 +40,16 @@
|
||||||
(bytevector=? (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
|
(bytevector=? (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
|
||||||
(string->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)
|
(test-end)
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue