1 ;;;; hash.test --- test guile hashing -*- scheme -*-
3 ;;;; Copyright (C) 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
5 ;;;; This library is free software; you can redistribute it and/or
6 ;;;; modify it under the terms of the GNU Lesser General Public
7 ;;;; License as published by the Free Software Foundation; either
8 ;;;; version 2.1 of the License, or (at your option) any later version.
10 ;;;; This library is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;;;; Lesser General Public License for more details.
15 ;;;; You should have received a copy of the GNU Lesser General Public
16 ;;;; License along with this library; if not, write to the Free Software
17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 (define-module (test-suite test-numbers)
20 #:use-module (test-suite lib)
21 #:use-module (ice-9 documentation))
27 (with-test-prefix "hash"
28 (pass-if (->bool (object-documentation hash)))
29 (pass-if-exception "hash #t -1" exception:out-of-range
31 (pass-if-exception "hash #t 0" exception:out-of-range
33 (pass-if (= 0 (hash #t 1)))
34 (pass-if (= 0 (hash #f 1)))
35 (pass-if (= 0 (hash noop 1))))
41 (with-test-prefix "hashv"
42 (pass-if (->bool (object-documentation hashv)))
43 (pass-if-exception "hashv #t -1" exception:out-of-range
45 (pass-if-exception "hashv #t 0" exception:out-of-range
47 (pass-if (= 0 (hashv #t 1)))
48 (pass-if (= 0 (hashv #f 1)))
49 (pass-if (= 0 (hashv noop 1))))
55 (with-test-prefix "hashq"
56 (pass-if (->bool (object-documentation hashq)))
57 (pass-if-exception "hashq #t -1" exception:out-of-range
59 (pass-if-exception "hashq #t 0" exception:out-of-range
61 (pass-if (= 0 (hashq #t 1)))
62 (pass-if (= 0 (hashq #f 1)))
63 (pass-if (= 0 (hashq noop 1))))
70 "make-hash-table, hash-table?"
71 (pass-if-exception "make-hash-table -1" exception:out-of-range
73 (pass-if (hash-table? (make-hash-table 0))) ;; default
74 (pass-if (not (hash-table? 'not-a-hash-table)))
75 (pass-if (equal? "#<hash-table 0/113>"
76 (with-output-to-string
77 (lambda () (write (make-hash-table 100)))))))
80 ;;; usual set and reference
84 "hash-set and hash-ref"
87 (pass-if (let ((table (make-hash-table 1))) ;;actually makes size 31
88 (hash-set! table 'one 1)
89 (hash-set! table 'two #t)
90 (hash-set! table 'three #t)
91 (hash-set! table 'four #t)
92 (hash-set! table 'five #t)
93 (hash-set! table 'six #t)
94 (hash-set! table 'seven #t)
95 (hash-set! table 'eight #t)
96 (hash-set! table 'nine 9)
97 (hash-set! table 'ten #t)
98 (hash-set! table 'eleven #t)
99 (hash-set! table 'twelve #t)
100 (hash-set! table 'thirteen #t)
101 (hash-set! table 'fourteen #t)
102 (hash-set! table 'fifteen #t)
103 (hash-set! table 'sixteen #t)
104 (hash-set! table 'seventeen #t)
105 (hash-set! table 18 #t)
106 (hash-set! table 19 #t)
107 (hash-set! table 20 #t)
108 (hash-set! table 21 #t)
109 (hash-set! table 22 #t)
110 (hash-set! table 23 #t)
111 (hash-set! table 24 #t)
112 (hash-set! table 25 #t)
113 (hash-set! table 26 #t)
114 (hash-set! table 27 #t)
115 (hash-set! table 28 #t)
116 (hash-set! table 29 #t)
117 (hash-set! table 30 'thirty)
118 (hash-set! table 31 #t)
119 (hash-set! table 32 #t)
120 (hash-set! table 33 'thirty-three)
121 (hash-set! table 34 #t)
122 (hash-set! table 35 #t)
123 (hash-set! table 'foo 'bar)
124 (and (equal? 1 (hash-ref table 'one))
125 (equal? 9 (hash-ref table 'nine))
126 (equal? 'thirty (hash-ref table 30))
127 (equal? 'thirty-three (hash-ref table 33))
128 (equal? 'bar (hash-ref table 'foo))
129 (equal? "#<hash-table 36/61>"
130 (with-output-to-string (lambda () (write table)))))))
132 ;; 1 and 1 are equal? and eqv? and eq?
133 (pass-if (equal? 'foo
134 (let ((table (make-hash-table)))
135 (hash-set! table 1 'foo)
136 (hash-ref table 1))))
137 (pass-if (equal? 'foo
138 (let ((table (make-hash-table)))
139 (hashv-set! table 1 'foo)
140 (hashv-ref table 1))))
141 (pass-if (equal? 'foo
142 (let ((table (make-hash-table)))
143 (hashq-set! table 1 'foo)
144 (hashq-ref table 1))))
146 ;; 1/2 and 2/4 are equal? and eqv? but not eq?
147 (pass-if (equal? 'foo
148 (let ((table (make-hash-table)))
149 (hash-set! table 1/2 'foo)
150 (hash-ref table 2/4))))
151 (pass-if (equal? 'foo
152 (let ((table (make-hash-table)))
153 (hashv-set! table 1/2 'foo)
154 (hashv-ref table 2/4))))
156 (let ((table (make-hash-table)))
157 (hashq-set! table 1/2 'foo)
158 (hashq-ref table 2/4))))
160 ;; (list 1 2) is equal? but not eqv? or eq? to another (list 1 2)
161 (pass-if (equal? 'foo
162 (let ((table (make-hash-table)))
163 (hash-set! table (list 1 2) 'foo)
164 (hash-ref table (list 1 2)))))
166 (let ((table (make-hash-table)))
167 (hashv-set! table (list 1 2) 'foo)
168 (hashv-ref table (list 1 2)))))
170 (let ((table (make-hash-table)))
171 (hashq-set! table (list 1 2) 'foo)
172 (hashq-ref table (list 1 2)))))
174 ;; ref default argument
175 (pass-if (equal? 'bar
176 (let ((table (make-hash-table)))
177 (hash-ref table 'foo 'bar))))
178 (pass-if (equal? 'bar
179 (let ((table (make-hash-table)))
180 (hashv-ref table 'foo 'bar))))
181 (pass-if (equal? 'bar
182 (let ((table (make-hash-table)))
183 (hashq-ref table 'foo 'bar))))
184 (pass-if (equal? 'bar
185 (let ((table (make-hash-table)))
186 (hashx-ref hash equal? table 'foo 'bar))))
188 ;; wrong type argument
189 (pass-if-exception "(hash-ref 'not-a-table 'key)" exception:wrong-type-arg
190 (hash-ref 'not-a-table 'key))
198 "auto-resizing hashx"
200 (let ((table (make-hash-table 1))) ;;actually makes size 31
201 (hashx-set! hash assoc table 1/2 'equal)
202 (hashx-set! hash assoc table 1/3 'equal)
203 (hashx-set! hash assoc table 4 'equal)
204 (hashx-set! hash assoc table 1/5 'equal)
205 (hashx-set! hash assoc table 1/6 'equal)
206 (hashx-set! hash assoc table 7 'equal)
207 (hashx-set! hash assoc table 1/8 'equal)
208 (hashx-set! hash assoc table 1/9 'equal)
209 (hashx-set! hash assoc table 10 'equal)
210 (hashx-set! hash assoc table 1/11 'equal)
211 (hashx-set! hash assoc table 1/12 'equal)
212 (hashx-set! hash assoc table 13 'equal)
213 (hashx-set! hash assoc table 1/14 'equal)
214 (hashx-set! hash assoc table 1/15 'equal)
215 (hashx-set! hash assoc table 16 'equal)
216 (hashx-set! hash assoc table 1/17 'equal)
217 (hashx-set! hash assoc table 1/18 'equal)
218 (hashx-set! hash assoc table 19 'equal)
219 (hashx-set! hash assoc table 1/20 'equal)
220 (hashx-set! hash assoc table 1/21 'equal)
221 (hashx-set! hash assoc table 22 'equal)
222 (hashx-set! hash assoc table 1/23 'equal)
223 (hashx-set! hash assoc table 1/24 'equal)
224 (hashx-set! hash assoc table 25 'equal)
225 (hashx-set! hash assoc table 1/26 'equal)
226 (hashx-set! hash assoc table 1/27 'equal)
227 (hashx-set! hash assoc table 28 'equal)
228 (hashx-set! hash assoc table 1/29 'equal)
229 (hashx-set! hash assoc table 1/30 'equal)
230 (hashx-set! hash assoc table 31 'equal)
231 (hashx-set! hash assoc table 1/32 'equal)
232 (hashx-set! hash assoc table 1/33 'equal)
233 (hashx-set! hash assoc table 34 'equal)
234 (pass-if (equal? 'equal (hash-ref table 2/4)))
235 (pass-if (equal? 'equal (hash-ref table 2/6)))
236 (pass-if (equal? 'equal (hash-ref table 4)))
237 (pass-if (equal? 'equal (hashx-ref hash assoc table 2/64)))
238 (pass-if (equal? 'equal (hashx-ref hash assoc table 2/66)))
239 (pass-if (equal? 'equal (hashx-ref hash assoc table 34)))
240 (pass-if (equal? "#<hash-table 33/61>"
241 (with-output-to-string (lambda () (write table)))))))
245 (pass-if (let ((table (make-hash-table)))
246 (hashx-set! (lambda (k v) 1)
247 (lambda (k al) (assoc 'foo al))
250 'bar (hashx-ref (lambda (k v) 1)
251 (lambda (k al) (assoc 'foo al))
253 (pass-if (let ((table (make-hash-table 31)))
254 (hashx-set! (lambda (k v) 1) assoc table 'foo 'bar)
256 (hashx-ref (lambda (k v) 2) assoc table 'foo))))
257 (pass-if (let ((table (make-hash-table)))
258 (hashx-set! hash assoc table 'foo 'bar)
260 (hashx-ref hash (lambda (k al) #f) table 'foo))))
262 "hashx-set! (lambda (k s) 1) equal? table 'foo 'bar"
263 exception:wrong-type-arg ;; there must be a better exception than that...
264 (hashx-set! (lambda (k s) 1) (lambda (k al) #t) (make-hash-table) 'foo 'bar))
271 (with-test-prefix "hashx-remove!"
272 (pass-if (->bool (object-documentation hashx-remove!)))
274 (pass-if (let ((table (make-hash-table)))
275 (hashx-set! hashq assq table 'x 123)
276 (hashx-remove! hashq assq table 'x)
277 (null? (hash-map->list noop table)))))
283 (with-test-prefix "hashx"
285 "hashx-set! (lambda (k s) 1) (lambda (k al) #t) table 'foo 'bar"
286 exception:wrong-type-arg
287 (hashx-set! (lambda (k s) 1) (lambda (k al) #t) (make-hash-table) 'foo 'bar))