source: trunk/source/tests/ansi-tests/assoc-if.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: 4.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Apr 20 07:27:57 2003
4;;;; Contains: Tests of ASSOC-IF
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest assoc-if.1
11    (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d))))
12           (xcopy (make-scaffold-copy x))
13           (result (assoc-if #'evenp x)))
14      (and
15       (check-scaffold-copy x xcopy)
16       (eqt result (third x))
17       result))
18  (6 . c))
19
20(deftest assoc-if.2
21  (let* ((x (copy-list '((1 . a) (3 . b) (6 . c) (7 . d))))
22         (xcopy (make-scaffold-copy x))
23         (result (assoc-if #'oddp x :key #'1+)))
24    (and
25     (check-scaffold-copy x xcopy)
26     (eqt result (third x))
27     result))
28  (6 . c))
29
30(deftest assoc-if.3
31    (let* ((x (copy-list '((1 . a) nil (3 . b) (6 . c) (7 . d))))
32           (xcopy (make-scaffold-copy x))
33           (result (assoc-if #'evenp x)))
34      (and
35       (check-scaffold-copy x xcopy)
36       (eqt result (fourth x))
37       result))
38  (6 . c))
39
40(deftest assoc-if.4
41  (assoc-if #'null '((a . b) nil (c . d) (nil . e) (f . g)))
42  (nil . e))
43
44(deftest assoc-if.5
45  (let () (assoc-if #'null '((a . b) nil (c . d) (nil . e) (f . g))))
46  (nil . e))
47
48
49;;; Order of argument evaluation
50
51(deftest assoc-if.order.1
52  (let ((i 0) x y)
53    (values
54     (assoc-if (progn (setf x (incf i)) #'null)
55               (progn (setf y (incf i))
56                      '((a . 1) (b . 2) (nil . 17) (d . 4))))
57     i x y))
58  (nil . 17) 2 1 2)
59
60(deftest assoc-if.order.2
61  (let ((i 0) x y z)
62    (values
63     (assoc-if (progn (setf x (incf i)) #'null)
64               (progn (setf y (incf i))
65                      '((a . 1) (b . 2) (nil . 17) (d . 4)))
66               :key (progn (setf z (incf i)) #'null))
67     i x y z))
68  (a . 1) 3 1 2 3)
69
70;;; Keyword tests
71
72(deftest assoc-if.allow-other-keys.1
73  (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :bad t :allow-other-keys t)
74  (nil . 2))
75
76(deftest assoc-if.allow-other-keys.2
77  (assoc-if #'null '((a . 1) (nil . 2) (c . 3))
78            :allow-other-keys t :also-bad t)
79  (nil . 2))
80
81(deftest assoc-if.allow-other-keys.3
82  (assoc-if #'null '((a . 1) (nil . 2) (c . 3))
83            :allow-other-keys t :also-bad t :key #'not)
84  (a . 1))
85
86(deftest assoc-if.allow-other-keys.4
87  (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :allow-other-keys t)
88  (nil . 2))
89
90(deftest assoc-if.allow-other-keys.5
91  (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :allow-other-keys nil)
92  (nil . 2))
93
94(deftest assoc-if.keywords.6
95  (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :key #'identity :key #'null)
96  (nil . 2))
97
98(deftest assoc-if.keywords.7
99  (assoc-if #'null '((a . 1) (nil . 2) (c . 3)) :key nil :key #'null)
100  (nil . 2))
101
102;;; Macro env tests
103
104(deftest assoc-if.env.1
105  (macrolet
106   ((%m (z) z))
107   (let ((alist '((1 . a) (3 . b) (6 . c) (8 . d) (-1 . e))))
108     (values
109      (assoc-if (expand-in-current-env (%m 'evenp)) alist)
110      (assoc-if (expand-in-current-env (%m #'evenp)) alist)
111      (assoc-if #'evenp (expand-in-current-env (%m alist)))
112      (assoc-if 'oddp alist (expand-in-current-env (%m :key)) '1+)
113      (assoc-if 'oddp alist :key (expand-in-current-env (%m #'1+)))
114      )))
115  (6 . c)
116  (6 . c)
117  (6 . c)
118  (6 . c)
119  (6 . c))     
120
121;;; Error cases
122
123(deftest assoc-if.error.1
124  (signals-error (assoc-if) program-error)
125  t)
126
127(deftest assoc-if.error.2
128  (signals-error (assoc-if #'null) program-error)
129  t)
130
131(deftest assoc-if.error.3
132  (signals-error (assoc-if #'null nil :bad t)
133                 program-error)
134  t)
135
136(deftest assoc-if.error.4
137  (signals-error (assoc-if #'null nil :key)
138                 program-error)
139  t)
140
141(deftest assoc-if.error.5
142  (signals-error (assoc-if #'null nil 1 1)
143                 program-error)
144  t)
145
146(deftest assoc-if.error.6
147  (signals-error (assoc-if #'null nil :bad t :allow-other-keys nil)
148                 program-error)
149  t)
150
151(deftest assoc-if.error.7
152  (signals-error (assoc-if #'cons '((a b)(c d)))
153                 program-error)
154  t)
155
156(deftest assoc-if.error.8
157  (signals-error (assoc-if #'identity '((a b)(c d)) :key #'cons)
158                 program-error)
159  t)
160
161(deftest assoc-if.error.9
162  (signals-type-error x 'a (assoc-if #'car '((a b)(c d))))
163  t)
164
165(deftest assoc-if.error.10
166  (signals-type-error x 'a (assoc-if #'identity '((a b)(c d)) :key #'car))
167  t)
168
169(deftest assoc-if.error.11
170  (signals-error (assoc-if #'null '((a . b) . c))
171                 type-error)
172  t)
173
174(deftest assoc-if.error.12
175  (signals-error (assoc-if #'null '((a . b) :bad (c . d)))
176                 type-error)
177  t)
178
179(deftest assoc-if.error.13
180  (signals-type-error x 'y (assoc-if #'null x))
181  t)
Note: See TracBrowser for help on using the repository browser.