source: trunk/source/tests/ansi-tests/subst.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:37:56 2003
4;;;; Contains: Tests of SUBST
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(defvar *subst-tree-1* '(10 (30 20 10) (20 10) (10 20 30 40)))
11
12(deftest subst.1
13  (check-subst "Z" 30 (copy-tree *subst-tree-1*))
14  (10 ("Z" 20 10) (20 10) (10 20 "Z" 40)))
15
16(deftest subst.2
17  (check-subst "A" 0 (copy-tree *subst-tree-1*))
18  (10 (30 20 10) (20 10) (10 20 30 40)))
19
20(deftest subst.3
21  (check-subst "Z" 100 (copy-tree *subst-tree-1*) :test-not #'eql)
22  "Z")
23
24(deftest subst.4
25  (check-subst 'grape 'dick
26               '(melville wrote (moby dick)))
27  (melville wrote (moby grape)))
28
29(deftest subst.5
30  (check-subst 'cha-cha-cha 'nil '(melville wrote (moby dick)))
31  (melville wrote (moby dick . cha-cha-cha) . cha-cha-cha))
32
33(deftest subst.6
34  (check-subst
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 subst.7
41  (check-subst
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 subst.8
51  (check-subst
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 subst.9
61  (check-subst 'a 'b
62               (copy-tree '(a b c d a b))
63               :key nil)
64  (a a c d a a))
65
66(deftest subst.10
67  (check-subst '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 subst.11
72  (check-subst '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 subset.test-and-test-not.1
78  (subst 'a 'b (list 'a 'b 'c 'd 'e) :test #'eq :test-not #'eq))
79
80(defharmless subset.test-and-test-not.2
81  (subst 'a 'b (list 'a 'b 'c 'd 'e) :test-not #'eq :test #'eq))
82
83
84;;; Order of argument evaluation
85(deftest subst.order.1
86  (let ((i 0) v w x y z)
87    (values
88     (subst (progn (setf v (incf i)) 'b)
89            (progn (setf w (incf i)) 'a)
90            (progn (setf x (incf i)) (copy-tree '((10 a . a) a b c ((a)) z)))
91            :key (progn (setf y (incf i)) #'identity)
92            :test (progn (setf z (incf i)) #'eql))
93     i v w x y z))
94  ((10 b . b) b b c ((b)) z)
95  5 1 2 3 4 5)
96
97(deftest subst.order.2
98  (let ((i 0) v w x y z)
99    (values
100     (subst (progn (setf v (incf i)) 'b)
101            (progn (setf w (incf i)) 'a)
102            (progn (setf x (incf i)) (copy-tree '((10 a . a) a b c ((a)) z)))
103            :test-not (progn (setf y (incf i)) (complement #'eql))
104            :key (progn (setf z (incf i)) #'identity)
105            )
106     i v w x y z))
107  ((10 b . b) b b c ((b)) z)
108  5 1 2 3 4 5)
109
110;;; Const fold tests
111
112(def-fold-test subst.fold.1 (subst 'a 'b '(a b c (a . b) . a)))
113
114;;; Keyword tests for subst
115
116(deftest subst.allow-other-keys.1
117  (subst 'a 'b (list 'a 'b 'c) :bad t :allow-other-keys t)
118  (a a c))
119
120(deftest subst.allow-other-keys.2
121  (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t)
122  (a a c))
123
124(deftest subst.allow-other-keys.3
125  (subst 'a 'b (list 'a 'b 'c) :allow-other-keys nil)
126  (a a c))
127
128(deftest subst.allow-other-keys.4
129  (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t :bad t)
130  (a a c))
131
132(deftest subst.allow-other-keys.5
133  (subst 'a 'b (list 'a 'b 'c) :allow-other-keys t :allow-other-keys nil
134         :bad t)
135  (a a c))
136
137(deftest subst.keywords.6
138  (subst 'a 'b (list 'a 'b 'c) :test #'eq :test (complement #'eq))
139  (a a c))
140
141(deftest subst.error.1
142  (signals-error (subst) program-error)
143  t)
144
145(deftest subst.error.2
146  (signals-error (subst 'a) program-error)
147  t)
148
149(deftest subst.error.3
150  (signals-error (subst 'a 'b) program-error)
151  t)
152
153(deftest subst.error.4
154  (signals-error (subst 'a 'b nil :foo nil) program-error)
155  t)
156
157(deftest subst.error.5
158  (signals-error (subst 'a 'b nil :test) program-error)
159  t)
160
161(deftest subst.error.6
162  (signals-error (subst 'a 'b nil 1) program-error)
163  t)
164
165(deftest subst.error.7
166  (signals-error (subst 'a 'b nil :bad t :allow-other-keys nil) program-error)
167  t)
168
169(deftest subst.error.8
170  (signals-error (subst 'a 'b (list 'a 'b) :test #'identity) program-error)
171  t)
172
173(deftest subst.error.9
174  (signals-error (subst 'a 'b (list 'a 'b) :test-not #'identity) program-error)
175  t)
176
177(deftest subst.error.10
178  (signals-error (subst 'a 'b (list 'a 'b) :key #'equal) program-error)
179  t)
Note: See TracBrowser for help on using the repository browser.