← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/maphash.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/maphash.lsp
 
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)