mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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
3 changed files with 21 additions and 2 deletions
|
@ -415,12 +415,12 @@ (define partition-label-predicate
|
|||
(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
|
||||
|
|
|
@ -29,6 +29,7 @@ (define-module (gnu system uuid)
|
|||
uuid?
|
||||
uuid-type
|
||||
uuid-bytevector
|
||||
uuid=?
|
||||
|
||||
bytevector->uuid
|
||||
|
||||
|
@ -281,3 +282,15 @@ (define uuid->string
|
|||
((_ . (? 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))))
|
||||
|
|
|
@ -57,4 +57,10 @@ (define-module (test-uuid)
|
|||
"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)
|
||||
|
|
Loading…
Reference in a new issue