all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
From: "Mattias Engdegård" <mattias.engdegard@gmail.com>
To: Joseph Turner <joseph@breatheoutbreathe.in>
Cc: 63671@debbugs.gnu.org
Subject: bug#63671: Add function to test equality of hash tables
Date: Wed, 24 May 2023 22:34:11 +0200	[thread overview]
Message-ID: <567C6354-0FD1-4441-B5F7-8A9ADC44DB41@gmail.com> (raw)
In-Reply-To: <87y1ldk59f.fsf@breatheoutbreathe.in>

[-- Attachment #1: Type: text/plain, Size: 553 bytes --]

24 maj 2023 kl. 19.27 skrev Joseph Turner <joseph@breatheoutbreathe.in>:

> Would extending `equal' to handle hash tables be generally useful?

It would, but doing so would be very risky at this point since it would change long-standing semantics.

We could make an augmented version of `equal` but what we really want is one that works for user-defined types (see Ihor's reference to a previous discussion).

Anyway, here's an old patch I had lying around, in case we decide that we do need a shoddy equality predicate for hash tables only.


[-- Attachment #2: hash-table-equal-p.diff --]
[-- Type: application/octet-stream, Size: 3636 bytes --]

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 9cd793d05c..17ca80a297 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -93,6 +93,28 @@ hash-table-values
   "Return a list of values in HASH-TABLE."
   (cl-loop for v being the hash-values of hash-table collect v))
 
+(defun hash-table-equal-p (h1 h2 &optional value-eq)
+  "Whether the hash tables H1 and H2 are equal with respect to VALUE-EQ.
+Equality means that the tables have the same equality predicate
+and the same set of key-value pairs where keys are compared by
+that predicate and values by VALUE-EQ, which defaults to `eq'."
+  (or (eq h1 h2)
+      (and (= (hash-table-count h1) (hash-table-count h2))
+           (eq (hash-table-test h1) (hash-table-test h2))
+           (progn
+             (unless value-eq
+               (setq value-eq #'eq))
+             ;; Loop over the physically smaller table.
+             (when (> (hash-table-size h1) (hash-table-size h2))
+               (cl-rotatef h1 h2))
+             (catch 'done
+               (maphash
+                (lambda (k v)
+                  (unless (funcall value-eq v (gethash k h2 (not v)))
+                    (throw 'done nil)))
+                h1)
+               t)))))
+
 (defsubst string-empty-p (string)
   "Check whether STRING is empty."
   (string= string ""))
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 7f3916c2c0..923155eedb 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -743,6 +743,55 @@ test-with-buffer-unmodified-if-unchanged
           (with-current-buffer inner
             (should-not (buffer-modified-p))))))))
 
+(ert-deftest subr-x--hash-table-equal-p ()
+  (cl-flet ((hashtab (test &rest elts)
+              (let ((h (make-hash-table :test test)))
+                (while elts
+                  (let* ((key (pop elts))
+                         (val (pop elts)))
+                    (puthash key val h)))
+                h)))
+
+    (let ((h1 (hashtab #'eq 'a (list 1) 'b (list 2))
+          (h2 (hashtab #'eq 'a (list 1) 'b (list 2)))))
+      (should (hash-table-equal-p h1 h2 #'equal))
+      (should (hash-table-equal-p h2 h1 #'equal))
+      (should (not (hash-table-equal-p h1 h2 #'eq)))
+      (should (not (hash-table-equal-p h2 h1 #'eq)))
+      (should (hash-table-equal-p h1 h1 #'eq)))
+
+    (let ((h1 (hashtab #'eql 1 'a 2 'b)
+          (h2 (hashtab #'equal 1 'a 2 'b))))
+      (should (not (hash-table-equal-p h1 h2)))
+      (should (not (hash-table-equal-p h2 h1))))
+
+    (let ((h1 (hashtab #'eql 1 'a 2 'a)
+          (h2 (hashtab #'eql 1 'a))))
+      (should (not (hash-table-equal-p h1 h2)))
+      (should (not (hash-table-equal-p h2 h1))))
+
+    (let ((h1 (hashtab #'eql 1 'a 2 'a)
+          (h2 (hashtab #'eql 1 'a 2 'b))))
+      (should (not (hash-table-equal-p h1 h2)))
+      (should (not (hash-table-equal-p h2 h1))))
+
+    (let ((h1 (hashtab #'eql 1 'a 2 'a)
+          (h2 (hashtab #'eql 1 'a 3 'a))))
+      (should (not (hash-table-equal-p h1 h2)))
+      (should (not (hash-table-equal-p h2 h1))))
+
+    (let ((h1 (hashtab #'eql)
+          (h2 (hashtab #'eql))))
+      (should (hash-table-equal-p h1 h2))
+      (should (hash-table-equal-p h2 h1)))
+
+    (let ((h1 (make-hash-table :test #'eql :size 1000 :rehash-size 3.5))
+          (h2 (hashtab #'eql 10 'a 20 'b)))
+      (puthash 10 'a h1)
+      (puthash 20 'b h1)
+      (should (hash-table-equal-p h1 h2))
+      (should (hash-table-equal-p h2 h1)))
+    ))
 
 (provide 'subr-x-tests)
 ;;; subr-x-tests.el ends here

  parent reply	other threads:[~2023-05-24 20:34 UTC|newest]

Thread overview: 11+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-05-23 19:32 bug#63671: Add function to test equality of hash tables Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-05-24  9:27 ` Mattias Engdegård
2023-05-24 17:27   ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-05-24 20:01     ` Ihor Radchenko
2023-05-24 20:34     ` Mattias Engdegård [this message]
2023-05-25  2:44       ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-05-25  6:31         ` Ihor Radchenko
2023-05-25  7:22           ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-05-25  7:22           ` Joseph Turner via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-05-25  8:18           ` Mattias Engdegård
2023-09-11 18:39             ` Stefan Kangas

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=567C6354-0FD1-4441-B5F7-8A9ADC44DB41@gmail.com \
    --to=mattias.engdegard@gmail.com \
    --cc=63671@debbugs.gnu.org \
    --cc=joseph@breatheoutbreathe.in \
    /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/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.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.