← Back to branch summary

~peter-pearse/ubuntu/natty/guile-1.8/prop001

« back to all changes in this revision

Viewing changes to test-suite/tests/hash.test

  • Committer: Bazaar Package Importer
  • Author(s): Steve Langasek
  • Date: 2009-06-04 19:01:38 UTC
  • mfrom: (8.1.1 sid)
  • Revision ID: james.westby@ubuntu.com-20090604190138-1ao3t6sj31cqvcfe
Tags: 1.8.6+1-1ubuntu1
* Merge from Debian unstable, remaining changes:
  - Build with -Wno-error.
  - Build with thread support. Some guile-using programs like autogen need it.
  - Add debian/guile-1.8-libs.shlibs: Thread support breaks ABI, bump the soname.
* Dropped changes:
  - libltdl3-dev -> libltdl7-dev: current libltdl-dev Provides: both.
  - debian/patches/libtool-ftbfs.diff: integrated upstream.

Show diffs side-by-side

added added

removed removed

Lines of Context:
test-suite/tests/hash.test
63
63
  (pass-if (= 0 (hashq noop 1))))
64
64
 
65
65
;;;
 
66
;;; make-hash-table
 
67
;;;
 
68
 
 
69
(with-test-prefix
 
70
 "make-hash-table, hash-table?"
 
71
 (pass-if-exception "make-hash-table -1" exception:out-of-range
 
72
                    (make-hash-table -1))
 
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)))))))
 
78
 
 
79
;;;
 
80
;;; usual set and reference
 
81
;;;
 
82
 
 
83
(with-test-prefix
 
84
 "hash-set and hash-ref"
 
85
 
 
86
 ;; auto-resizing
 
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)))))))
 
131
 
 
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))))
 
145
 
 
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))))
 
155
 (pass-if (equal? #f
 
156
                  (let ((table (make-hash-table)))
 
157
                    (hashq-set! table 1/2 'foo)
 
158
                    (hashq-ref table 2/4))))
 
159
 
 
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)))))
 
165
 (pass-if (equal? #f
 
166
                  (let ((table (make-hash-table)))
 
167
                    (hashv-set! table (list 1 2) 'foo)
 
168
                    (hashv-ref table (list 1 2)))))
 
169
 (pass-if (equal? #f
 
170
                  (let ((table (make-hash-table)))
 
171
                    (hashq-set! table (list 1 2) 'foo)
 
172
                    (hashq-ref table (list 1 2)))))
 
173
 
 
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))))
 
187
 
 
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))
 
191
 )
 
192
 
 
193
;;;
 
194
;;; hashx
 
195
;;;
 
196
 
 
197
(with-test-prefix
 
198
 "auto-resizing hashx"
 
199
 ;; auto-resizing
 
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)))))))
 
242
 
 
243
(with-test-prefix 
 
244
 "hashx"
 
245
 (pass-if (let ((table (make-hash-table)))
 
246
            (hashx-set! (lambda (k v) 1) 
 
247
                        (lambda (k al) (assoc 'foo al)) 
 
248
                        table 'foo 'bar)
 
249
            (equal? 
 
250
             'bar (hashx-ref (lambda (k v) 1) 
 
251
                             (lambda (k al) (assoc 'foo al)) 
 
252
                             table 'baz))))
 
253
 (pass-if (let ((table (make-hash-table 31)))
 
254
            (hashx-set! (lambda (k v) 1) assoc table 'foo 'bar)
 
255
            (equal? #f
 
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)
 
259
            (equal? #f 
 
260
                    (hashx-ref hash (lambda (k al) #f) table 'foo))))
 
261
 (pass-if-exception 
 
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))
 
265
 )
 
266
 
 
267
 
 
268
;;;
66
269
;;; hashx-remove!
67
270
;;;
68
271
(with-test-prefix "hashx-remove!"