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=?'.
This commit is contained in:
parent
67a08f1809
commit
aed1f1b049
|
@ -415,12 +415,12 @@ was READ is = to the given value."
|
||||||
(partition-predicate read-partition-label string=?))
|
(partition-predicate read-partition-label string=?))
|
||||||
|
|
||||||
(define partition-uuid-predicate
|
(define partition-uuid-predicate
|
||||||
(partition-predicate read-partition-uuid bytevector=?))
|
(partition-predicate read-partition-uuid uuid=?))
|
||||||
|
|
||||||
(define luks-partition-uuid-predicate
|
(define luks-partition-uuid-predicate
|
||||||
(partition-predicate
|
(partition-predicate
|
||||||
(partition-field-reader read-luks-header luks-header-uuid)
|
(partition-field-reader read-luks-header luks-header-uuid)
|
||||||
bytevector=?))
|
uuid=?))
|
||||||
|
|
||||||
(define (find-partition predicate)
|
(define (find-partition predicate)
|
||||||
"Return the first partition found that matches PREDICATE, or #f if none
|
"Return the first partition found that matches PREDICATE, or #f if none
|
||||||
|
|
|
@ -29,6 +29,7 @@
|
||||||
uuid?
|
uuid?
|
||||||
uuid-type
|
uuid-type
|
||||||
uuid-bytevector
|
uuid-bytevector
|
||||||
|
uuid=?
|
||||||
|
|
||||||
bytevector->uuid
|
bytevector->uuid
|
||||||
|
|
||||||
|
@ -281,3 +282,15 @@ corresponding bytevector; otherwise return #f."
|
||||||
((_ . (? procedure? unparse)) (unparse bv))))
|
((_ . (? procedure? unparse)) (unparse bv))))
|
||||||
(((? uuid? uuid))
|
(((? uuid? uuid))
|
||||||
(uuid->string (uuid-bytevector uuid) (uuid-type 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))))
|
||||||
|
|
|
@ -57,4 +57,10 @@
|
||||||
"1234-ABCD"
|
"1234-ABCD"
|
||||||
(uuid->string (uuid "1234-abcd" 'fat32)))
|
(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)
|
(test-end)
|
||||||
|
|
Loading…
Reference in New Issue