subst-if-not.lsp 2.97 KB
Newer Older
1
2
3
4
5
6
7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 21:48:22 2003
;;;; Contains: Tests of SUBST-IF-NOT

(in-package :cl-test)

8
9
(compile-and-load "cons-aux.lsp")

10
11
12
13
14
15
16
17
18
19
(deftest subst-if-not.1
  (check-subst-if-not '(x) 'consp '(1 (1 2) (1 2 3) (1 2 3 4)))
  ((x)
   ((x) (x) x)
   ((x) (x) (x) x)
   ((x) (x) (x) (x) x)
   x))

(deftest subst-if-not.2
  (check-subst-if-not 'a (complement #'listp)
sds's avatar
sds committed
20
                      '((100 1) (2 3) (4 3 2 1) (a b c)))
21
22
23
24
  a)

(deftest subst-if-not.3
  (check-subst-if-not 'c #'identity
sds's avatar
sds committed
25
26
                      '((100 1) (2 3) (4 3 2 1) (a b c))
                      :key (complement #'listp))
27
28
29
30
31
32
33
34
  c)

(deftest subst-if-not.4
  (check-subst-if-not
   40
   #'(lambda (x) (not (eql x 17)))
   '((17) (17 22) (17 22 31) (17 21 34 54))
   :key #'(lambda (x)
sds's avatar
sds committed
35
36
            (and (consp x)
                 (car x))))
37
38
39
40
  (40 40 40 40))

(deftest subst-if-not.5
  (check-subst-if-not 'a  #'(lambda (x) (not (eql x 'b)))
sds's avatar
sds committed
41
42
                      '((a) (b) (c) (d))
                      :key nil)
43
44
45
46
47
48
49
50
51
52
53
54
55
  ((a) (a) (c) (d)))

(deftest subst-if-not.7
  (let ((i 0) w x y z)
    (values
     (subst-if-not
      (progn (setf w (incf i)) 'a)
      (progn (setf x (incf i)) #'(lambda (x) (not (eql x 'b))))
      (progn (setf y (incf i)) (copy-list '(1 2 a b c)))
      :key (progn (setf z (incf i)) #'identity))
     i w x y z))
  (1 2 a a c)
  4 1 2 3 4)
pfdietz's avatar
pfdietz committed
56
57

(def-fold-test subst-if-not.fold.1 (subst-if-not 'a #'consp '((1 . 2) 3 . 4)))
sds's avatar
sds committed
58

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
;;; Keywords tests for subst-if-not

(deftest subst-if-not.allow-other-keys.1
  (subst-if-not 'a #'identity nil :bad t :allow-other-keys t)
  a)

(deftest subst-if-not.allow-other-keys.2
  (subst-if-not 'a #'identity nil :allow-other-keys t)
  a)

(deftest subst-if-not.allow-other-keys.3
  (subst-if-not 'a #'identity nil :allow-other-keys nil)
  a)

(deftest subst-if-not.allow-other-keys.4
  (subst-if-not 'a #'identity nil :allow-other-keys t :bad t)
  a)

(deftest subst-if-not.allow-other-keys.5
  (subst-if-not 'a #'identity nil :allow-other-keys t
sds's avatar
sds committed
79
                :allow-other-keys nil :bad t)
80
81
82
83
84
85
86
87
88
  a)

(deftest subst-if-not.keywords.6
  (subst-if-not 'a #'identity nil :key nil :key (constantly 'b))
  a)

;;; error cases

(deftest subst-if-not.error.1
89
90
  (signals-error (subst-if-not) program-error)
  t)
91
92

(deftest subst-if-not.error.2
93
94
  (signals-error (subst-if-not 'a) program-error)
  t)
95
96

(deftest subst-if-not.error.3
97
98
  (signals-error (subst-if-not 'a #'null) program-error)
  t)
99
100

(deftest subst-if-not.error.4
101
102
  (signals-error (subst-if-not 'a #'null nil :foo nil) program-error)
  t)
103
104

(deftest subst-if-not.error.5
105
106
  (signals-error (subst-if-not 'a #'null nil :test) program-error)
  t)
107
108

(deftest subst-if-not.error.6
109
110
  (signals-error (subst-if-not 'a #'null nil 1) program-error)
  t)
111
112

(deftest subst-if-not.error.7
113
  (signals-error (subst-if-not 'a #'null nil
sds's avatar
sds committed
114
                                :bad t :allow-other-keys nil) program-error)
115
  t)
116
117

(deftest subst-if-not.error.8
118
119
  (signals-error (subst-if-not 'a #'null (list 'a nil 'c) :key #'cons) program-error)
  t)