rassoc-if.lsp 3.51 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:34:59 2003
;;;; Contains: Tests of RASSOC-IF

6

7

8

9

10 11
(deftest rassoc-if.1
    (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d))))
sds's avatar
sds committed
12 13
           (xcopy (make-scaffold-copy x))
           (result (rassoc-if #'evenp x)))
14 15 16 17 18 19 20 21
      (and
       (check-scaffold-copy x xcopy)
       (eqt result (third x))
       result))
  (c . 6))

(deftest rassoc-if.2
  (let* ((x (rev-assoc-list '((1 . a) (3 . b) (6 . c) (7 . d))))
sds's avatar
sds committed
22 23
         (xcopy (make-scaffold-copy x))
         (result (rassoc-if #'oddp x :key #'1+)))
24 25 26 27 28 29 30 31
    (and
     (check-scaffold-copy x xcopy)
     (eqt result (third x))
     result))
  (c . 6))

(deftest rassoc-if.3
    (let* ((x (rev-assoc-list '((1 . a) nil (3 . b) (6 . c) (7 . d))))
sds's avatar
sds committed
32 33
           (xcopy (make-scaffold-copy x))
           (result (rassoc-if #'evenp x)))
34 35 36 37 38 39 40 41
      (and
       (check-scaffold-copy x xcopy)
       (eqt result (fourth x))
       result))
  (c . 6))

(deftest rassoc-if.4
    (rassoc-if #'null
sds's avatar
sds committed
42
               (rev-assoc-list '((a . b) nil (c . d) (nil . e) (f . g))))
43 44 45 46 47 48 49 50
  (e))

;;; Order of argument evaluation

(deftest rassoc-if.order.1
  (let ((i 0) x y)
    (values
     (rassoc-if (progn (setf x (incf i)) #'null)
sds's avatar
sds committed
51 52
                (progn (setf y (incf i))
                       '((1 . a) (2 . b) (17) (4 . d))))
53 54 55 56 57 58 59
     i x y))
  (17) 2 1 2)

(deftest rassoc-if.order.2
  (let ((i 0) x y z)
    (values
     (rassoc-if (progn (setf x (incf i)) #'null)
sds's avatar
sds committed
60 61 62
                (progn (setf y (incf i))
                       '((1 . a) (2 . b) (17) (4 . d)))
                :key (progn (setf z (incf i)) #'null))
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
     i x y z))
  (1 . a) 3 1 2 3)


;;; Keyword tests

(deftest rassoc-if.allow-other-keys.1
  (rassoc-if #'null '((1 . a) (2) (3 . c)) :bad t :allow-other-keys t)
  (2))

(deftest rassoc-if.allow-other-keys.2
  (rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t)
  (2))

(deftest rassoc-if.allow-other-keys.3
  (rassoc-if #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t :bad t
sds's avatar
sds committed
79
          :key 'not)
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
  (2))

(deftest rassoc-if.allow-other-keys.4
  (rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys t)
  (2))

(deftest rassoc-if.allow-other-keys.5
  (rassoc-if #'null '((1 . a) (2) (3 . c)) :allow-other-keys nil)
  (2))

(deftest rassoc-if.keywords.6
  (rassoc-if #'identity '((1 . a) (2) (3 . c)) :key #'not :key #'identity)
  (2))

;;; Error tests

(deftest rassoc-if.error.1
97 98
  (signals-error (rassoc-if) program-error)
  t)
99 100

(deftest rassoc-if.error.2
101 102
  (signals-error (rassoc-if #'null) program-error)
  t)
103 104

(deftest rassoc-if.error.3
105 106
  (signals-error (rassoc-if #'null nil :bad t) program-error)
  t)
107 108

(deftest rassoc-if.error.4
109 110
  (signals-error (rassoc-if #'null nil :key) program-error)
  t)
111 112

(deftest rassoc-if.error.5
113 114
  (signals-error (rassoc-if #'null nil 1 1) program-error)
  t)
115 116

(deftest rassoc-if.error.6
117 118
  (signals-error (rassoc-if #'null nil :bad t :allow-other-keys nil) program-error)
  t)
119 120

(deftest rassoc-if.error.7
121 122
  (signals-error (rassoc-if #'cons '((a . b)(c . d))) program-error)
  t)
123 124

(deftest rassoc-if.error.8
125 126
  (signals-error (rassoc-if #'car '((a . b)(c . d))) type-error)
  t)
127 128

(deftest rassoc-if.error.9
129 130
  (signals-error (rassoc-if #'identity '((a . b)(c . d)) :key #'cons) program-error)
  t)
131 132

(deftest rassoc-if.error.10
133 134
  (signals-error (rassoc-if #'identity '((a . b)(c . d)) :key #'car) type-error)
  t)
135 136

(deftest rassoc-if.error.11
137 138
  (signals-error (rassoc-if #'not '((a . b) . c)) type-error)
  t)
139

pfdietz's avatar
pfdietz committed
140 141 142
(deftest rassoc-if.error.12
  (check-type-error #'(lambda (x) (rassoc-if #'identity x)) #'listp)
  nil)