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