From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Mattias =?UTF-8?Q?Engdeg=C3=A5rd?= Newsgroups: gmane.emacs.bugs Subject: bug#63671: Add function to test equality of hash tables Date: Wed, 24 May 2023 22:34:11 +0200 Message-ID: <567C6354-0FD1-4441-B5F7-8A9ADC44DB41@gmail.com> References: <87y1ldk59f.fsf@breatheoutbreathe.in> Mime-Version: 1.0 (Mac OS X Mail 14.0 \(3654.120.0.1.15\)) Content-Type: multipart/mixed; boundary="Apple-Mail=_34F072A2-5F60-4CD5-8FF8-0DC326FC01F1" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="18375"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 63671@debbugs.gnu.org To: Joseph Turner Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed May 24 22:35:29 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1q1vCj-0004cG-6a for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 24 May 2023 22:35:29 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1q1vCP-0007Jm-AJ; Wed, 24 May 2023 16:35:09 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1q1vCN-0007JL-BY for bug-gnu-emacs@gnu.org; Wed, 24 May 2023 16:35:07 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1q1vCI-00008z-PW for bug-gnu-emacs@gnu.org; Wed, 24 May 2023 16:35:06 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1q1vCI-00007F-0E for bug-gnu-emacs@gnu.org; Wed, 24 May 2023 16:35:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Mattias =?UTF-8?Q?Engdeg=C3=A5rd?= Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Wed, 24 May 2023 20:35:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 63671 X-GNU-PR-Package: emacs Original-Received: via spool by 63671-submit@debbugs.gnu.org id=B63671.1684960465376 (code B ref 63671); Wed, 24 May 2023 20:35:01 +0000 Original-Received: (at 63671) by debbugs.gnu.org; 24 May 2023 20:34:25 +0000 Original-Received: from localhost ([127.0.0.1]:45220 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q1vBh-00005z-0u for submit@debbugs.gnu.org; Wed, 24 May 2023 16:34:25 -0400 Original-Received: from mail-lf1-f50.google.com ([209.85.167.50]:62572) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1q1vBb-00005d-NY for 63671@debbugs.gnu.org; Wed, 24 May 2023 16:34:23 -0400 Original-Received: by mail-lf1-f50.google.com with SMTP id 2adb3069b0e04-4f3a611b3ddso295327e87.0 for <63671@debbugs.gnu.org>; Wed, 24 May 2023 13:34:19 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20221208; t=1684960453; x=1687552453; h=references:to:cc:in-reply-to:date:subject:mime-version:message-id :from:sender:from:to:cc:subject:date:message-id:reply-to; bh=r+taTOWWqcpRL9eCqS9uJZK0BI8RNhspjXosqU94irw=; b=gezyJBworNCI9vGVlb7UFHWhOuSFdjlKyR1jwoSQNFewLuFXfSPRtp4+TGb5+zg/mJ v8zDx3TPIkhJsYg0vt3Vi+P3VXj39WbuLspz3E2rJyCZSpXTj/JGGxytiX5uDBVnvUpv HipI/vwWmH+CAv2GsszIQPO56/HlIchJDKqAXCGiHUlf2FmDLUejVw0wGjzqe8VnGfQf IpJEdNz+RX05GOkI8lvohek405uIQG6rcoYqNylJADli94ucyonukh+7uFFt4Q+Mi1XQ u8Ud+Nx4OwmvAiiOFZoJv9Du3aCPBrgDI+He9bJnBIMaG69fwK+0tJrcybBWnZQEcLIq e3iw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684960453; x=1687552453; h=references:to:cc:in-reply-to:date:subject:mime-version:message-id :from:sender:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=r+taTOWWqcpRL9eCqS9uJZK0BI8RNhspjXosqU94irw=; b=eG8wcFCp5rK/VaDb0DFi17JRTBkouDLLeoVZMtHRjzStPO0ssjUmdVqw/q5u39OEmP aNsevlhaldwVVa8smR1FTWjMtSvwFFrFNjgTX8EYcLH26FmZxlCbOa2KVY4HV5cQ8d+W VIrsqbY82nCZC3eBrUoi2+jSsriZOqH84HGAW0+5wGJPV/rsSjrxvwrmSb03fV9uZ4Wb coQx1T9YJIElHNmIVr2BaFPc5jBmcitp97PgCeygop466Y5bkQaez6umlU8JAtmM207e KjVPyFlaldjwDXDqOAuT8BaiCJTtCGvCb1mmGKcPyBC80MBjNqX/ilXpaTOKw7Sgk5Zi dhag== X-Gm-Message-State: AC+VfDw16JhbqsFRZdxHmkin6BujfqjvY1vSN06SdgM7OBruTQG9Mk7G FtXN0DhlqN3Gs6SEXJkVT8w= X-Google-Smtp-Source: ACHHUZ7ymvNZs40vwSI3pSKwMVVRz5+oAV8dfa0G4pv+cd/IJby8jJpD77ve5EuFaMjQYhJzBwyT4Q== X-Received: by 2002:ac2:5338:0:b0:4f4:a656:2466 with SMTP id f24-20020ac25338000000b004f4a6562466mr146729lfh.15.1684960453042; Wed, 24 May 2023 13:34:13 -0700 (PDT) Original-Received: from smtpclient.apple (c188-150-165-235.bredband.tele2.se. [188.150.165.235]) by smtp.gmail.com with ESMTPSA id r27-20020ac252bb000000b004f38267a2f9sm1834416lfm.161.2023.05.24.13.34.12 (version=TLS1_2 cipher=ECDHE-ECDSA-AES128-GCM-SHA256 bits=128/128); Wed, 24 May 2023 13:34:12 -0700 (PDT) In-Reply-To: <87y1ldk59f.fsf@breatheoutbreathe.in> X-Mailer: Apple Mail (2.3654.120.0.1.15) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:262318 Archived-At: --Apple-Mail=_34F072A2-5F60-4CD5-8FF8-0DC326FC01F1 Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=us-ascii 24 maj 2023 kl. 19.27 skrev Joseph Turner : > 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. --Apple-Mail=_34F072A2-5F60-4CD5-8FF8-0DC326FC01F1 Content-Disposition: attachment; filename=hash-table-equal-p.diff Content-Type: application/octet-stream; x-unix-mode=0644; name="hash-table-equal-p.diff" Content-Transfer-Encoding: 7bit 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 --Apple-Mail=_34F072A2-5F60-4CD5-8FF8-0DC326FC01F1--