← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/adjoin.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/adjoin.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Mar 28 07:33:20 1998
 
4
;;;; Contains:  Tests of ADJOIN
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(compile-and-load "cons-aux.lsp")
 
9
 
 
10
(deftest adjoin.1
 
11
  (adjoin 'a nil)
 
12
  (a))
 
13
 
 
14
(deftest adjoin.2
 
15
  (adjoin nil nil)
 
16
  (nil))
 
17
 
 
18
(deftest adjoin.3
 
19
  (adjoin 'a '(a))
 
20
  (a))
 
21
 
 
22
;; Check that a NIL :key argument is the same as no key argument at all
 
23
(deftest adjoin.4
 
24
  (adjoin 'a '(a) :key nil)
 
25
  (a))
 
26
 
 
27
(deftest adjoin.5
 
28
  (adjoin 'a '(a) :key #'identity)
 
29
  (a))
 
30
 
 
31
(deftest adjoin.6
 
32
  (adjoin 'a '(a) :key 'identity)
 
33
  (a))
 
34
 
 
35
(deftest adjoin.7
 
36
  (adjoin (1+ 11) '(4 3 12 2 1))
 
37
  (4 3 12 2 1))
 
38
 
 
39
;; Check that the test is EQL, not EQ (by adjoining a bignum)
 
40
(deftest adjoin.8
 
41
  (adjoin (1+ 999999999999) '(4 1 1000000000000 3816734 a "aa"))
 
42
  (4 1 1000000000000 3816734 a "aa"))
 
43
 
 
44
(deftest adjoin.9
 
45
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a))
 
46
  ("aaa" aaa "AAA" "aaa" #\a))
 
47
 
 
48
(deftest adjoin.10
 
49
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test #'equal)
 
50
  (aaa "AAA" "aaa" #\a))
 
51
 
 
52
(deftest adjoin.11
 
53
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test 'equal)
 
54
  (aaa "AAA" "aaa" #\a))
 
55
 
 
56
(deftest adjoin.12
 
57
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
 
58
          :test-not (complement #'equal))
 
59
  (aaa "AAA" "aaa" #\a))
 
60
 
 
61
(deftest adjoin.14
 
62
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
 
63
          :test #'equal :key #'identity)
 
64
  (aaa "AAA" "aaa" #\a))
 
65
 
 
66
(deftest adjoin.15
 
67
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
 
68
          :test 'equal :key #'identity)
 
69
  (aaa "AAA" "aaa" #\a))
 
70
 
 
71
;; Test that a :key of NIL is the same as no key at all
 
72
(deftest adjoin.16
 
73
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
 
74
          :test #'equal :key nil)
 
75
  (aaa "AAA" "aaa" #\a))
 
76
 
 
77
;; Test that a :key of NIL is the same as no key at all
 
78
(deftest adjoin.17
 
79
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
 
80
          :test 'equal :key nil)
 
81
  (aaa "AAA" "aaa" #\a))
 
82
 
 
83
;; Test that a :key of NIL is the same as no key at all
 
84
(deftest adjoin.18
 
85
  (adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
 
86
          :test-not (complement #'equal) :key nil)
 
87
  (aaa "AAA" "aaa" #\a))
 
88
 
 
89
;;; Ordering in comparison function
 
90
 
 
91
(deftest adjoin.19
 
92
  (adjoin 10 '(1 2 3) :test #'<)
 
93
  (10 1 2 3))
 
94
 
 
95
(deftest adjoin.20
 
96
  (adjoin 10 '(1 2 3) :test #'>)
 
97
  (1 2 3))
 
98
 
 
99
(deftest adjoin.21
 
100
  (adjoin 10 '(1 2 3) :test-not #'>)
 
101
  (10 1 2 3))
 
102
 
 
103
(deftest adjoin.22
 
104
  (adjoin 10 '(1 2 3) :test-not #'<)
 
105
  (1 2 3))
 
106
 
 
107
(defharmless adjoin.test-and-test-not.1
 
108
  (adjoin 'a '(b c) :test #'eql :test-not #'eql))
 
109
 
 
110
(defharmless adjoin.test-and-test-not.2
 
111
  (adjoin 'a '(b c) :test-not #'eql :test #'eql))
 
112
 
 
113
(deftest adjoin.order.1
 
114
  (let ((i 0) w x y z)
 
115
    (values
 
116
     (adjoin (progn (setf w (incf i)) 'a)
 
117
             (progn (setf x (incf i)) '(b c d a e))
 
118
             :key (progn (setf y (incf i)) #'identity)
 
119
             :test (progn (setf z (incf i)) #'eql))
 
120
     i w x y z))
 
121
  (b c d a e)
 
122
  4 1 2 3 4)
 
123
 
 
124
(deftest adjoin.order.2
 
125
  (let ((i 0) w x y z p)
 
126
    (values
 
127
     (adjoin (progn (setf w (incf i)) 'a)
 
128
             (progn (setf x (incf i)) '(b c d e))
 
129
             :test-not (progn (setf y (incf i)) (complement #'eql))
 
130
             :key (progn (setf z (incf i)) #'identity)
 
131
             :key (progn (setf p (incf i)) nil))
 
132
     i w x y z p))
 
133
  (a b c d e)
 
134
  5 1 2 3 4 5)
 
135
 
 
136
(deftest adjoin.allow-other-keys.1
 
137
  (adjoin 'a '(b c) :bad t :allow-other-keys t)
 
138
  (a b c))
 
139
 
 
140
(deftest adjoin.allow-other-keys.2
 
141
  (adjoin 'a '(b c) :allow-other-keys t :foo t)
 
142
  (a b c))
 
143
 
 
144
(deftest adjoin.allow-other-keys.3
 
145
  (adjoin 'a '(b c) :allow-other-keys t)
 
146
  (a b c))
 
147
 
 
148
(deftest adjoin.allow-other-keys.4
 
149
  (adjoin 'a '(b c) :allow-other-keys nil)
 
150
  (a b c))
 
151
 
 
152
(deftest adjoin.allow-other-keys.5
 
153
  (adjoin 'a '(b c) :allow-other-keys t :allow-other-keys nil 'bad t)
 
154
  (a b c))
 
155
 
 
156
(deftest adjoin.repeat-key
 
157
  (adjoin 'a '(b c) :test #'eq :test (complement #'eq))
 
158
  (a b c))
 
159
 
 
160
(deftest adjoin.error.1
 
161
  (signals-error (adjoin) program-error)
 
162
  t)
 
163
 
 
164
(deftest adjoin.error.2
 
165
  (signals-error (adjoin 'a) program-error)
 
166
  t)
 
167
 
 
168
(deftest adjoin.error.3
 
169
  (signals-error (adjoin 'a '(b c) :bad t) program-error)
 
170
  t)
 
171
 
 
172
(deftest adjoin.error.4
 
173
  (signals-error (adjoin 'a '(b c) :allow-other-keys nil :bad t) program-error)
 
174
  t)
 
175
 
 
176
(deftest adjoin.error.5
 
177
  (signals-error (adjoin 'a '(b c) 1 2) program-error)
 
178
  t)
 
179
 
 
180
(deftest adjoin.error.6
 
181
  (signals-error (adjoin 'a '(b c) :test) program-error)
 
182
  t)
 
183
 
 
184
(deftest adjoin.error.7
 
185
  (signals-error (adjoin 'a '(b c) :test #'identity) program-error)
 
186
  t)
 
187
 
 
188
(deftest adjoin.error.8
 
189
  (signals-error (adjoin 'a '(b c) :test-not #'identity) program-error)
 
190
  t)
 
191
 
 
192
(deftest adjoin.error.9
 
193
  (signals-error (adjoin 'a '(b c) :key #'cons) program-error)
 
194
  t)
 
195
 
 
196
(deftest adjoin.error.10
 
197
  (signals-error (adjoin 'a (list* 'b 'c 'd)) type-error)
 
198
  t)