01/02: file-systems: 'uuid' raises a syntax error for invalid UUIDs.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 1cab9e810ef7843afdbd101ad967f835cfb64999
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jul 16 09:49:36 2015 +0200

    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.
---
 gnu/system/file-systems.scm |    6 ++++--
 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 ece8fb4..0f3e6fb 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 d445b49..c36509b 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)