source: trunk/source/tests/ansi-tests/gethash.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Nov 28 06:05:21 2003
4;;;; Contains: Tests of GETHASH
5
6(in-package :cl-test)
7
8;;; Most testing of GETHASH is in test-hash-table-1 in hash-table-aux.lsp
9
10(deftest gethash.1
11  (gethash 'x (make-hash-table) 'y)
12  y nil)
13
14(deftest gethash.2
15  (gethash nil (make-hash-table) 'a)
16  a nil)
17
18(deftest gethash.3
19  (gethash nil (make-hash-table) 'a)
20  a nil)
21
22(deftest gethash.4
23  (multiple-value-bind (value present)
24      (gethash 'a (let ((table (make-hash-table)))
25                    (setf (gethash 'a table) 'b)
26                    table))
27    (values value (notnot present)))
28  b t)
29
30(deftest gethash.5
31  (let ((table (make-hash-table))
32        (i 0))
33    (values
34     (setf (gethash 'x table (incf i)) 'y)
35     i
36     (gethash 'x table)))
37  y 1 y)
38
39(deftest gethash.order.1
40  (let ((i 0) x y
41        (table (make-hash-table)))
42    (setf (gethash 'a table) 'b)
43    (values
44     (gethash (progn (setf x (incf i)) 'a)
45              (progn (setf y (incf i)) table))
46     i x y))
47  b 2 1 2)
48
49(deftest gethash.order.2
50  (let ((i 0) x y z
51        (table (make-hash-table)))
52    (setf (gethash 'a table) 'b)
53    (values
54     (gethash (progn (setf x (incf i)) 'a)
55              (progn (setf y (incf i)) table)
56              (progn (setf z (incf i)) 'missing))
57     i x y z))
58  b 3 1 2 3)
59
60(deftest gethash.order.3
61  (let ((i 0) x y
62        (table (make-hash-table)))
63    (values
64      (setf (gethash (progn (setf x (incf i)) 'a)
65                     (progn (setf y (incf i)) table))
66            'b)
67      i x y
68      (gethash 'a table)))
69  b 2 1 2 b)
70
71(deftest gethash.order.4
72  (let ((i 0) x y z
73        (table (make-hash-table)))
74    (values
75      (setf (gethash (progn (setf x (incf i)) 'a)
76                     (progn (setf y (incf i)) table)
77                     (setf z (incf i)))
78            'b)
79      i x y z
80      (gethash 'a table)))
81  b 3 1 2 3 b)
82
83
84;;; Tests for 0.0, -0.0 in hash tables
85
86(deftest gethash.zero.1
87  (loop for pz in '(0.0s0 0.0f0 0.0d0 0.0l0)
88        for nz = (- pz)
89        for result = (let ((table (make-hash-table :test 'eq)))
90                       (list
91                        (setf (gethash pz table) :x)
92                        (gethash pz table)
93                        (gethash nz table)
94                        (setf (gethash nz table) :y)
95                        (gethash pz table)
96                        (gethash nz table)))
97        unless (or (eql pz nz)
98                   (equal result '(:x :x nil :y :x :y)))
99        collect (list pz nz result))
100  nil)
101
102(deftest gethash.zero.2
103  (loop for pz in '(0.0s0 0.0f0 0.0d0 0.0l0)
104        for nz = (- pz)
105        for result = (let ((table (make-hash-table :test 'eql)))
106                       (list
107                        (setf (gethash pz table) :x)
108                        (gethash pz table)
109                        (gethash nz table)
110                        (setf (gethash nz table) :y)
111                        (gethash pz table)
112                        (gethash nz table)))
113        unless (or (eql pz nz)
114                   (equal result '(:x :x nil :y :x :y)))
115        collect (list pz nz result))
116  nil)
117
118(deftest gethash.zero.3
119  (loop for pz in '(0.0s0 0.0f0 0.0d0 0.0l0)
120        for nz = (- pz)
121        for result = (let ((table (make-hash-table :test 'equal)))
122                       (list
123                        (setf (gethash pz table) :x)
124                        (gethash pz table)
125                        (gethash nz table)
126                        (setf (gethash nz table) :y)
127                        (gethash pz table)
128                        (gethash nz table)))
129        unless (or (eql pz nz)
130                   (equal result '(:x :x nil :y :x :y)))
131        collect (list pz nz result))
132  nil)
133
134(deftest gethash.zero.4
135  (loop for pz in '(0.0s0 0.0f0 0.0d0 0.0l0)
136        for nz = (- pz)
137        for result = (let ((table (make-hash-table :test 'equalp)))
138                       (list
139                        (setf (gethash pz table) :x)
140                        (gethash pz table)
141                        (gethash nz table)
142                        (setf (gethash nz table) :y)
143                        (gethash pz table)
144                        (gethash nz table)))
145        unless (or (eql pz nz)
146                   (equal result '(:x :x :x :y :y :y)))
147        collect (list pz nz result))
148  nil)
149
150;;;; Error tests
151
152(deftest gethash.error.1
153  (signals-error (gethash) program-error)
154  t)
155
156(deftest gethash.error.2
157  (signals-error (gethash 'foo) program-error)
158  t)
159
160(deftest gethash.error.3
161  (signals-error (gethash 'foo (make-hash-table) nil nil) program-error)
162  t)
Note: See TracBrowser for help on using the repository browser.