Mercurial > hg > xemacs-beta

comparison tests/automated/symbol-tests.el @ 440:8de8e3f6228a r21-2-28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 3ecd8885ac67
children 6728e641994e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
248 248
249 ;;----------------------------------------------------- 249 ;;-----------------------------------------------------
250 ;; Magic symbols 250 ;; Magic symbols
251 ;;----------------------------------------------------- 251 ;;-----------------------------------------------------
252 252
253 ;; Magic symbols are almost totally unimplemented. However, a 253 ;; Magic symbols are only half implemented. However, a subset of the
254 ;; rudimentary subset of the functionality is being used to implement 254 ;; functionality is being used to implement backward compatibility or
255 ;; backward compatibility or clearer error messages for new features 255 ;; clearer error messages for new features such as specifiers and
256 ;; such as specifiers and glyphs. These tests try to test that 256 ;; glyphs. These tests try to test that working subset.
257 ;; working subset. 257
258 258 (let ((mysym (make-symbol "test-symbol"))
259 (let ((mysym (make-symbol "test-symbol"))) 259 save)
260 (dontusethis-set-symbol-value-handler 260 (dontusethis-set-symbol-value-handler
261 mysym 261 mysym
262 'set-value 262 'set-value
263 (lambda (&rest args) 263 (lambda (&rest args)
264 (throw 'test-tag args))) 264 (throw 'test-tag args)))
265 (Assert (not (boundp mysym)))
265 (Assert (equal (catch 'test-tag 266 (Assert (equal (catch 'test-tag
266 (set mysym 'foo)) 267 (set mysym 'foo))
267 `(,mysym (foo) set nil nil)))) 268 `(,mysym (foo) set nil nil)))
268 269 (Assert (not (boundp mysym)))
269 ;; #### These two make XEmacs crash! 270 (dontusethis-set-symbol-value-handler
270 271 mysym
271 ;(let ((mysym (make-symbol "test-symbol"))) 272 'set-value
272 ; (dontusethis-set-symbol-value-handler 273 (lambda (&rest args) (setq save (nth 1 args))))
273 ; mysym 274 (set mysym 'foo)
274 ; 'make-unbound 275 (Assert (equal save '(foo)))
275 ; (lambda (&rest args) 276 (Assert (eq (symbol-value mysym) 'foo))
276 ; (throw 'test-tag args))) 277 )
277 ; (Assert (equal (catch 'test-tag 278
278 ; (set mysym 'foo)) 279 (let ((mysym (make-symbol "test-symbol"))
279 ; `(,mysym (foo) set nil nil)))) 280 save)
281 (dontusethis-set-symbol-value-handler
282 mysym
283 'make-unbound
284 (lambda (&rest args)
285 (throw 'test-tag args)))
286 (Assert (equal (catch 'test-tag
287 (makunbound mysym))
288 `(,mysym nil makunbound nil nil)))
289 (dontusethis-set-symbol-value-handler
290 mysym
291 'make-unbound
292 (lambda (&rest args) (setq save (nth 2 args))))
293 (Assert (not (boundp mysym)))
294 (set mysym 'bar)
295 (Assert (null save))
296 (Assert (eq (symbol-value mysym) 'bar))
297 (makunbound mysym)
298 (Assert (not (boundp mysym)))
299 (Assert (eq save 'makunbound))
300 )
301
302 (when (featurep 'file-coding)
303 (Assert (eq pathname-coding-system file-name-coding-system))
304 (let ((val1 file-name-coding-system)
305 (val2 pathname-coding-system))
306 (Assert (eq val1 val2))
307 (let ((file-name-coding-system 'no-conversion-dos))
308 (Assert (eq file-name-coding-system 'no-conversion-dos))
309 (Assert (eq pathname-coding-system file-name-coding-system)))
310 (let ((pathname-coding-system 'no-conversion-mac))
311 (Assert (eq file-name-coding-system 'no-conversion-mac))
312 (Assert (eq pathname-coding-system file-name-coding-system)))
313 (Assert (eq file-name-coding-system pathname-coding-system))
314 (Assert (eq val1 file-name-coding-system)))
315 (Assert (eq pathname-coding-system file-name-coding-system)))
316
280 317
281 ;(let ((mysym (make-symbol "test-symbol"))) 318 ;(let ((mysym (make-symbol "test-symbol")))
282 ; (dontusethis-set-symbol-value-handler 319 ; (dontusethis-set-symbol-value-handler
283 ; mysym 320 ; mysym
284 ; 'make-local 321 ; 'make-local
285 ; (lambda (&rest args) 322 ; (lambda (&rest args)
286 ; (throw 'test-tag args))) 323 ; (throw 'test-tag args)))
287 ; (Assert (equal (catch 'test-tag 324 ; (Assert (equal (catch 'test-tag
288 ; (set mysym 'foo)) 325 ; (set mysym 'foo))
289 ; `(,mysym (foo) set nil nil)))) 326 ; `(,mysym (foo) make-local nil nil))))