01/04: uuid: Add 'uuid=?' and use it.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit aed1f1b049f6e7ef9f2f2db58bdca6cd3effe94b
Author: Ludovic Courtès <address@hidden>
Date:   Wed Oct 4 21:34:09 2017 +0200

    uuid: Add 'uuid=?' and use it.
    
    * gnu/system/uuid.scm (uuid=?): New procedure.
    * tests/uuid.scm ("uuid=?"): New test.
    * gnu/build/file-systems.scm (partition-uuid-predicate)
    (luks-partition-uuid-predicate): Use it instead of 'bytevector=?'.
---
 gnu/build/file-systems.scm |  4 ++--
 gnu/system/uuid.scm        | 13 +++++++++++++
 tests/uuid.scm             |  6 ++++++
 3 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 32885f1..140bcb4 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -415,12 +415,12 @@ was READ is = to the given value."
   (partition-predicate read-partition-label string=?))
 
 (define partition-uuid-predicate
-  (partition-predicate read-partition-uuid bytevector=?))
+  (partition-predicate read-partition-uuid uuid=?))
 
 (define luks-partition-uuid-predicate
   (partition-predicate
    (partition-field-reader read-luks-header luks-header-uuid)
-   bytevector=?))
+   uuid=?))
 
 (define (find-partition predicate)
   "Return the first partition found that matches PREDICATE, or #f if none
diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index 6470abb..e422e06 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -29,6 +29,7 @@
             uuid?
             uuid-type
             uuid-bytevector
+            uuid=?
 
             bytevector->uuid
 
@@ -281,3 +282,15 @@ corresponding bytevector; otherwise return #f."
        ((_ . (? procedure? unparse)) (unparse bv))))
     (((? uuid? uuid))
      (uuid->string (uuid-bytevector uuid) (uuid-type uuid)))))
+
+(define uuid=?
+  ;; Return true if A is equal to B, comparing only the actual bits.
+  (match-lambda*
+    (((? bytevector? a) (? bytevector? b))
+     (bytevector=? a b))
+    (((? uuid? a) (? bytevector? b))
+     (bytevector=? (uuid-bytevector a) b))
+    (((? uuid? a) (? uuid? b))
+     (bytevector=? (uuid-bytevector a) (uuid-bytevector b)))
+    ((a b)
+     (uuid=? b a))))
diff --git a/tests/uuid.scm b/tests/uuid.scm
index aacce77..68676f7 100644
--- a/tests/uuid.scm
+++ b/tests/uuid.scm
@@ -57,4 +57,10 @@
   "1234-ABCD"
   (uuid->string (uuid "1234-abcd" 'fat32)))
 
+(test-equal "uuid=?"
+  (and (uuid=? (uuid-bytevector (uuid "1234-abcd" 'fat32))
+               (uuid "1234-abcd" 'fat32))
+       (uuid=? (uuid "1234-abcd" 'fat32)
+               (uuid "1234-abcd" 'fat))))
+
 (test-end)