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