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