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