nsubst-if-not.lsp 3.01 KB
Newer Older
1
2
3
4
5
6
7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 21:54:12 2003
;;;; Contains: Tests of NSUBST-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 nsubst-if-not.1
  (check-nsubst-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 nsubst-if-not.2
  (check-nsubst-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 nsubst-if-not.3
  (check-nsubst-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 nsubst-if-not.4
  (check-nsubst-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 nsubst-if-not.5
  (check-nsubst-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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
  ((a) (a) (c) (d)))

(deftest nsubst-if-not.6
  (nsubst-if-not 'a #'null nil :bad t :allow-other-keys t)
  nil)

(deftest nsubst-if-not.7
  (let ((i 0) w x y z)
    (values
     (nsubst-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)

;;; Keywords tests for nsubst-if-not

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

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

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

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

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

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

;;; error cases

(deftest nsubst-if-not.error.1
90
91
  (signals-error (nsubst-if-not) program-error)
  t)
92
93

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

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

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

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

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

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

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