From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: taylanbayirli@gmail.com (Taylan Ulrich =?UTF-8?Q?Bay=C4=B1rl=C4=B1/Kammer?=) Newsgroups: gmane.lisp.guile.bugs Subject: bug#22446: (rnrs hashtables): Hash functions of eq? and eqv? hashtables Date: Sun, 24 Jan 2016 12:47:08 +0100 Message-ID: <87d1srjj2b.fsf_-_@T420.taylan> References: <871t98knd4.fsf@T420.taylan> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1453635860 25931 80.91.229.3 (24 Jan 2016 11:44:20 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 24 Jan 2016 11:44:20 +0000 (UTC) To: 22446@debbugs.gnu.org Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Sun Jan 24 12:44:11 2016 Return-path: Envelope-to: guile-bugs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1aNJ5W-0007xp-Fh for guile-bugs@m.gmane.org; Sun, 24 Jan 2016 12:44:10 +0100 Original-Received: from localhost ([::1]:60029 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aNJ5V-0004bK-Ub for guile-bugs@m.gmane.org; Sun, 24 Jan 2016 06:44:09 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:50406) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aNJ5R-0004az-T0 for bug-guile@gnu.org; Sun, 24 Jan 2016 06:44:06 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aNJ5O-0008OS-N6 for bug-guile@gnu.org; Sun, 24 Jan 2016 06:44:05 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:44563) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aNJ5O-0008OO-Iy for bug-guile@gnu.org; Sun, 24 Jan 2016 06:44:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84) (envelope-from ) id 1aNJ5O-00089j-9w for bug-guile@gnu.org; Sun, 24 Jan 2016 06:44:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: taylanbayirli@gmail.com (Taylan Ulrich =?UTF-8?Q?Bay=C4=B1rl=C4=B1/Kammer?=) Original-Sender: "Debbugs-submit" Resent-CC: bug-guile@gnu.org Resent-Date: Sun, 24 Jan 2016 11:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 22446 X-GNU-PR-Package: guile X-GNU-PR-Keywords: Original-Received: via spool by 22446-submit@debbugs.gnu.org id=B22446.145363579331277 (code B ref 22446); Sun, 24 Jan 2016 11:44:02 +0000 Original-Received: (at 22446) by debbugs.gnu.org; 24 Jan 2016 11:43:13 +0000 Original-Received: from localhost ([127.0.0.1]:32783 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84) (envelope-from ) id 1aNJ4a-00088O-TK for submit@debbugs.gnu.org; Sun, 24 Jan 2016 06:43:13 -0500 Original-Received: from mail-wm0-f49.google.com ([74.125.82.49]:38817) by debbugs.gnu.org with esmtp (Exim 4.84) (envelope-from ) id 1aNJ4Z-00088D-7H for 22446@debbugs.gnu.org; Sun, 24 Jan 2016 06:43:11 -0500 Original-Received: by mail-wm0-f49.google.com with SMTP id b14so41384830wmb.1 for <22446@debbugs.gnu.org>; Sun, 24 Jan 2016 03:43:11 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:subject:references:date:in-reply-to:message-id:user-agent :mime-version:content-type; bh=tKibcuQ0FQHmndT9Lxvn/95pBJFlmkTxKhw5aLAHIYo=; b=nebuNVL3RabL8tXdTNo6ufIccEX+ENVgcZ3NQTtqCac24di8ANeoHQRMgDDPlTXSq4 nJPhJzMz99/VbI+Ee7K29kBz3GkK4emt8jzBSoXGIbdFbIQ+NebLxDYbS01I2pywAFt1 SWvRZBAYD30LXe9kieM1E6nA1d0HUYPZzRXgcaD8fuNHcqvwdKDR5M4Roguy0IMZWfOs Jp6q6XX57LRf7WA2kjTBXJjSV/L3SA5Q9hS1zQXf7RnkTXTlCICtnJP9A+VgmEzA2ZxG HsyzGddnIdNPRxq5sWyC/nh3ewhAGd5MulpSfl3qwG99ktwdzIHMyXo5GXX632AfzXFe 0MAg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:to:subject:references:date:in-reply-to :message-id:user-agent:mime-version:content-type; bh=tKibcuQ0FQHmndT9Lxvn/95pBJFlmkTxKhw5aLAHIYo=; b=OPsV6UnFLchr0GtEdtrzBQEmEhHGzUNSAeUqTZ6py//XD3XJNUmV0pdZttLJGmfkbD uMY+mTsVgc+HoIus9OvGfNiOWNrTl9uUK8NOsX4iatgsHQQWtXAzKJbSgtHS6NqEfVua 6qp/3atzOVos4HuiCPfwJsXSvOpPp7wJEZwXx0C3TdGe9xam3GWXEy8S+R6PMXj/sNU5 /9z2AUCIq2v2FAejBSA0AvKyPPQ+waHzUhnHmhhAzAq5boAz7+/QDUymY2bXga4gGDw9 wSw09WLO6k7/gESYzE3KMC2DIlaqPGPRYT6FbyQ7xUuvI3OdnBWIR+8Ifn51hh08F32e j15Q== X-Gm-Message-State: AG10YOSfaT7eLvHRx84q2mbRKqXBS5KG43pw7CtnUoVsKXXaIuHuDiGeAzjffdTsd65dHg== X-Received: by 10.28.5.213 with SMTP id 204mr12323505wmf.20.1453635785701; Sun, 24 Jan 2016 03:43:05 -0800 (PST) Original-Received: from T420.taylan ([2a02:908:c30:3ec0:221:ccff:fe66:68f0]) by smtp.gmail.com with ESMTPSA id w8sm14200323wjx.21.2016.01.24.03.43.04 for <22446@debbugs.gnu.org> (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Sun, 24 Jan 2016 03:43:04 -0800 (PST) In-Reply-To: (GNU bug Tracking System's message of "Sat, 23 Jan 2016 21:13:01 +0000") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-guile@gnu.org List-Id: "Bug reports for GUILE, GNU's Ubiquitous Extension Language" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Original-Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.bugs:7944 Archived-At: --=-=-= Content-Type: text/plain Here's a patch to fix this. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Hashtable-hash-function-returns-f-on-eq-and-eqv-tabl.patch >From a3e5a705aaea725fd751111280a27b971d8e45e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Taylan=20Ulrich=20Bay=C4=B1rl=C4=B1/Kammer?= Date: Sun, 24 Jan 2016 12:23:34 +0100 Subject: [PATCH] Hashtable-hash-function returns #f on eq and eqv tables. * module/rnrs/hashtables.scm (r6rs:hashtable)[type]: New field. (r6rs:hashtable-type): New procedure. --- module/rnrs/hashtables.scm | 22 +++++++++++++++------- test-suite/tests/r6rs-hashtables.test | 6 +++++- 2 files changed, 20 insertions(+), 8 deletions(-) diff --git a/module/rnrs/hashtables.scm b/module/rnrs/hashtables.scm index 5773eb1..22bae7f 100644 --- a/module/rnrs/hashtables.scm +++ b/module/rnrs/hashtables.scm @@ -74,8 +74,9 @@ (make-record-type-descriptor 'r6rs:hashtable #f #f #t #t '#((mutable wrapped-table) - (immutable orig-hash-function) - (immutable mutable)))) + (immutable orig-hash-function) + (immutable mutable) + (immutable type)))) (define hashtable? (record-predicate r6rs:hashtable)) (define make-r6rs-hashtable @@ -85,6 +86,7 @@ (define r6rs:hashtable-set-wrapped-table! (record-mutator r6rs:hashtable 0)) (define r6rs:hashtable-orig-hash-function (record-accessor r6rs:hashtable 1)) (define r6rs:hashtable-mutable? (record-accessor r6rs:hashtable 2)) + (define r6rs:hashtable-type (record-accessor r6rs:hashtable 3)) (define hashtable-mutable? r6rs:hashtable-mutable?) @@ -96,13 +98,15 @@ (make-r6rs-hashtable (if k (make-hash-table eq? hashq k) (make-hash-table eq? symbol-hash)) symbol-hash - #t)) + #t + 'eq)) (define* (make-eqv-hashtable #:optional k) (make-r6rs-hashtable (if k (make-hash-table eqv? hashv k) (make-hash-table eqv? hash-by-value)) hash-by-value - #t)) + #t + 'eqv)) (define* (make-hashtable hash-function equiv #:optional k) (let ((wrapped-hash-function (wrap-hash-function hash-function))) @@ -111,7 +115,8 @@ (make-hash-table equiv wrapped-hash-function k) (make-hash-table equiv wrapped-hash-function)) hash-function - #t))) + #t + 'custom))) (define (hashtable-size hashtable) (hash-table-size (r6rs:hashtable-wrapped-table hashtable))) @@ -144,7 +149,8 @@ (make-r6rs-hashtable (hash-table-copy (r6rs:hashtable-wrapped-table hashtable)) (r6rs:hashtable-orig-hash-function hashtable) - (and mutable #t))) + (and mutable #t) + (r6rs:hashtable-type hashtable))) (define* (hashtable-clear! hashtable #:optional k) (if (r6rs:hashtable-mutable? hashtable) @@ -179,4 +185,6 @@ (hash-table-equivalence-function (r6rs:hashtable-wrapped-table hashtable))) (define (hashtable-hash-function hashtable) - (r6rs:hashtable-orig-hash-function hashtable))) + (case (r6rs:hashtable-type hashtable) + ((eq eqv) #f) + (else (r6rs:hashtable-orig-hash-function hashtable))))) diff --git a/test-suite/tests/r6rs-hashtables.test b/test-suite/tests/r6rs-hashtables.test index dbf6859..5c48579 100644 --- a/test-suite/tests/r6rs-hashtables.test +++ b/test-suite/tests/r6rs-hashtables.test @@ -176,7 +176,11 @@ (with-test-prefix "hashtable-hash-function" (pass-if "hashtable-hash-function returns hash function" (let ((abs-hashtable (make-hashtable abs eqv?))) - (eq? (hashtable-hash-function abs-hashtable) abs)))) + (eq? (hashtable-hash-function abs-hashtable) abs))) + (pass-if "hashtable-hash-function returns #f on eq table" + (eq? #f (hashtable-hash-function (make-eq-hashtable)))) + (pass-if "hashtable-hash-function returns hash function" + (eq? #f (hashtable-hash-function (make-eqv-hashtable))))) (with-test-prefix "hashtable-mutable?" (pass-if "hashtable-mutable? is #t on mutable hashtables" -- 2.6.3 --=-=-=--