source: trunk/source/tests/ansi-tests/sublis.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.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 19 21:32:50 2003
4;;;; Contains: Tests of SUBLIS
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest sublis.1
11  (check-sublis '((a b) g (d e 10 g h) 15 . g)
12                '((e . e2) (g . 17)))
13  ((a b) 17 (d e2 10 17 h) 15 . 17))
14
15(deftest sublis.2
16  (check-sublis '(f6 10 (f4 (f3 (f1 a b) (f1 a p)) (f2 a b)))
17                '(((f1 a b) . (f2 a b)) ((f2 a b) . (f1 a b)))
18                :test #'equal)
19  (f6 10 (f4 (f3 (f2 a b) (f1 a p)) (f1 a b))))
20
21(deftest sublis.3
22  (check-sublis '(10 ((10 20 (a b c) 30)) (((10 20 30 40))))
23                '((30 . "foo")))
24  (10 ((10 20 (a b c) "foo")) (((10 20 "foo" 40)))))
25
26(deftest sublis.4
27  (check-sublis (sublis
28                 (copy-tree '((a . 2) (b . 4) (c . 1)))
29                 (copy-tree '(a b c d e (a b c a d b) f)))
30                '((t . "yes"))
31                :key #'(lambda (x) (and (typep x 'integer)
32                                        (evenp x))))
33  ("yes" "yes" 1 d e ("yes" "yes" 1 "yes" d "yes") f))
34
35(deftest sublis.5
36  (check-sublis '("fee" (("fee" "Fie" "foo"))
37                  fie ("fee" "fie"))
38                `((,(copy-seq "fie") . #\f)))
39  ("fee" (("fee" "Fie" "foo")) fie ("fee" "fie")))
40
41(deftest sublis.6
42  (check-sublis '("fee" fie (("fee" "Fie" "foo") 1)
43                  ("fee" "fie"))
44                `((,(copy-seq "fie") . #\f))
45                :test 'equal)
46  ("fee" fie (("fee" "Fie" "foo") 1) ("fee" #\f)))
47
48(deftest sublis.7
49  (check-sublis '(("aa" a b)
50                  (z "bb" d)
51                  ((x . "aa")))
52                `((,(copy-seq "aa") . 1)
53                  (,(copy-seq "bb") . 2))
54                :test 'equal
55                :key #'(lambda (x) (if (consp x) (car x)
56                                     '*not-present*)))
57  (1 (z . 2) ((x . "aa"))))
58
59;; Check that a null key arg is ignored.
60
61(deftest sublis.8
62  (check-sublis
63   '(1 2 a b)
64   '((1 . 2) (a . b))
65   :key nil)
66  (2 2 b b))
67
68(deftest sublis.9
69  (check-sublis  (list 0 3 8 20)
70                 '((1 . x) (5 . y) (10 . z))
71                :test #'(lambda (x y) (and (realp x) (realp y) (< x y))))
72  (x y z 20))
73
74(deftest sublis.10
75  (check-sublis  (list 0 3 8 20)
76                 '((1 . x) (5 . y) (10 . z))
77                :test-not
78                #'(lambda (x y) (not (and (realp x) (realp y) (< x y)))))
79  (x y z 20))
80
81(defharmless sublis.test-and-test-not.1
82  (sublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd)
83           :test #'eql :test-not #'eql))
84
85(defharmless sublis.test-and-test-not.2
86  (sublis '((a . 1) (b . 2)) (list 'a 'b 'c 'd)
87           :test-not #'eql :test #'eql))
88
89;;; Order of argument evaluation
90(deftest sublis.order.1
91  (let ((i 0) w x y z)
92    (values
93     (sublis
94      (progn (setf w (incf i))
95             '((a . z)))
96      (progn (setf x (incf i))
97             (copy-tree '(a b c d)))
98      :test (progn (setf y (incf i)) #'eql)
99      :key (progn (setf z (incf i)) #'identity))
100     i w x y z))
101  (z b c d)
102  4 1 2 3 4)
103
104(deftest sublis.order.2
105  (let ((i 0) w x y z)
106    (values
107     (sublis
108      (progn (setf w (incf i))
109             '((a . z)))
110      (progn (setf x (incf i))
111             (copy-tree '(a b c d)))
112      :key (progn (setf y (incf i)) #'identity)
113      :test-not (progn (setf z (incf i)) (complement #'eql))
114      )
115     i w x y z))
116  (z b c d)
117  4 1 2 3 4)
118
119;;; Const fold tests
120
121(def-fold-test sublis.fold.1 (sublis '((a . b)) '(a x y . a)))
122
123
124;;; Keyword tests
125
126(deftest sublis.allow-other-keys.1
127  (sublis nil 'a :bad t :allow-other-keys t)
128  a)
129
130(deftest sublis.allow-other-keys.2
131  (sublis nil 'a :allow-other-keys t :bad t)
132  a)
133
134(deftest sublis.allow-other-keys.3
135  (sublis nil 'a :allow-other-keys t)
136  a)
137
138(deftest sublis.allow-other-keys.4
139  (sublis nil 'a :allow-other-keys nil)
140  a)
141
142(deftest sublis.allow-other-keys.5
143  (sublis nil 'a :allow-other-keys t :allow-other-keys t :bad t)
144  a)
145
146(deftest sublis.keywords.6
147  (sublis '((1 . a)) (list 0 1 2) :key #'(lambda (x) (if (numberp x) (1+ x) x))
148          :key #'identity)
149  (a 1 2))
150
151
152;; Argument error cases
153
154(deftest sublis.error.1
155  (signals-error (sublis) program-error)
156  t)
157
158(deftest sublis.error.2
159  (signals-error (sublis nil) program-error)
160  t)
161
162(deftest sublis.error.3
163  (signals-error (sublis nil 'a :test) program-error)
164  t)
165
166(deftest sublis.error.4
167  (signals-error (sublis nil 'a :bad-keyword t) program-error)
168  t)
169
170(deftest sublis.error.5
171  (signals-error (sublis '((a . 1) (b . 2))
172                          (list 'a 'b 'c 'd)
173                          :test #'identity)
174                 program-error)
175  t)
176
177(deftest sublis.error.6
178  (signals-error (sublis '((a . 1) (b . 2))
179                          (list 'a 'b 'c 'd)
180                          :key #'cons)
181                 program-error)
182  t)
183
184(deftest sublis.error.7
185  (signals-error (sublis '((a . 1) (b . 2))
186                          (list 'a 'b 'c 'd)
187                          :test-not #'identity)
188                 program-error)
189  t)
190
191(deftest sublis.error.8
192  (signals-error (sublis '((a . 1) . bad)
193                          (list 'a 'b 'c 'd))
194                 type-error)
195  t)
196
197(deftest sublis.shared
198  (let* ((shared-piece (list 'a 'b))
199         (a (list shared-piece shared-piece)))
200    (check-sublis a '((a . b) (b . a))))
201  ((b a) (b a)))
Note: See TracBrowser for help on using the repository browser.