uuid: 'uuid' returns #f when 'string->uuid' returns #f.

* gnu/system/uuid.scm (uuid): When STR is not a literal, return #f when
'string->uuid' returns #f.
* tests/uuid.scm ("uuid, dynamic value"): New test.

diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index 73695dd..f13960c 100644 (file)
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -251,7 +251,8 @@ corresponding bytevector; otherwise return #f."
 
 (define-syntax uuid
   (lambda (s)
-    "Return the UUID object corresponding to the given UUID representation."
+    "Return the UUID object corresponding to the given UUID representation or
+#f if the string could not be parsed."
     (syntax-case s (quote)
       ((_ str (quote type))
        (and (string? (syntax->datum #'str))
@@ -266,9 +267,11 @@ corresponding bytevector; otherwise return #f."
        (string? (syntax->datum #'str))
        #'(uuid str 'dce))
       ((_ str)
-       #'(make-uuid 'dce (string->uuid str 'dce)))
+       #'(let ((bv (string->uuid str 'dce)))
+           (and bv (make-uuid 'dce bv))))
       ((_ str type)
-       #'(make-uuid type (string->uuid str type))))))
+       #'(let ((bv (string->uuid str type)))
+           (and bv (make-uuid type bv)))))))
 
 (define uuid->string
   ;; Convert the given bytevector or UUID object, to the corresponding UUID

diff --git a/tests/uuid.scm b/tests/uuid.scm
index 91a3482..260614f 100644 (file)
--- a/tests/uuid.scm
+++ b/tests/uuid.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,6 +57,13 @@
   "1234-ABCD"
   (uuid->string (uuid "1234-abcd" 'fat32)))
 
+(test-assert "uuid, dynamic value"
+  (let* ((good "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
+         (bad  (string-drop good 3)))
+    (and (uuid? (uuid good))
+         (string=? good (uuid->string (uuid good)))
+         (not (uuid bad)))))
+
 (test-assert "uuid=?"
   (and (uuid=? (uuid-bytevector (uuid "1234-abcd" 'fat32))
                (uuid "1234-abcd" 'fat32))