diff options
| -rw-r--r-- | gnu/build/file-systems.scm | 4 | ||||
| -rw-r--r-- | gnu/system/uuid.scm | 13 | ||||
| -rw-r--r-- | 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 32885f1d2e..140bcb414b 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 6470abb8cc..e422e06a6d 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 aacce77233..68676f775d 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) |