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 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) |
