complement.lsp 3.79 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Oct  6 20:04:33 2002
;;;; Contains: Tests for COMPLEMENT

(in-package :cl-test)

(deftest complement.1
9 10
  (notnot-mv (funcall (complement #'identity) nil))
  t)
11 12

(deftest complement.2
13
  (funcall (complement #'identity) t)
14 15 16
  nil)

(deftest complement.3
17 18
  (check-predicate
   #'(lambda (x) (eql (funcall (cl::complement #'not) x)
sds's avatar
sds committed
19
                      (not (not x)))))
20
  nil)
21 22 23 24

(deftest complement.4
  (let ((x '(#\b)))
    (loop for i from 2 to (min 256 (1- call-arguments-limit))
sds's avatar
sds committed
25 26 27
          always (progn
                   (push #\a x)
                   (apply (complement #'char=) x))))
28
  t)
29 30

(deftest complement.5
31 32 33
  (notnot-mv (complement #'identity))
  t)

pfdietz's avatar
pfdietz committed
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
(deftest complement.6
  (flet ((%f (&rest args) (notnot (evenp (length args)))))
    (let ((cf (complement #'%f)))
      (values
       (%f) (%f 'a) (%f 'a 'b) (%f 'a 'b 'c)
       (funcall cf) (funcall cf 'a) (funcall cf 'a 'b) (funcall cf 'a 'b 'c))))
  t nil t nil
  nil t nil t)

(deftest complement.7
  (flet ((%f (&optional x y) (if x (not y) y)))
    (let ((cf (complement #'%f)))
      (values
       (%f) (%f nil) (%f t) (%f nil nil) (%f t nil) (%f nil t) (%f t t)
       (funcall cf) (funcall cf nil) (funcall cf t)
       (funcall cf nil nil) (funcall cf t nil)
       (funcall cf nil t) (funcall cf t t))))
  nil nil t nil t t nil
  t t nil t nil nil t)

(deftest complement.8
  (flet ((%f (&key x y) (if x (not y) y)))
    (let ((cf (complement #'%f)))
      (values
       (list
       (%f)
       (%f :x nil) (%f :x t)
       (%f :y nil) (%f :y t :y nil)
       (%f :x nil :y nil) (%f :x t :y nil)
       (%f :y t :x nil) (%f :x t :y t))
sds's avatar
sds committed
64

pfdietz's avatar
pfdietz committed
65
       (list
sds's avatar
sds committed
66 67 68 69
        (funcall cf) (funcall cf :x nil) (funcall cf :x t)
        (funcall cf :y nil) (funcall cf :y t)
        (funcall cf :x nil :y nil) (funcall cf :x t :y nil)
        (funcall cf :y t :x nil) (funcall cf :x t :y t :x nil))
pfdietz's avatar
pfdietz committed
70
       (list
sds's avatar
sds committed
71 72
        (funcall cf :x nil :y t :foo nil :allow-other-keys t)
        (funcall cf :x nil :y t :allow-other-keys nil)))))
pfdietz's avatar
pfdietz committed
73 74 75 76 77 78 79 80 81 82 83
  (nil nil t nil t nil t t nil)
  (t t nil t nil t nil nil t)
  (nil nil))

(deftest complement.9
  (let ((sym (gensym)))
    (eval `(defgeneric ,sym (x y)))
    (eval `(defmethod ,sym ((x integer) (y integer)) (evenp (+ x y))))
    (eval `(defmethod ,sym ((x t) (y t)) nil))
    (let ((cf (complement (symbol-function sym))))
      (values (funcall cf 'a 'b)
sds's avatar
sds committed
84 85 86 87
              (funcall cf 0 0)
              (funcall cf 0 1)
              (funcall cf 1 0)
              (funcall cf 1 1))))
pfdietz's avatar
pfdietz committed
88 89 90 91 92
  t nil t t nil)

(deftest complement.10
  (let ((cf (complement (compile nil '(lambda (x y) (evenp (+ x y)))))))
    (values (funcall cf 0 0)
sds's avatar
sds committed
93 94 95 96
            (funcall cf 0 1)
            (funcall cf 1 0)
            (funcall cf 1 1)))
  nil t t nil)
pfdietz's avatar
pfdietz committed
97

98 99 100 101 102 103 104 105 106
(deftest complement.order.1
  (let ((i 0))
    (let ((fn (complement (progn (incf i) #'null))))
      (values
       i
       (mapcar fn '(a b nil c 1 nil t nil))
       i)))
  1 (t t nil t t nil t nil) 1)

pfdietz's avatar
pfdietz committed
107 108
;;; Error tests

109
(deftest complement.error.1
110 111
  (signals-error (complement) program-error)
  t)
112

113
(deftest complement.error.2
114 115
  (signals-error (complement #'not t) program-error)
  t)
116 117

(deftest complement.error.3
118
  (signals-error (funcall (complement #'identity))
sds's avatar
sds committed
119
                 program-error)
120
  t)
121 122

(deftest complement.error.4
123
  (signals-error (funcall (complement #'identity) t t)
sds's avatar
sds committed
124
                 program-error)
125
  t)
pfdietz's avatar
pfdietz committed
126 127 128 129 130 131 132

(deftest complement.error.5
  (signals-error (funcall (complement #'(lambda (&key) t)) :foo t) program-error)
  t)

(deftest complement.error.6
  (signals-error (funcall (complement #'(lambda (&key) t)) :allow-other-keys nil
sds's avatar
sds committed
133
                          :allow-other-keys t :foo t) program-error)
pfdietz's avatar
pfdietz committed
134 135 136 137
  t)

(deftest complement.error.7
  (signals-error (funcall (complement #'(lambda (x &rest y) (and x (evenp (length y))))))
sds's avatar
sds committed
138
                 program-error)
pfdietz's avatar
pfdietz committed
139
  t)