comparison tests/automated/extent-tests.el @ 4855:189fb67ca31a

Create Assert-eq, Assert-equal, etc. These are equivalent to (Assert (eq ...)) but display both the actual value and the expected value of the comparison. Use them throughout the test suite.
author Ben Wing <ben@xemacs.org>
date Thu, 14 Jan 2010 02:18:03 -0600
parents 20ae8821c23d
children 0f66906b6e37
comparison
equal deleted inserted replaced
4854:95c4ced5c07c 4855:189fb67ca31a
50 ;; Detached extent. 50 ;; Detached extent.
51 (Assert (extent-detached-p extent)) 51 (Assert (extent-detached-p extent))
52 52
53 ;; Put it in a buffer. 53 ;; Put it in a buffer.
54 (set-extent-endpoints extent 1 1 (current-buffer)) 54 (set-extent-endpoints extent 1 1 (current-buffer))
55 (Assert (eq (extent-object extent) (current-buffer))) 55 (Assert-eq (extent-object extent) (current-buffer))
56 56
57 ;; And then into another buffer. 57 ;; And then into another buffer.
58 (with-temp-buffer 58 (with-temp-buffer
59 (set-extent-endpoints extent 1 1 (current-buffer)) 59 (set-extent-endpoints extent 1 1 (current-buffer))
60 (Assert (eq (extent-object extent) (current-buffer)))) 60 (Assert-eq (extent-object extent) (current-buffer)))
61 61
62 ;; Now that the buffer doesn't exist, extent should be detached 62 ;; Now that the buffer doesn't exist, extent should be detached
63 ;; again. 63 ;; again.
64 (Assert (extent-detached-p extent)) 64 (Assert (extent-detached-p extent))
65 65
66 ;; This line crashes XEmacs 21.2.46 and prior. 66 ;; This line crashes XEmacs 21.2.46 and prior.
67 (set-extent-endpoints extent 1 (length string) string) 67 (set-extent-endpoints extent 1 (length string) string)
68 (Assert (eq (extent-object extent) string)) 68 (Assert-eq (extent-object extent) string)
69 ) 69 )
70 70
71 (let ((extent (make-extent 1 1))) 71 (let ((extent (make-extent 1 1)))
72 ;; By default, extent should be closed-open 72 ;; By default, extent should be closed-open
73 (Assert (eq (get extent 'start-closed) t)) 73 (Assert-eq (get extent 'start-closed) t)
74 (Assert (eq (get extent 'start-open) nil)) 74 (Assert-eq (get extent 'start-open) nil)
75 (Assert (eq (get extent 'end-open) t)) 75 (Assert-eq (get extent 'end-open) t)
76 (Assert (eq (get extent 'end-closed) nil)) 76 (Assert-eq (get extent 'end-closed) nil)
77 77
78 ;; Make it closed-closed. 78 ;; Make it closed-closed.
79 (set-extent-property extent 'end-closed t) 79 (set-extent-property extent 'end-closed t)
80 80
81 (Assert (eq (get extent 'start-closed) t)) 81 (Assert-eq (get extent 'start-closed) t)
82 (Assert (eq (get extent 'start-open) nil)) 82 (Assert-eq (get extent 'start-open) nil)
83 (Assert (eq (get extent 'end-open) nil)) 83 (Assert-eq (get extent 'end-open) nil)
84 (Assert (eq (get extent 'end-closed) t)) 84 (Assert-eq (get extent 'end-closed) t)
85 85
86 ;; open-closed 86 ;; open-closed
87 (set-extent-property extent 'start-open t) 87 (set-extent-property extent 'start-open t)
88 88
89 (Assert (eq (get extent 'start-closed) nil)) 89 (Assert-eq (get extent 'start-closed) nil)
90 (Assert (eq (get extent 'start-open) t)) 90 (Assert-eq (get extent 'start-open) t)
91 (Assert (eq (get extent 'end-open) nil)) 91 (Assert-eq (get extent 'end-open) nil)
92 (Assert (eq (get extent 'end-closed) t)) 92 (Assert-eq (get extent 'end-closed) t)
93 93
94 ;; open-open 94 ;; open-open
95 (set-extent-property extent 'end-open t) 95 (set-extent-property extent 'end-open t)
96 96
97 (Assert (eq (get extent 'start-closed) nil)) 97 (Assert-eq (get extent 'start-closed) nil)
98 (Assert (eq (get extent 'start-open) t)) 98 (Assert-eq (get extent 'start-open) t)
99 (Assert (eq (get extent 'end-open) t)) 99 (Assert-eq (get extent 'end-open) t)
100 (Assert (eq (get extent 'end-closed) nil))) 100 (Assert-eq (get extent 'end-closed) nil))
101 101
102 ) 102 )
103 103
104 ;;----------------------------------------------------- 104 ;;-----------------------------------------------------
105 ;; Insertion behavior. 105 ;; Insertion behavior.
123 (with-temp-buffer 123 (with-temp-buffer
124 (insert "###eee###") 124 (insert "###eee###")
125 (let ((e (make-extent 4 7))) 125 (let ((e (make-extent 4 7)))
126 ;; current state: "###[eee)###" 126 ;; current state: "###[eee)###"
127 ;; 123 456 789 127 ;; 123 456 789
128 (Assert (equal (et-range e) '(4 7))) 128 (Assert-equal (et-range e) '(4 7))
129 129
130 (et-insert-at "xxx" 4) 130 (et-insert-at "xxx" 4)
131 131
132 ;; current state: "###[xxxeee)###" 132 ;; current state: "###[xxxeee)###"
133 ;; 123 456789 012 133 ;; 123 456789 012
134 (Assert (equal (et-range e) '(4 10))) 134 (Assert-equal (et-range e) '(4 10))
135 135
136 (et-insert-at "yyy" 7) 136 (et-insert-at "yyy" 7)
137 137
138 ;; current state: "###[xxxyyyeee)###" 138 ;; current state: "###[xxxyyyeee)###"
139 ;; 123 456789012 345 139 ;; 123 456789012 345
140 (Assert (equal (et-range e) '(4 13))) 140 (Assert-equal (et-range e) '(4 13))
141 141
142 (et-insert-at "zzz" 13) 142 (et-insert-at "zzz" 13)
143 143
144 ;; current state: "###[xxxyyyeee)zzz###" 144 ;; current state: "###[xxxyyyeee)zzz###"
145 ;; 123 456789012 345678 145 ;; 123 456789012 345678
146 (Assert (equal (et-range e) '(4 13))) 146 (Assert-equal (et-range e) '(4 13))
147 )) 147 ))
148 148
149 ;; closed-closed 149 ;; closed-closed
150 150
151 (with-temp-buffer 151 (with-temp-buffer
153 (let ((e (make-extent 4 7))) 153 (let ((e (make-extent 4 7)))
154 (put e 'end-closed t) 154 (put e 'end-closed t)
155 155
156 ;; current state: "###[eee]###" 156 ;; current state: "###[eee]###"
157 ;; 123 456 789 157 ;; 123 456 789
158 (Assert (equal (et-range e) '(4 7))) 158 (Assert-equal (et-range e) '(4 7))
159 159
160 (et-insert-at "xxx" 4) 160 (et-insert-at "xxx" 4)
161 161
162 ;; current state: "###[xxxeee]###" 162 ;; current state: "###[xxxeee]###"
163 ;; 123 456789 012 163 ;; 123 456789 012
164 (Assert (equal (et-range e) '(4 10))) 164 (Assert-equal (et-range e) '(4 10))
165 165
166 (et-insert-at "yyy" 7) 166 (et-insert-at "yyy" 7)
167 167
168 ;; current state: "###[xxxyyyeee]###" 168 ;; current state: "###[xxxyyyeee]###"
169 ;; 123 456789012 345 169 ;; 123 456789012 345
170 (Assert (equal (et-range e) '(4 13))) 170 (Assert-equal (et-range e) '(4 13))
171 171
172 (et-insert-at "zzz" 13) 172 (et-insert-at "zzz" 13)
173 173
174 ;; current state: "###[xxxyyyeeezzz]###" 174 ;; current state: "###[xxxyyyeeezzz]###"
175 ;; 123 456789012345 678 175 ;; 123 456789012345 678
176 (Assert (equal (et-range e) '(4 16))) 176 (Assert-equal (et-range e) '(4 16))
177 )) 177 ))
178 178
179 ;; open-closed 179 ;; open-closed
180 180
181 (with-temp-buffer 181 (with-temp-buffer
184 (put e 'start-open t) 184 (put e 'start-open t)
185 (put e 'end-closed t) 185 (put e 'end-closed t)
186 186
187 ;; current state: "###(eee]###" 187 ;; current state: "###(eee]###"
188 ;; 123 456 789 188 ;; 123 456 789
189 (Assert (equal (et-range e) '(4 7))) 189 (Assert-equal (et-range e) '(4 7))
190 190
191 (et-insert-at "xxx" 4) 191 (et-insert-at "xxx" 4)
192 192
193 ;; current state: "###xxx(eee]###" 193 ;; current state: "###xxx(eee]###"
194 ;; 123456 789 012 194 ;; 123456 789 012
195 (Assert (equal (et-range e) '(7 10))) 195 (Assert-equal (et-range e) '(7 10))
196 196
197 (et-insert-at "yyy" 8) 197 (et-insert-at "yyy" 8)
198 198
199 ;; current state: "###xxx(eyyyee]###" 199 ;; current state: "###xxx(eyyyee]###"
200 ;; 123456 789012 345 200 ;; 123456 789012 345
201 (Assert (equal (et-range e) '(7 13))) 201 (Assert-equal (et-range e) '(7 13))
202 202
203 (et-insert-at "zzz" 13) 203 (et-insert-at "zzz" 13)
204 204
205 ;; current state: "###xxx(eyyyeezzz]###" 205 ;; current state: "###xxx(eyyyeezzz]###"
206 ;; 123456 789012345 678 206 ;; 123456 789012345 678
207 (Assert (equal (et-range e) '(7 16))) 207 (Assert-equal (et-range e) '(7 16))
208 )) 208 ))
209 209
210 ;; open-open 210 ;; open-open
211 211
212 (with-temp-buffer 212 (with-temp-buffer
214 (let ((e (make-extent 4 7))) 214 (let ((e (make-extent 4 7)))
215 (put e 'start-open t) 215 (put e 'start-open t)
216 216
217 ;; current state: "###(eee)###" 217 ;; current state: "###(eee)###"
218 ;; 123 456 789 218 ;; 123 456 789
219 (Assert (equal (et-range e) '(4 7))) 219 (Assert-equal (et-range e) '(4 7))
220 220
221 (et-insert-at "xxx" 4) 221 (et-insert-at "xxx" 4)
222 222
223 ;; current state: "###xxx(eee)###" 223 ;; current state: "###xxx(eee)###"
224 ;; 123456 789 012 224 ;; 123456 789 012
225 (Assert (equal (et-range e) '(7 10))) 225 (Assert-equal (et-range e) '(7 10))
226 226
227 (et-insert-at "yyy" 8) 227 (et-insert-at "yyy" 8)
228 228
229 ;; current state: "###xxx(eyyyee)###" 229 ;; current state: "###xxx(eyyyee)###"
230 ;; 123456 789012 345 230 ;; 123456 789012 345
231 (Assert (equal (et-range e) '(7 13))) 231 (Assert-equal (et-range e) '(7 13))
232 232
233 (et-insert-at "zzz" 13) 233 (et-insert-at "zzz" 13)
234 234
235 ;; current state: "###xxx(eyyyee)zzz###" 235 ;; current state: "###xxx(eyyyee)zzz###"
236 ;; 123456 789012 345678 236 ;; 123456 789012 345678
237 (Assert (equal (et-range e) '(7 13))) 237 (Assert-equal (et-range e) '(7 13))
238 )) 238 ))
239 239
240 240
241 ;;----------------------------------------------------- 241 ;;-----------------------------------------------------
242 ;; Deletion behavior. 242 ;; Deletion behavior.
254 (let ((e (make-extent 3 9))) 254 (let ((e (make-extent 3 9)))
255 (set-extent-properties e props) 255 (set-extent-properties e props)
256 256
257 ;; current state: xx[xxxxxx]xx 257 ;; current state: xx[xxxxxx]xx
258 ;; 12 345678 90 258 ;; 12 345678 90
259 (Assert (equal (et-range e) '(3 9))) 259 (Assert-equal (et-range e) '(3 9))
260 260
261 (delete-region 1 2) 261 (delete-region 1 2)
262 262
263 ;; current state: x[xxxxxx]xx 263 ;; current state: x[xxxxxx]xx
264 ;; 1 234567 89 264 ;; 1 234567 89
265 (Assert (equal (et-range e) '(2 8))) 265 (Assert-equal (et-range e) '(2 8))
266 266
267 (delete-region 2 4) 267 (delete-region 2 4)
268 268
269 ;; current state: x[xxxx]xx 269 ;; current state: x[xxxx]xx
270 ;; 1 2345 67 270 ;; 1 2345 67
271 (Assert (equal (et-range e) '(2 6))) 271 (Assert-equal (et-range e) '(2 6))
272 272
273 (delete-region 1 3) 273 (delete-region 1 3)
274 274
275 ;; current state: [xxx]xx 275 ;; current state: [xxx]xx
276 ;; 123 45 276 ;; 123 45
277 (Assert (equal (et-range e) '(1 4))) 277 (Assert-equal (et-range e) '(1 4))
278 278
279 (delete-region 3 5) 279 (delete-region 3 5)
280 280
281 ;; current state: [xx]x 281 ;; current state: [xx]x
282 ;; 12 3 282 ;; 12 3
283 (Assert (equal (et-range e) '(1 3))) 283 (Assert-equal (et-range e) '(1 3))
284 284
285 ))) 285 )))
286 286
287 ;;; #### Should have a test for read-only-ness and insertion and 287 ;;; #### Should have a test for read-only-ness and insertion and
288 ;;; deletion! 288 ;;; deletion!
327 (Assert (not (extent-detached-p e))) 327 (Assert (not (extent-detached-p e)))
328 328
329 (delete-region 4 6) 329 (delete-region 4 6)
330 ;; ###[]### 330 ;; ###[]###
331 (Assert (not (extent-detached-p e))) 331 (Assert (not (extent-detached-p e)))
332 (Assert (equal (et-range e) '(4 4))) 332 (Assert-equal (et-range e) '(4 4))
333 )) 333 ))
334 ) 334 )
335 335
336 336
337 ;;----------------------------------------------------- 337 ;;-----------------------------------------------------
341 ;; closed-open (should stay put) 341 ;; closed-open (should stay put)
342 (with-temp-buffer 342 (with-temp-buffer
343 (insert "######") 343 (insert "######")
344 (let ((e (make-extent 4 4))) 344 (let ((e (make-extent 4 4)))
345 (et-insert-at "foo" 4) 345 (et-insert-at "foo" 4)
346 (Assert (equal (et-range e) '(4 4))))) 346 (Assert-equal (et-range e) '(4 4))))
347 347
348 ;; open-closed (should move) 348 ;; open-closed (should move)
349 (with-temp-buffer 349 (with-temp-buffer
350 (insert "######") 350 (insert "######")
351 (let ((e (make-extent 4 4))) 351 (let ((e (make-extent 4 4)))
352 (put e 'start-open t) 352 (put e 'start-open t)
353 (put e 'end-closed t) 353 (put e 'end-closed t)
354 (et-insert-at "foo" 4) 354 (et-insert-at "foo" 4)
355 (Assert (equal (et-range e) '(7 7))))) 355 (Assert-equal (et-range e) '(7 7))))
356 356
357 ;; closed-closed (should extend) 357 ;; closed-closed (should extend)
358 (with-temp-buffer 358 (with-temp-buffer
359 (insert "######") 359 (insert "######")
360 (let ((e (make-extent 4 4))) 360 (let ((e (make-extent 4 4)))
361 (put e 'end-closed t) 361 (put e 'end-closed t)
362 (et-insert-at "foo" 4) 362 (et-insert-at "foo" 4)
363 (Assert (equal (et-range e) '(4 7))))) 363 (Assert-equal (et-range e) '(4 7))))
364 364
365 ;; open-open (illegal; forced to behave like closed-open) 365 ;; open-open (illegal; forced to behave like closed-open)
366 (with-temp-buffer 366 (with-temp-buffer
367 (insert "######") 367 (insert "######")
368 (let ((e (make-extent 4 4))) 368 (let ((e (make-extent 4 4)))
369 (put e 'start-open t) 369 (put e 'start-open t)
370 (et-insert-at "foo" 4) 370 (et-insert-at "foo" 4)
371 (Assert (equal (et-range e) '(4 4))))) 371 (Assert-equal (et-range e) '(4 4))))