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:
Ludovic Courtès 2015-07-16 09:49:36 +02:00
parent 68e88a09b4
commit 1cab9e810e
2 changed files with 14 additions and 2 deletions

View File

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

View File

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