[PATCH] Implement `equal' for hash tables

Hash tables are equal if they have equal atoms, weakness, and equality
and hash functions.

(This also means that equal of structures which contain hash tables is
useful now, too, which is really the reason I implemented this: right
now, hash tables are a sort of poison pill which render any object into
which they are inserted unequal with all others.  No more.)

* src/fns.c (internal_equal): Implement it.
* test/src/fns-tests.el: Test it.
* doc/lispref/objects.texi (Equality Predicates): Document it.
---
 doc/lispref/objects.texi |  5 +++
 src/fns.c                | 32 ++++++++++++++++++
 test/src/fns-tests.el    | 72 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 109 insertions(+)

diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index d610689677e..7f916b815d2 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -2513,6 +2513,11 @@ Equality Predicates
 @code{equal} compares two symbols with position by
 comparing their components.  @xref{Symbols with Position}.
 
+Hash tables (@xref{Hash Tables}) are considered @code{equal} if they
+have the same keys and values, which all compare @code{equal}, and
+the same weakness, @code{:equal}, and hash function.  (Their size,
+being merely an optimization hint, is ignored.)
+
 Other objects are considered @code{equal} only if they are @code{eq}.
 For example, two distinct buffers are never considered @code{equal},
 even if their textual contents are the same.
diff --git a/src/fns.c b/src/fns.c
index 4284d82d6a5..4ef65e81d68 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2972,6 +2972,38 @@ internal_equal_1 (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
 		      && !memcmp (bool_vector_data (o1), bool_vector_data (o2),
 				  bool_vector_bytes (size)));
 	    }
+	  case PVEC_HASH_TABLE:
+	    {
+	      struct Lisp_Hash_Table *h1 = XHASH_TABLE (o1);
+	      struct Lisp_Hash_Table *h2 = XHASH_TABLE (o2);
+
+	      /* Hash tables with differing numbers of elements,
+		 weaknesses or equal functions are different.  Other
+		 properties are merely hints or optimizations, and do not
+		 affect equality.  */
+	      if (!BASE_EQ (Fhash_table_count (o1), Fhash_table_count (o2)))
+		return false;
+
+	      if (h1->test->hashfn != h2->test->hashfn
+		  || h1->test->cmpfn != h2->test->cmpfn
+		  || !BASE_EQ (h1->test->user_hash_function, h2->test->user_hash_function)
+		  || !internal_equal_1 (h1->test->name, h2->test->name, equal_kind, depth + 1, ht)
+		  || h1->weakness != h2->weakness)
+		return false;
+
+	      DOHASH (h1, k, v)
+		{
+		  ptrdiff_t iv2 = hash_find (h2, k);
+		  Lisp_Object v2;
+
+		  if (iv2 >= 0)
+		    v2 = HASH_VALUE (h2, iv2);
+
+		  if (iv2 < 0 || !internal_equal_1 (v, v2, equal_kind, depth + 1, ht))
+		    return false;
+		}
+	      return true;
+	    }
 
 #ifdef HAVE_TREE_SITTER
 	  case PVEC_TS_NODE:
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 0288e3a460e..952e16f5590 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -122,6 +122,78 @@ fns-tests-equal-symbols-with-position
       (should (eq foo1 foo3))
       (should (equal foo1 foo3)))))
 
+(defun fns-tests-hash-populate (h)
+  "Populate a hash table suitably for the hashtable equality tests."
+  (mapc (lambda (kv) (puthash (car kv) (cdr kv) h))
+        '((a 5) (b 6) (foo "bar") (wobble 6.5375)))
+  h)
+
+(ert-deftest fns-tests-equal-hash-tables ()
+  "Test `equal' on hash tables."
+  ;; These never get defined, but that's ok: it doesn't make a
+  ;; hash of things unless we insert things into the table.
+  (define-hash-table-test 'fns-tests--3 'my-cmp 'my-hash)
+  (define-hash-table-test 'fns-tests--4 'my-cmp 'my-otherhash)
+  (define-hash-table-test 'fns-tests--5 'my-othercmp 'my-hash)
+  (let ((heq (fns-tests-hash-populate (make-hash-table)))
+        (heqsiz (fns-tests-hash-populate (make-hash-table :size 10)))
+        (heqpure (fns-tests-hash-populate (make-hash-table :purecopy t)))
+        (heqkeyweak (fns-tests-hash-populate (make-hash-table :weakness 'key)))
+        (heqvalweak (fns-tests-hash-populate (make-hash-table :weakness 'value)))
+        (heqkavweak (fns-tests-hash-populate (make-hash-table :weakness 'key-and-value)))
+        (heqkvweak (fns-tests-hash-populate (make-hash-table :weakness 'key-or-value)))
+        (heqequal (fns-tests-hash-populate (make-hash-table :test 'equal)))
+        (heqeq (fns-tests-hash-populate (make-hash-table :test 'eq)))
+        (hequh1 (make-hash-table :test 'fns-tests--3))
+        (hequh2 (make-hash-table :test 'fns-tests--4))
+        (hequh3 (make-hash-table :test 'fns-tests--5))
+        (valdiff (fns-tests-hash-populate (make-hash-table :test 'equal)))
+        (valdiff2 (fns-tests-hash-populate (make-hash-table :test 'equal)))
+        (valdiff3 (fns-tests-hash-populate (make-hash-table :test 'equal)))
+        (valdiff4 (fns-tests-hash-populate (make-hash-table :test 'equal)))
+        (valdiff5 (fns-tests-hash-populate (make-hash-table :test 'equal))))
+
+    (remhash 'b valdiff)
+    (remhash 'b valdiff2)
+    (puthash 'wombat 42 valdiff2)
+    (puthash 'a 42 valdiff3)
+    (remhash 'b valdiff4)
+    (puthash "string key test" 666 valdiff4)
+    (remhash 'b valdiff5)
+    (puthash "string key test" 666 valdiff5)
+
+    (cl-flet ((teq (a dscr)
+                (message dscr)
+                (should (equal a a))
+                (should (equal heq a)))
+              (notteq (a dscr)
+                (should (equal a a))
+                (should-not (equal heq a))))
+      (should (equal heq heq))
+      (teq heqsiz "heqsiz")
+      (teq heqpure "heqpure")
+      (should (equal heqsiz heqpure))
+      (notteq heqkeyweak "heqkeyweak")
+      (notteq heqvalweak "heqvalweak")
+      (notteq heqkavweak "heqkavweak")
+      (notteq heqkvweak "heqkvweak")
+      (notteq heqequal "heqequal")
+      (notteq heqeq "heqeq")
+      (notteq hequh1 "hequh1")
+      (notteq hequh2 "hequh2")
+      (notteq hequh3 "hequh3")
+      (should-not (equal hequh1 hequh2))
+      (should-not (equal hequh2 hequh3))
+      (should-not (equal hequh1 hequh3))
+      (notteq valdiff "valdiff")
+      (notteq valdiff2 "valdiff2")
+      (notteq valdiff3 "valdiff3")
+      (notteq valdiff4 "valdiff4")
+      (notteq valdiff5 "valdiff5")
+      (should (not (equal heqequal valdiff4)))
+      (should (not (equal valdiff3 valdiff5)))
+      (should (equal valdiff4 valdiff5)))))
+
 (ert-deftest fns-tests-reverse ()
   (should-error (reverse))
   (should-error (reverse 1))
-- 
2.55.0.289.g420c953d2f