all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
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

  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

* 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 external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.