diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-07-16 09:49:36 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-07-16 09:49:36 +0200 |
| commit | 1cab9e810ef7843afdbd101ad967f835cfb64999 (patch) | |
| tree | a72b0bf84ca491834a94b92ad3ce93cd9b9de879 | |
| parent | 68e88a09b46cc2b4affebbd258decbcd4024f0db (diff) | |
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.
| -rw-r--r-- | gnu/system/file-systems.scm | 6 | ||||
| -rw-r--r-- | tests/file-systems.scm | 10 |
2 files changed, 14 insertions, 2 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index ece8fb41e6..0f3e6fbcaa 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -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))))) diff --git a/tests/file-systems.scm b/tests/file-systems.scm index d445b4971f..c36509b2b0 100644 --- a/tests/file-systems.scm +++ b/tests/file-systems.scm @@ -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) |