source: trunk/source/tests/ansi-tests/with-hash-table-iterator.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: 4.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Nov 28 20:08:43 2003
4;;;; Contains: Tests of WITH-HASH-TABLE-ITERATOR
5
6(in-package :cl-test)
7
8(deftest with-hash-table-iterator.1
9  (with-hash-table-iterator (x (make-hash-table)))
10  nil)
11
12(deftest with-hash-table-iterator.2
13  (with-hash-table-iterator (x (make-hash-table)) (values)))
14
15(deftest with-hash-table-iterator.3
16  (with-hash-table-iterator (x (make-hash-table)) (values 'a 'b 'c 'd))
17  a b c d)
18
19(deftest with-hash-table-iterator.4
20  (with-hash-table-iterator
21   (%x (make-hash-table))
22   (%x))
23  nil)
24
25(deftest with-hash-table-iterator.5
26  (let ((table (make-hash-table)))
27    (setf (gethash 'a table) 'b)
28    (with-hash-table-iterator
29     (%x table)
30     (multiple-value-bind (success-p key val)
31         (%x)
32       (values (notnot success-p) key val))))
33  t a b)
34
35(deftest with-hash-table-iterator.6
36  (let ((table (make-hash-table)))
37    (setf (gethash 'a table) 'b)
38    (with-hash-table-iterator
39     (%x table)
40     (length (multiple-value-list (%x)))))
41  3)
42
43(deftest with-hash-table-iterator.7
44  (let ((keys '("a" "b" "c" "d" "e")))
45    (loop for test in '(eq eql equal equalp)
46          for test-fn of-type function = (symbol-function test)
47          collect
48          (let ((table (make-hash-table :test test)))
49            (loop for k in keys
50                  for i from 0
51                  do (setf (gethash k table) i))
52            (let ((count 0) (found-keys))
53              (with-hash-table-iterator
54               (%x table)
55               (block done
56                 (loop
57                  (multiple-value-bind (success key val)
58                      (%x)
59                    (unless success (return-from done nil))
60                    (incf count)
61                    (push key found-keys)
62                    (assert (= val (position key keys :test test-fn))))))
63               (and (= count (length keys))
64                    (every test-fn
65                           (sort (remove-duplicates found-keys :test test)
66                                 #'string<)
67                           keys)
68                    t))))))
69  (t t t t))
70
71(deftest with-hash-table-iterator.8
72  (with-hash-table-iterator
73   (%x (make-hash-table))
74   (declare (optimize)))
75  nil)
76
77(deftest with-hash-table-iterator.8a
78  (with-hash-table-iterator
79   (%x (make-hash-table))
80   (declare (optimize))
81   (declare (optimize)))
82  nil)
83
84(deftest with-hash-table-iterator.9
85  (with-hash-table-iterator
86   (%x (make-hash-table))
87   (macrolet
88       ((expand-%x
89         (&environment env)
90         (let ((expanded-form (macroexpand '(%x) env)))
91           (if (equal expanded-form '(%x)) nil t))))
92     (expand-%x)))
93  t)
94
95(deftest with-hash-table-iterator.10
96  (let ((table (make-hash-table)))
97    (loop for key from 1 to 100
98          for val from 101 to 200
99          do (setf (gethash key table) val))
100    (let ((pairs nil))
101      (with-hash-table-iterator
102       (%x table)
103       (loop
104        (multiple-value-bind (success key val)
105            (%x)
106          (unless success (return nil))
107          (remhash key table)
108          (push (cons key val) pairs))))
109      (assert (eql (length pairs) 100))
110      (setq pairs (sort pairs #'(lambda (p1 p2) (< (car p1) (car p2)))))
111      (values
112       (hash-table-count table)
113       (loop
114        for (key . val) in pairs
115        for expected-key from 1
116        for expected-val from 101
117        always (and (eql key expected-key)
118                    (eql val expected-val))))))
119  0 t)
120
121(deftest with-hash-table-iterator.11
122  (let ((table (make-hash-table)))
123    (loop for key from 1 to 100
124          for val from 101 to 200
125          do (setf (gethash key table) val))
126    (let ((pairs nil))
127      (with-hash-table-iterator
128       (%x table)
129       (loop
130        (multiple-value-bind (success key val)
131            (%x)
132          (unless success (return nil))
133          (setf (gethash key table) (+ 1000 val))
134          (push (cons key val) pairs))))
135      (assert (eql (length pairs) 100))
136      (setq pairs (sort pairs #'(lambda (p1 p2) (< (car p1) (car p2)))))
137      (values
138       (hash-table-count table)
139       (loop
140        for (key . val) in pairs
141        for expected-key from 1
142        for expected-val from 101
143        always (and (eql key expected-key)
144                    (eql val expected-val)
145                    (eql (gethash key table) (+ 1000 val))
146                    )))))
147  100 t)
148
149;;; Free declaration scope
150
151(deftest with-hash-table-iterator.12
152  (block done
153    (let ((x :bad))
154      (declare (special x))
155      (let ((x :good))
156        (with-hash-table-iterator (m (return-from done x))
157                                  (declare (special x))))))
158  :good)
Note: See TracBrowser for help on using the repository browser.