summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/file-systems.scm4
-rw-r--r--gnu/system/uuid.scm13
-rw-r--r--tests/uuid.scm6
3 files changed, 21 insertions, 2 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 32885f1d2ef..140bcb414b0 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -415,12 +415,12 @@ was READ is = to the given value."
415 (partition-predicate read-partition-label string=?)) 415 (partition-predicate read-partition-label string=?))
416 416
417(define partition-uuid-predicate 417(define partition-uuid-predicate
418 (partition-predicate read-partition-uuid bytevector=?)) 418 (partition-predicate read-partition-uuid uuid=?))
419 419
420(define luks-partition-uuid-predicate 420(define luks-partition-uuid-predicate
421 (partition-predicate 421 (partition-predicate
422 (partition-field-reader read-luks-header luks-header-uuid) 422 (partition-field-reader read-luks-header luks-header-uuid)
423 bytevector=?)) 423 uuid=?))
424 424
425(define (find-partition predicate) 425(define (find-partition predicate)
426 "Return the first partition found that matches PREDICATE, or #f if none 426 "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 6470abb8cc5..e422e06a6da 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -29,6 +29,7 @@
29 uuid? 29 uuid?
30 uuid-type 30 uuid-type
31 uuid-bytevector 31 uuid-bytevector
32 uuid=?
32 33
33 bytevector->uuid 34 bytevector->uuid
34 35
@@ -281,3 +282,15 @@ corresponding bytevector; otherwise return #f."
281 ((_ . (? procedure? unparse)) (unparse bv)))) 282 ((_ . (? procedure? unparse)) (unparse bv))))
282 (((? uuid? uuid)) 283 (((? uuid? uuid))
283 (uuid->string (uuid-bytevector uuid) (uuid-type uuid))))) 284 (uuid->string (uuid-bytevector uuid) (uuid-type uuid)))))
285
286(define uuid=?
287 ;; Return true if A is equal to B, comparing only the actual bits.
288 (match-lambda*
289 (((? bytevector? a) (? bytevector? b))
290 (bytevector=? a b))
291 (((? uuid? a) (? bytevector? b))
292 (bytevector=? (uuid-bytevector a) b))
293 (((? uuid? a) (? uuid? b))
294 (bytevector=? (uuid-bytevector a) (uuid-bytevector b)))
295 ((a b)
296 (uuid=? b a))))
diff --git a/tests/uuid.scm b/tests/uuid.scm
index aacce772334..68676f775d6 100644
--- a/tests/uuid.scm
+++ b/tests/uuid.scm
@@ -57,4 +57,10 @@
57 "1234-ABCD" 57 "1234-ABCD"
58 (uuid->string (uuid "1234-abcd" 'fat32))) 58 (uuid->string (uuid "1234-abcd" 'fat32)))
59 59
60(test-equal "uuid=?"
61 (and (uuid=? (uuid-bytevector (uuid "1234-abcd" 'fat32))
62 (uuid "1234-abcd" 'fat32))
63 (uuid=? (uuid "1234-abcd" 'fat32)
64 (uuid "1234-abcd" 'fat))))
65
60(test-end) 66(test-end)