rassoc-if-not.lsp 3.96 KB
Newer Older
1
2
3
4
5
6
7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:35:27 2003
;;;; Contains: Tests of RASSOC-IF-NOT

(in-package :cl-test)

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

(deftest rassoc-if-not.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-not #'oddp 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-not.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-not #'evenp 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-not.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-not #'oddp x)))
34
35
36
37
38
39
40
      (and
       (check-scaffold-copy x xcopy)
       (eqt result (fourth x))
       result))
  (c . 6))

(deftest rassoc-if-not.4
sds's avatar
sds committed
41
42
    (rassoc-if-not #'identity
                   (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-not.order.1
  (let ((i 0) x y)
    (values
     (rassoc-if-not (progn (setf x (incf i)) #'identity)
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-not.order.2
  (let ((i 0) x y z)
    (values
     (rassoc-if-not (progn (setf x (incf i)) #'identity)
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
     i x y z))
  (1 . a) 3 1 2 3)

;;; Keyword tests

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

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

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

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

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

(deftest rassoc-if-not.allow-other-keys.6
  (rassoc-if-not #'identity '((1 . a) (2) (3 . c)) :allow-other-keys t
sds's avatar
sds committed
91
                 :allow-other-keys nil :bad t)
92
93
94
95
96
97
98
99
100
  (2))

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

;;; Error tests

(deftest rassoc-if-not.error.1
101
102
  (signals-error (rassoc-if-not) program-error)
  t)
103
104

(deftest rassoc-if-not.error.2
105
106
  (signals-error (rassoc-if-not #'null) program-error)
  t)
107
108

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

(deftest rassoc-if-not.error.4
113
114
  (signals-error (rassoc-if-not #'null nil :key) program-error)
  t)
115
116

(deftest rassoc-if-not.error.5
117
118
  (signals-error (rassoc-if-not #'null nil 1 1) program-error)
  t)
119
120

(deftest rassoc-if-not.error.6
121
122
  (signals-error (rassoc-if-not #'null nil :bad t :allow-other-keys nil) program-error)
  t)
123
124

(deftest rassoc-if-not.error.7
125
126
  (signals-error (rassoc-if-not #'cons '((a . b)(c . d))) program-error)
  t)
127
128

(deftest rassoc-if-not.error.8
129
130
  (signals-error (rassoc-if-not #'car '((a . b)(c . d))) type-error)
  t)
131
132

(deftest rassoc-if-not.error.9
133
134
  (signals-error (rassoc-if-not #'identity '((a . b)(c . d)) :key #'cons) program-error)
  t)
135
136

(deftest rassoc-if-not.error.10
137
138
  (signals-error (rassoc-if-not #'identity '((a . b)(c . d)) :key #'car) type-error)
  t)
139
140

(deftest rassoc-if-not.error.11
141
142
  (signals-error (rassoc-if-not #'identity '((a . b) . c)) type-error)
  t)
pfdietz's avatar
pfdietz committed
143
144
145
146

(deftest rassoc-if-not.error.12
  (check-type-error #'(lambda (x) (rassoc-if-not #'identity x)) #'listp)
  nil)