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