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

Last change on this file since 8991 was 8991, checked in by gz, 12 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 09:36:58 2003
4;;;; Contains: Test of MAPHASH
5
6(in-package :cl-test)
7
8(deftest maphash.1
9  (let ((table (make-hash-table)))
10    (loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
11    (let ((s1 0) (s2 0))
12      (values
13       (multiple-value-list
14        (maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
15       s1 s2)))
16  (nil) #.(* 500 1001) #.(* 1000 1001))
17
18(deftest maphash.2
19  (let ((table (make-hash-table :test 'equal)))
20    (loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
21    (let ((s1 0) (s2 0))
22      (values
23       (multiple-value-list
24        (maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
25       s1 s2)))
26  (nil) #.(* 500 1001) #.(* 1000 1001))
27
28(deftest maphash.3
29  (let ((table (make-hash-table :test 'equalp)))
30    (loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
31    (let ((s1 0) (s2 0))
32      (values
33       (multiple-value-list
34        (maphash #'(lambda (k v) (incf s1 k) (incf s2 v)) table))
35       s1 s2)))
36  (nil) #.(* 500 1001) #.(* 1000 1001))
37
38;;; Test that REMHASH on the key being traversed is allowed
39
40(deftest maphash.4
41  (let ((table (make-hash-table)))
42    (loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
43    (let ((s1 0) (s2 0))
44      (values
45       (multiple-value-list
46        (maphash #'(lambda (k v)
47                     (incf s1 k) (incf s2 v)
48                     (remhash k table))
49                 table))
50       s1 s2 (hash-table-count table))))
51  (nil) #.(* 500 1001) #.(* 1000 1001) 0)
52
53(deftest maphash.5
54  (let ((table (make-hash-table :test 'equal)))
55    (loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
56    (let ((s1 0) (s2 0))
57      (values
58       (multiple-value-list
59        (maphash #'(lambda (k v)
60                     (incf s1 k) (incf s2 v)
61                     (remhash k table))
62                 table))
63       s1 s2 (hash-table-count table))))
64  (nil) #.(* 500 1001) #.(* 1000 1001) 0)
65
66(deftest maphash.6
67  (let ((table (make-hash-table :test 'equalp)))
68    (loop for i from 1 to 1000 do (setf (gethash i table) (+ i i)))
69    (let ((s1 0) (s2 0))
70      (values
71       (multiple-value-list
72        (maphash #'(lambda (k v)
73                     (incf s1 k) (incf s2 v)
74                     (remhash k table))
75                 table))
76       s1 s2 (hash-table-count table))))
77  (nil) #.(* 500 1001) #.(* 1000 1001) 0)
78
79
80;;; EQ hash tables
81
82(deftest maphash.7
83  (let ((symbols '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
84        (table (make-hash-table :test #'eq)))
85    (loop for sym in symbols
86          for i from 1
87          do (setf (gethash sym table) i))
88    (let ((sum 0))
89      (values
90       (multiple-value-list
91        (maphash #'(lambda (k v)
92                     (assert (eq (elt symbols (1- v)) k))
93                     (incf sum v))
94                 table))
95       sum)))
96  (nil) #.(* 13 27))
97
98(deftest maphash.8
99  (let ((symbols '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
100        (table (make-hash-table :test #'eq)))
101    (loop for sym in symbols
102          for i from 1
103          do (setf (gethash sym table) i))
104    (let ((sum 0))
105      (values
106       (multiple-value-list
107        (maphash #'(lambda (k v)
108                     (assert (eq (elt symbols (1- v)) k))
109                     (remhash k table)
110                     (incf sum v))
111                 table))
112       sum
113       (hash-table-count table))))
114  (nil) #.(* 13 27) 0)
115
116;;; Need to add tests where things are setf'd during traversal
117
118(deftest maphash.order.1
119  (let ((i 0) x y dummy
120        (table (make-hash-table)))
121    (values
122     (multiple-value-list
123      (maphash (progn (setf x (incf i))
124                      #'(lambda (k v) (setf dummy (list k v))))
125               (progn (setf y (incf i))
126                      table)))
127     i x y dummy))
128  (nil) 2 1 2 nil)
129   
130
131;;; Error tests
132
133(deftest maphash.error.1
134  (signals-error (maphash) program-error)
135  t)
136
137(deftest maphash.error.2
138  (signals-error (maphash #'list) program-error)
139  t)
140
141(deftest maphash.error.3
142  (signals-error (maphash #'list (make-hash-table) nil) program-error)
143  t)
Note: See TracBrowser for help on using the repository browser.