source: trunk/source/tests/ansi-tests/subst-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: 2.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 19 21:39:42 2003
4;;;; Contains: Tests of SUBST-IF
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest subst-if.1
11  (check-subst-if 'a #'consp '((100 1) (2 3) (4 3 2 1) (a b c)))
12  a)
13
14(deftest subst-if.2
15  (check-subst-if 17 (complement #'listp) '(a (a b) (a c d) (a nil e f g)))
16  (17 (17 17) (17 17 17) (17 nil 17 17 17)))
17
18(deftest subst-if.3
19  (check-subst-if '(z)
20                  (complement #'consp)
21                  '(a (a b) (c d e) (f g h i)))
22  ((z)
23   ((z) (z) z)
24   ((z) (z) (z) z)
25   ((z) (z) (z) (z) z)
26   z))
27
28(deftest subst-if.4
29  (check-subst-if 'b #'identity '((100 1) (2 3) (4 3 2 1) (a b c))
30                  :key #'listp)
31  b)
32
33(deftest subst-if.5
34  (check-subst-if 4 #'(lambda (x) (eql x 1))
35                  '((1 3) (1) (1 10 20 30) (1 3 x y))
36                  :key #'(lambda (x)
37                           (and (consp x)
38                                (car x))))
39  (4 4 4 4))
40
41(deftest subst-if.6
42  (check-subst-if 'a  #'(lambda (x) (eql x 'b))
43                  '((a) (b) (c) (d))
44                  :key nil)
45  ((a) (a) (c) (d)))
46
47(deftest subst-if.7
48  (let ((i 0) w x y z)
49    (values
50     (subst-if
51      (progn (setf w (incf i)) 'a)
52      (progn (setf x (incf i)) #'(lambda (x) (eql x 'b)))
53      (progn (setf y (incf i)) (copy-list '(1 2 a b c)))
54      :key (progn (setf z (incf i)) #'identity))
55     i w x y z))
56  (1 2 a a c)
57  4 1 2 3 4)
58
59(def-fold-test subst-if.fold.1 (subst-if 'x 'numberp '(a b 3 (4) c d . 12)))
60
61;;; Keyword tests for subst-if
62
63(deftest subst-if.allow-other-keys.1
64  (subst-if 'a #'null nil :bad t :allow-other-keys t)
65  a)
66
67(deftest subst-if.allow-other-keys.2
68  (subst-if 'a #'null nil :allow-other-keys t)
69  a)
70
71(deftest subst-if.allow-other-keys.3
72  (subst-if 'a #'null nil :allow-other-keys nil)
73  a)
74
75(deftest subst-if.allow-other-keys.4
76  (subst-if 'a #'null nil :allow-other-keys t :bad t)
77  a)
78
79(deftest subst-if.allow-other-keys.5
80  (subst-if 'a #'null nil :allow-other-keys t :allow-other-keys nil :bad t)
81  a)
82
83(deftest subst-if.keywords.6
84  (subst-if 'a #'null nil :key nil :key (constantly 'b))
85  a)
86
87;;; Error tests
88
89(deftest subst-if.error.1
90  (signals-error (subst-if) program-error)
91  t)
92
93(deftest subst-if.error.2
94  (signals-error (subst-if 'a) program-error)
95  t)
96
97(deftest subst-if.error.3
98  (signals-error (subst-if 'a #'null) program-error)
99  t)
100
101(deftest subst-if.error.4
102  (signals-error (subst-if 'a #'null nil :foo nil) program-error)
103  t)
104
105(deftest subst-if.error.5
106  (signals-error (subst-if 'a #'null nil :test) program-error)
107  t)
108
109(deftest subst-if.error.6
110  (signals-error (subst-if 'a #'null nil 1) program-error)
111  t)
112
113(deftest subst-if.error.7
114  (signals-error (subst-if 'a #'null nil :bad t :allow-other-keys nil) program-error)
115  t)
116
117(deftest subst-if.error.8
118  (signals-error (subst-if 'a #'null (list 'a nil 'c) :key #'cons) program-error)
119  t)
Note: See TracBrowser for help on using the repository browser.