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