From 575a3316916fdddbc30a404f190277e1b5c0e71a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9ssica=20Milar=C3=A9?= Date: Tue, 8 Jan 2019 22:07:02 -0200 Subject: [PATCH 5/5] Implemented SRFI-126 using GENERIC-HASH-TABLES --- module/Makefile.am | 1 + module/srfi/srfi-126.scm | 215 +++++++++++++++++++++ test-suite/Makefile.am | 1 + test-suite/tests/srfi-126.test | 344 +++++++++++++++++++++++++++++++++ 4 files changed, 561 insertions(+) create mode 100644 module/srfi/srfi-126.scm create mode 100644 test-suite/tests/srfi-126.test diff --git a/module/Makefile.am b/module/Makefile.am index 6dba87ce8..6e739fed0 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -294,6 +294,7 @@ SOURCES = \ srfi/srfi-88.scm \ srfi/srfi-98.scm \ srfi/srfi-111.scm \ + srfi/srfi-126.scm \ \ statprof.scm \ \ diff --git a/module/srfi/srfi-126.scm b/module/srfi/srfi-126.scm new file mode 100644 index 000000000..7a6594434 --- /dev/null +++ b/module/srfi/srfi-126.scm @@ -0,0 +1,215 @@ +;;; srfi-69.scm --- Basic hash tables + +;; Copyright (C) 2007 Free Software Foundation, Inc. +;; +;; This library is free software; you can redistribute it and/or +;; modify it under the terms of the GNU Lesser General Public +;; License as published by the Free Software Foundation; either +;; version 3 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +(define-module (srfi srfi-126) + #:use-module (srfi srfi-1) + #:use-module ((ice-9 generic-hash-tables) #:prefix gen:) + #:use-module ((rnrs hashtables) + #:select (hashtable? + hashtable-contains? hashtable-mutable? + hashtable-set! hashtable-delete! hashtable-clear! + hashtable-size + hashtable-keys hashtable-entries + hashtable-equivalence-function + hashtable-hash-function + equal-hash symbol-hash + string-hash string-ci-hash)) + #:re-export (hashtable? + hashtable-contains? hashtable-mutable? + hashtable-set! hashtable-delete! hashtable-clear! + hashtable-size + hashtable-keys hashtable-entries + hashtable-equivalence-function + hashtable-hash-function + equal-hash symbol-hash + string-hash string-ci-hash) + #:export (make-eq-hashtable + make-eqv-hashtable make-hashtable + alist->eq-hashtable alist->eqv-hashtable alist->hashtable + hashtable-weakness + hashtable-ref hashtable-lookup + hashtable-update! hashtable-intern! + hashtable-copy hashtable-empty-copy + hashtable-values + hashtable-key-list hashtable-value-list hashtable-entry-lists + hashtable-walk hashtable-update-all! + hashtable-prune! hashtable-merge! hashtable-sum + hashtable-map->lset + hashtable-find hashtable-empty? + hashtable-pop! + hashtable-inc! hashtable-dec! + hash-salt)) + +(cond-expand-provide (current-module) '(srfi-126)) + +(define hashtable? gen:hash-table?) + +(define* (make-hashtable hash-function equiv-function + #:optional capacity weakness) + "Creates a new hash table. EQUIV-FUNCTION is used as the comparison +function and HASH-FUNCTION, if provided and not false, is used as the +hash function, otherwise a suitable hash-function for the hash table is +guessed or, if one can't be guessed, an error is signaled. WEAKNESS +should be either #f, WEAK-KEY, WEAK-VALUE or WEAK-KEY-AND-VALUE. +CAPACITY is the minimal number of buckets of the hash table." + (gen:make-hash-table equiv-function (if (pair? hash-function) + (car hash-function) + hash-function) + #:capacity (or capacity 1) + #:weakness weakness)) + +(define* (make-eq-hashtable #:optional capacity weakness) + (gen:make-hash-table eq? gen:hash-by-identity + #:capacity (or capacity 1) + #:weakness weakness)) + +(define* (make-eqv-hashtable #:optional capacity weakness) + (gen:make-hash-table eqv? gen:hash-by-value + #:capacity (or capacity 1) + #:weakness weakness)) + +(define alist->hashtable + (case-lambda + ((hash-function equiv-function alist) + (gen:alist->hash-table alist equiv-function + (if (pair? hash-function) + (car hash-function) + hash-function))) + ((hash-function equiv-function capacity alist) + (gen:alist->hash-table alist equiv-function + (if (pair? hash-function) + (car hash-function) + hash-function) + #:capacity (or capacity 1))) + ((hash-function equiv-function capacity weakness alist) + (gen:alist->hash-table alist equiv-function + (if (pair? hash-function) + (car hash-function) + hash-function) + #:capacity (or capacity 1) + #:weakness weakness)))) + +(define (alist->eq-hashtable . args) + (apply alist->hashtable #f eq? args)) + +(define (alist->eqv-hashtable . args) + (apply alist->hashtable #f eqv? args)) + +(define* (hashtable-ref ht key #:optional default) + (if default + (gen:hash-table-ref/default ht key default) + (gen:hash-table-ref ht key))) + +;; (define hashtable-contains? rnrs:hashtable-contains?) +;; (define hashtable-set! rnrs:hashtable-set!) +;; (define hashtable-delete! rnrs:hashtable-delete!) + +(define (hashtable-lookup hashtable key) + (let* ((found? #t) + (value (gen:hash-table-ref hashtable key + (lambda () (set! found? #f) #f)))) + (values value found?))) + +(define* (hashtable-update! ht key modifier #:optional default) + (if default + (gen:hash-table-update!/default ht key modifier default) + (gen:hash-table-update! ht key modifier))) + +(define hashtable-intern! gen:hash-table-intern!) + +(define* (hashtable-copy hashtable #:optional mutable + (weakness (hashtable-weakness hashtable))) + (gen:hash-table-copy hashtable #:mutable mutable #:weakness weakness)) + +;; (define hashtable-clear! rnrs:hashtable-clear!) + +(define* (hashtable-empty-copy hashtable #:optional capacity + (weakness (hashtable-weakness hashtable))) + (let ((capacity (case capacity + ((#f) 1) + ((#t) (hashtable-size hashtable)) + (else capacity)))) + (gen:hash-table-empty-copy hashtable #:capacity capacity #:weakness weakness))) + + +;;;; Accessing whole tables + +;; (define hashtable-size rnrs:hashtable-size) +;; (define hashtable-keys gen:hash-table-key-vector) +(define hashtable-values gen:hash-table-value-vector) +;; (define hashtable-entries rnrs:hashtable-entries) +(define hashtable-key-list gen:hash-table-keys) +(define hashtable-value-list gen:hash-table-values) +(define hashtable-entry-lists gen:hash-table-entries) +(define hashtable->alist gen:hash-table->alist) + +(define (hashtable-walk hashtable proc) + (gen:hash-table-for-each proc hashtable)) + +(define (hashtable-update-all! hashtable proc) + (gen:hash-table-map! proc hashtable)) + +(define (hashtable-prune! hashtable proc) + (gen:hash-table-prune! proc hashtable)) + +(define (hashtable-sum hashtable init proc) + (gen:hash-table-fold proc init hashtable)) + +(define (hashtable-merge! ht other-ht) + (gen:hash-table-for-each (lambda (k v) (hashtable-set! ht k v)) + other-ht) + ht) + +(define (hashtable-map->lset hashtable proc) + (gen:hash-table-map->list proc hashtable)) + +(define (hashtable-find hashtable proc) + (call/cc (lambda (return) + (gen:hash-table-for-each (lambda (k v) + (when (proc k v) (return k v #t))) + hashtable) + (values *unspecified* *unspecified* #f)))) + +(define hashtable-empty? gen:hash-table-empty?) +(define hashtable-pop! gen:hash-table-pop!) + +(define* (hashtable-inc! hashtable key #:optional (number 1)) + (hashtable-update! hashtable key (lambda (v) (+ v number)) 0)) + +(define* (hashtable-dec! hashtable key #:optional (number 1)) + (hashtable-update! hashtable key (lambda (v) (- v number)) 0)) + +(define hashtable-weakness gen:hash-table-weakness) +;; (define hashtable-mutable? rnrs:hashtable-mutable?) +;; (define hashtable-equivalence-function rnrs:hashtable-equivalence-function) +;; (define hashtable-hash-function rnrs:hashtable-hash-function) +;; (define equal-hash rnrs:equal-hash) +;; (define string-hash rnrs:string-hash) +;; (define string-ci-hash rnrs:string-ci-hash) +;; (define symbol-hash rnrs:symbol-hash) + +(define *hash-salt* + (let ((seed (getenv "SRFI_126_HASH_SEED"))) + (if (or (not seed) (string=? seed "")) + (random most-positive-fixnum) + (modulo (string-hash seed) most-positive-fixnum)))) + +(define (hash-salt) *hash-salt*) + +;; eof diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index e154602a7..f0ad8bb91 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -162,6 +162,7 @@ SCM_TESTS = tests/00-initial-env.test \ tests/srfi-98.test \ tests/srfi-105.test \ tests/srfi-111.test \ + tests/srfi-126.test \ tests/srfi-4.test \ tests/srfi-9.test \ tests/statprof.test \ diff --git a/test-suite/tests/srfi-126.test b/test-suite/tests/srfi-126.test new file mode 100644 index 000000000..e6a4e66a9 --- /dev/null +++ b/test-suite/tests/srfi-126.test @@ -0,0 +1,344 @@ +;;;; srfi-69.test --- Test suite for SRFI 69 -*- scheme -*- +;;;; +;;;; Copyright (C) 2007 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; The following tests are the tests from SRFI-126 reference +;;; implementation ported to Guile test suite. + +(define-module (test-srfi-126) + #:use-module (test-suite lib) + #:use-module (srfi srfi-126) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-8)) + +(define-syntax with-elt-in-list + (syntax-rules () + ((with-elt-in-list arg arg-list expr ...) + (let loop ((arg-list* arg-list)) + (or (null? arg-list*) + (and (let ((arg (car arg-list*))) + expr ...) + (loop (cdr arg-list*)))))))) + +(define (exact-integer? obj) + (and (integer? obj) (exact? obj))) + +(define (test-str-weakness str weakness) + (if (not weakness) str (format #f "~a (weakness: ~a)" str weakness))) + + + +(with-test-prefix "SRFI-126" + + ;; The following tests are done once with each kind of weakness + (with-elt-in-list weakness (list #f 'weak-key 'weak-value 'weak-key-and-value) + + (with-test-prefix "eq" + (let ((tables (list (and (not weakness) + (make-eq-hashtable)) + (make-eq-hashtable 10 weakness) + (make-eq-hashtable #f weakness) + (make-hashtable #f eq? #f weakness) + (and (not weakness) + (alist->eq-hashtable '((a . b) (c . d)))) + (alist->eq-hashtable 10 weakness '((a . b) (c . d))) + (alist->eq-hashtable #f weakness '((a . b) (c . d)))))) + (do ((tables tables (cdr tables)) + (i 0 (+ i 1))) + ((null? tables)) + (and-let* ((table (car tables))) + (with-test-prefix (test-str-weakness (format #f "table ~a" i) weakness) + (pass-if (hashtable? table)) + (pass-if-equal #f (hashtable-hash-function table)) + (pass-if-equal eq? (hashtable-equivalence-function table)) + (pass-if-equal weakness (hashtable-weakness table)) + (pass-if (hashtable-mutable? table))))))) + + (with-test-prefix "eqv" + (let ((tables (list (and (not weakness) + (make-eqv-hashtable)) + (make-eqv-hashtable 10 weakness) + (make-eqv-hashtable #f weakness) + (make-hashtable #f eqv? #f weakness) + (and (not weakness) + (alist->eqv-hashtable '((a . b) (c . d)))) + (alist->eqv-hashtable 10 weakness '((a . b) (c . d))) + (alist->eqv-hashtable #f weakness '((a . b) (c . d)))))) + (do ((tables tables (cdr tables)) + (i 0 (+ i 1))) + ((null? tables)) + (and-let* ((table (car tables))) + (with-test-prefix (test-str-weakness (format #f "table ~a" i) weakness) + (pass-if (hashtable? table)) + (pass-if-equal #f (hashtable-hash-function table)) + (pass-if-equal eqv? (hashtable-equivalence-function table)) + (pass-if-equal weakness (hashtable-weakness table)) + (pass-if (hashtable-mutable? table))))))) + + (with-test-prefix "equal" + (let ((tables (list (and (not weakness) + (make-hashtable equal-hash equal?)) + (make-hashtable equal-hash equal? 10 weakness) + (make-hashtable equal-hash equal? #f weakness) + (and (not weakness) + (alist->hashtable equal-hash equal? '((a . b) (c . d)))) + (alist->hashtable equal-hash equal? 10 weakness + '((a . b) (c . d))) + (alist->hashtable equal-hash equal? #f weakness + '((a . b) (c . d))) + (and (not weakness) + (make-hashtable (cons equal-hash equal-hash) equal?))))) + (do ((tables tables (cdr tables)) + (i 0 (+ i 1))) + ((null? tables)) + (and-let* ((table (car tables))) + (with-test-prefix (test-str-weakness (format #f "table ~a" i) weakness) + (pass-if (hashtable? table)) + (pass-if-equal equal-hash (hashtable-hash-function table)) + (pass-if-equal equal? (hashtable-equivalence-function table)) + (pass-if-equal weakness (hashtable-weakness table)) + (pass-if (hashtable-mutable? table))))))) + + (with-test-prefix "alist" + (let ((tables (list (and (not weakness) + (alist->eq-hashtable '((a . b) (a . c)))) + (and (not weakness) + (alist->eqv-hashtable '((a . b) (a . c)))) + (and (not weakness) + (alist->hashtable equal-hash equal? + '((a . b) (a . c)))) + (alist->eq-hashtable #f weakness '((a . b) (a . c))) + (alist->eqv-hashtable #f weakness '((a . b) (a . c))) + (alist->hashtable equal-hash equal? #f weakness + '((a . b) (a . c)))))) + (do ((tables tables (cdr tables)) + (i 0 (+ i 1))) + ((null? tables)) + (and-let* ((table (car tables))) + (with-test-prefix (test-str-weakness (format #f "table ~a" i) weakness) + (pass-if-equal 'b (hashtable-ref table 'a))))))) + + (with-test-prefix "procedures" + (with-test-prefix "basics" + (let ((table (make-eq-hashtable #f weakness))) + (with-test-prefix "ref" + (pass-if-exception "key not found" + '(misc-error . "^Key not in table") + (hashtable-ref table 'a)) + (pass-if-equal 'b (hashtable-ref table 'a 'b)) + (pass-if (not (hashtable-contains? table 'a))) + (pass-if-equal 0 (hashtable-size table))) + (with-test-prefix "set" + (hashtable-set! table 'a 'c) + (pass-if-equal 'c (hashtable-ref table 'a)) + (pass-if-equal 'c (hashtable-ref table 'a 'b)) + (pass-if (hashtable-contains? table 'a)) + (pass-if-equal 1 (hashtable-size table))) + (with-test-prefix "delete" + (hashtable-delete! table 'a) + (pass-if-exception "key not found" + '(misc-error . "^Key not in table") + (hashtable-ref table 'a)) + (pass-if-equal 'b (hashtable-ref table 'a 'b)) + (pass-if (not (hashtable-contains? table 'a))) + (pass-if-equal 0 (hashtable-size table)))))) + + (with-test-prefix "advanced" + (let ((table (make-eq-hashtable))) + (with-test-prefix "lookup" + (receive (x found?) (hashtable-lookup table 'a) + (pass-if (not found?)))) + (with-test-prefix "update" + (pass-if-exception "key not found" + '(misc-error . "^Key not in table") + (hashtable-update! table 'a (lambda (x) (+ x 1)))) + (hashtable-update! table 'a (lambda (x) (+ x 1)) 0) + (receive (x found?) (hashtable-lookup table 'a) + (pass-if-equal 1 x) + (pass-if found?)) + (hashtable-update! table 'a (lambda (x) (+ x 1))) + (receive (x found?) (hashtable-lookup table 'a) + (pass-if-equal x 2) + (pass-if found?)) + (hashtable-update! table 'a (lambda (x) (+ x 1)) 0) + (receive (x found?) (hashtable-lookup table 'a) + (pass-if-equal x 3) + (pass-if found?))) + (with-test-prefix "intern" + (pass-if-equal 0 (hashtable-intern! table 'b (lambda () 0))) + (pass-if-equal 0 (hashtable-intern! table 'b (lambda () 1)))))) + + (with-test-prefix "copy/clear" + (let ((table (alist->hashtable equal-hash equal? #f weakness '((a . b))))) + (with-test-prefix "copy" + (let ((table2 (hashtable-copy table))) + (pass-if-equal equal-hash (hashtable-hash-function table2)) + (pass-if-equal equal? (hashtable-equivalence-function table2)) + (pass-if-equal 'b (hashtable-ref table2 'a)) + (pass-if-equal weakness (hashtable-weakness table2)) + (pass-if-exception "set! immutable table" + '(misc-error . "^Hash table is not mutable") + (hashtable-set! table2 'a 'c))) + (let ((table2 (hashtable-copy table #f))) + (pass-if-equal equal-hash (hashtable-hash-function table2)) + (pass-if-equal equal? (hashtable-equivalence-function table2)) + (pass-if-equal 'b (hashtable-ref table2 'a)) + (pass-if-equal weakness (hashtable-weakness table2)) + (pass-if-exception "set! immutable table" + '(misc-error . "^Hash table is not mutable") + (hashtable-set! table2 'a 'c))) + (let ((table2 (hashtable-copy table #t))) + (pass-if-equal equal-hash (hashtable-hash-function table2)) + (pass-if-equal equal? (hashtable-equivalence-function table2)) + (pass-if-equal 'b (hashtable-ref table2 'a)) + (pass-if-equal weakness (hashtable-weakness table2)) + (hashtable-set! table2 'a 'c) + (pass-if-equal 'c (hashtable-ref table2 'a))) + (let ((table2 (hashtable-copy table #f #f))) + (pass-if-equal equal-hash (hashtable-hash-function table2)) + (pass-if-equal equal? (hashtable-equivalence-function table2)) + (pass-if-equal #f (hashtable-weakness table2)))) + + (with-test-prefix "clear" + (let ((table2 (hashtable-copy table #t))) + (hashtable-clear! table2) + (pass-if-equal 0 (hashtable-size table2))) + (let ((table2 (hashtable-copy table #t))) + (hashtable-clear! table2 10) + (pass-if-equal 0 (hashtable-size table2)))) + + (with-test-prefix "empty-copy" + (let ((table2 (hashtable-empty-copy table))) + (pass-if-equal equal-hash (hashtable-hash-function table2)) + (pass-if-equal equal? (hashtable-equivalence-function table2)) + (pass-if-equal 0 (hashtable-size table2))) + (let ((table2 (hashtable-empty-copy table 10))) + (pass-if-equal equal-hash (hashtable-hash-function table2)) + (pass-if-equal equal? (hashtable-equivalence-function table2)) + (pass-if-equal 0 (hashtable-size table2)))))) + + (with-test-prefix "keys/values" + (let ((table (alist->eq-hashtable '((a . b) (c . d))))) + (pass-if (lset= eq? '(a c) (vector->list (hashtable-keys table)))) + (pass-if (lset= eq? '(b d) (vector->list (hashtable-values table)))) + (receive (keys values) (hashtable-entries table) + (pass-if (lset= eq? '(a c) (vector->list keys))) + (pass-if (lset= eq? '(b d) (vector->list values)))) + (pass-if (lset= eq? '(a c) (hashtable-key-list table))) + (pass-if (lset= eq? '(b d) (hashtable-value-list table))) + (receive (keys values) (hashtable-entry-lists table) + (pass-if (lset= eq? '(a c) keys)) + (pass-if (lset= eq? '(b d) values))))) + + (with-test-prefix "iteration" + (with-test-prefix "walk" + (let ((keys '()) + (values '())) + (hashtable-walk (alist->eq-hashtable '((a . b) (c . d))) + (lambda (k v) + (set! keys (cons k keys)) + (set! values (cons v values)))) + (pass-if (lset= eq? '(a c) keys)) + (pass-if (lset= eq? '(b d) values)))) + + (with-test-prefix "update-all" + (let ((table (alist->eq-hashtable '((a . b) (c . d))))) + (hashtable-update-all! table + (lambda (k v) + (string->symbol (string-append (symbol->string v) "x")))) + (pass-if (lset= eq? '(a c) (hashtable-key-list table))) + (pass-if (lset= eq? '(bx dx) (hashtable-value-list table))))) + + (with-test-prefix "prune" + (let ((table (alist->eq-hashtable '((a . b) (c . d))))) + (hashtable-prune! table (lambda (k v) (eq? k 'a))) + (pass-if (not (hashtable-contains? table 'a))) + (pass-if (hashtable-contains? table 'c)))) + + (with-test-prefix "merge" + (let ((table (alist->eq-hashtable '((a . b) (c . d)))) + (table2 (alist->eq-hashtable '((a . x) (e . f))))) + (hashtable-merge! table table2) + (pass-if (lset= eq? '(a c e) (hashtable-key-list table))) + (pass-if (lset= eq? '(x d f) (hashtable-value-list table))))) + + (with-test-prefix "sum" + (let ((table (alist->eq-hashtable '((a . b) (c . d))))) + (pass-if (lset= eq? '(a b c d) + (hashtable-sum table '() + (lambda (k v acc) + (lset-adjoin eq? acc k v))))))) + + (with-test-prefix "map->lset" + (let ((table (alist->eq-hashtable '((a . b) (c . d))))) + (pass-if (lset= equal? '((a . b) (c . d)) + (hashtable-map->lset table cons))))) + + (with-test-prefix "find" + (let ((table (alist->eq-hashtable '((a . b) (c . d))))) + (receive (k v f?) (hashtable-find table + (lambda (k v) + (eq? k 'a))) + (pass-if (and f? (eq? k 'a) (eq? v 'b)))) + (receive (k v f?) (hashtable-find table (lambda (k v) #f)) + (pass-if (not f?))))) + + (with-test-prefix "misc" + + (with-test-prefix "empty?" + (pass-if (hashtable-empty? (alist->eq-hashtable '()))) + (pass-if (not (hashtable-empty? (alist->eq-hashtable '((a . b))))))) + + (with-test-prefix "pop!" + (pass-if-exception "" + '(misc-error . "^Hash table is empty") + (hashtable-pop! (make-eq-hashtable))) + (let ((table (alist->eq-hashtable '((a . b))))) + (receive (k v) (hashtable-pop! table) + (pass-if-equal 'a k) + (pass-if-equal 'b v) + (pass-if (hashtable-empty? table))))) + + (with-test-prefix "inc!" + (let ((table (alist->eq-hashtable '((a . 0))))) + (hashtable-inc! table 'a) + (pass-if-equal 1 (hashtable-ref table 'a)) + (hashtable-inc! table 'a 2) + (pass-if-equal 3 (hashtable-ref table 'a)))) + + (with-test-prefix "dec!" + (let ((table (alist->eq-hashtable '((a . 0))))) + (hashtable-dec! table 'a) + (pass-if-equal -1 (hashtable-ref table 'a)) + (hashtable-dec! table 'a 2) + (pass-if-equal -3 (hashtable-ref table 'a)))))) + + (with-test-prefix "hashing" + (pass-if (exact-integer? (hash-salt))) + (pass-if (not (negative? (hash-salt)))) + (pass-if (= (hash-salt) (hash-salt))) + (pass-if (= (equal-hash (list "foo" 'bar 42)) + (equal-hash (list "foo" 'bar 42)))) + (pass-if (= (string-hash (string-copy "foo")) + (string-hash (string-copy "foo")))) + (pass-if (= (string-ci-hash (string-copy "foo")) + (string-ci-hash (string-copy "FOO")))) + (pass-if (= (symbol-hash (string->symbol "foo")) + (symbol-hash (string->symbol "foo"))))) + ) + ) -- 2.19.1