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:
Ludovic Courtès 2017-10-04 21:34:09 +02:00
parent 67a08f1809
commit aed1f1b049
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 21 additions and 2 deletions

View file

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

View file

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

View file

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