Mercurial > hg > xemacs-beta

comparison tests/automated/extent-tests.el @ 5136:0f66906b6e37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-12 Ben Wing <ben@xemacs.org> * test-harness.el (test-harness-from-buffer): Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). Get rid of `Assert-equalp' and friends, `Assert-test', and `Assert-test-not'. Instead, make `Assert' smart enough to do the equivalent functionality when an expression like (Assert (equalp ...)) is seen. tests/ChangeLog addition: 2010-03-12 Ben Wing <ben@xemacs.org> * automated/base64-tests.el (bt-base64-encode-string): * automated/base64-tests.el (bt-base64-decode-string): * automated/base64-tests.el (for): * automated/byte-compiler-tests.el: * automated/byte-compiler-tests.el (before-and-after-compile-equal): * automated/case-tests.el (downcase-string): * automated/case-tests.el (uni-mappings): * automated/ccl-tests.el (ccl-test-normal-expr): * automated/ccl-tests.el (ccl-test-map-instructions): * automated/ccl-tests.el (ccl-test-suites): * automated/database-tests.el (delete-database-files): * automated/extent-tests.el (let): * automated/extent-tests.el (insert): * automated/extent-tests.el (props): * automated/file-tests.el: * automated/file-tests.el (for): * automated/hash-table-tests.el (test): * automated/hash-table-tests.el (for): * automated/hash-table-tests.el (ht): * automated/hash-table-tests.el (iterations): * automated/hash-table-tests.el (h1): * automated/hash-table-tests.el (equal): * automated/hash-table-tests.el (=): * automated/lisp-tests.el: * automated/lisp-tests.el (eq): * automated/lisp-tests.el (test-setq): * automated/lisp-tests.el (my-vector): * automated/lisp-tests.el (x): * automated/lisp-tests.el (equal): * automated/lisp-tests.el (y): * automated/lisp-tests.el (featurep): * automated/lisp-tests.el (=): * automated/lisp-tests.el (six): * automated/lisp-tests.el (three): * automated/lisp-tests.el (one): * automated/lisp-tests.el (two): * automated/lisp-tests.el (five): * automated/lisp-tests.el (test1): * automated/lisp-tests.el (division-test): * automated/lisp-tests.el (for): * automated/lisp-tests.el (check-function-argcounts): * automated/lisp-tests.el (z): * automated/lisp-tests.el (eql): * automated/lisp-tests.el (test-harness-risk-infloops): * automated/lisp-tests.el (erase-buffer): * automated/lisp-tests.el (sym): * automated/lisp-tests.el (new-char): * automated/lisp-tests.el (new-load-file-name): * automated/lisp-tests.el (cl-floor): * automated/lisp-tests.el (foo): * automated/md5-tests.el (lambda): * automated/md5-tests.el (large-string): * automated/md5-tests.el (mapcar): * automated/md5-tests.el (insert): * automated/mule-tests.el: * automated/mule-tests.el (test-chars): * automated/mule-tests.el (existing-file-name): * automated/mule-tests.el (featurep): * automated/query-coding-tests.el (featurep): * automated/regexp-tests.el: * automated/regexp-tests.el (insert): * automated/regexp-tests.el (Assert): * automated/regexp-tests.el (=): * automated/regexp-tests.el (featurep): * automated/regexp-tests.el (text): * automated/regexp-tests.el (text1): * automated/regexp-tests.el ("aáa"): * automated/regexp-tests.el (eql): * automated/search-tests.el (insert): * automated/search-tests.el (featurep): * automated/search-tests.el (let): * automated/search-tests.el (boundp): * automated/symbol-tests.el: * automated/symbol-tests.el (name): * automated/symbol-tests.el (check-weak-list-unique): * automated/symbol-tests.el (string): * automated/symbol-tests.el (list): * automated/symbol-tests.el (foo): * automated/symbol-tests.el (eq): * automated/symbol-tests.el (fresh-keyword-name): * automated/symbol-tests.el (print-gensym): * automated/symbol-tests.el (mysym): * automated/syntax-tests.el (test-forward-word): * automated/syntax-tests.el (test-backward-word): * automated/syntax-tests.el (test-syntax-table): * automated/syntax-tests.el (with-syntax-table): * automated/syntax-tests.el (Skip-Test-Unless): * automated/syntax-tests.el (with): * automated/tag-tests.el (testfile): * automated/weak-tests.el (w): * automated/weak-tests.el (p): * automated/weak-tests.el (a): Undo change of e.g. (Assert (equalp ...)) to (Assert-equalp ...). Get rid of `Assert-equalp' and friends, `Assert-test', and `Assert-test-not'. Instead, make `Assert' smart enough to do the equivalent functionality when an expression like (Assert (equalp ...)) is seen.
author Ben Wing <ben@xemacs.org>
date Fri, 12 Mar 2010 18:27:51 -0600
parents 189fb67ca31a
children 308d34e9f07d
comparison
equal deleted inserted replaced
5113:b2dcf6a6d8ab 5136:0f66906b6e37
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)))))