From: "Ludovic Courtès" <ludo@gnu.org>
To: 28706@debbugs.gnu.org
Subject: [bug#28706] [PATCH 1/3] uuid: Add 'uuid=?' and use it.
Date: Wed, 4 Oct 2017 21:51:43 +0200 [thread overview]
Message-ID: <20171004195145.4743-1-ludo@gnu.org> (raw)
In-Reply-To: <20171004194831.4524-1-ludo@gnu.org>
* 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=?'.
---
gnu/build/file-systems.scm | 4 ++--
gnu/system/uuid.scm | 13 +++++++++++++
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 32885f1d2..140bcb414 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 6470abb8c..e422e06a6 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 aacce7723..68676f775 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)
--
2.14.2
next prev parent reply other threads:[~2017-10-04 19:53 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-10-04 19:48 [bug#28706] [PATCH 0/3] Detect wrong UUIDs/labels in 'guix system init/reconfigure' Ludovic Courtès
2017-10-04 19:51 ` Ludovic Courtès [this message]
2017-10-04 19:51 ` [bug#28706] [PATCH 2/3] file-systems: Add a 'location' field to <file-system> Ludovic Courtès
2017-10-05 6:11 ` Danny Milosavljevic
2017-10-04 19:51 ` [bug#28706] [PATCH 3/3] guix system: Error out when passed a wrong file system UUID/label Ludovic Courtès
2017-10-05 6:12 ` Danny Milosavljevic
2017-10-05 10:12 ` bug#28706: " Ludovic Courtès
2017-10-05 6:11 ` [bug#28706] [PATCH 1/3] uuid: Add 'uuid=?' and use it Danny Milosavljevic
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20171004195145.4743-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=28706@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).