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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 263c9941a1e523b360ca9f42d1ed6b11e6e6e285
Author: Ludovic Courtès <address@hidden>
Date:   Fri May 18 22:20:33 2018 +0200

    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.
---
 gnu/system/uuid.scm | 11 +++++++----
 tests/uuid.scm      |  9 ++++++++-
 2 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index 73695dd..f13960c 100644
--- 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 <address@hidden>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2017 Danny Milosavljevic <address@hidden>
 ;;;
 ;;; 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
--- 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 <address@hidden>
+;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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))