Mercurial > hg > xemacs-beta
diff tests/automated/symbol-tests.el @ 440:8de8e3f6228a r21-2-28
Import from CVS: tag r21-2-28
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:33:38 +0200 |
parents | 3ecd8885ac67 |
children | 6728e641994e |
line wrap: on
line diff
--- a/tests/automated/symbol-tests.el Mon Aug 13 11:32:27 2007 +0200 +++ b/tests/automated/symbol-tests.el Mon Aug 13 11:33:38 2007 +0200 @@ -250,33 +250,70 @@ ;; Magic symbols ;;----------------------------------------------------- -;; Magic symbols are almost totally unimplemented. However, a -;; rudimentary subset of the functionality is being used to implement -;; backward compatibility or clearer error messages for new features -;; such as specifiers and glyphs. These tests try to test that -;; working subset. +;; Magic symbols are only half implemented. However, a subset of the +;; functionality is being used to implement backward compatibility or +;; clearer error messages for new features such as specifiers and +;; glyphs. These tests try to test that working subset. -(let ((mysym (make-symbol "test-symbol"))) +(let ((mysym (make-symbol "test-symbol")) + save) (dontusethis-set-symbol-value-handler mysym 'set-value (lambda (&rest args) (throw 'test-tag args))) + (Assert (not (boundp mysym))) (Assert (equal (catch 'test-tag (set mysym 'foo)) - `(,mysym (foo) set nil nil)))) - -;; #### These two make XEmacs crash! + `(,mysym (foo) set nil nil))) + (Assert (not (boundp mysym))) + (dontusethis-set-symbol-value-handler + mysym + 'set-value + (lambda (&rest args) (setq save (nth 1 args)))) + (set mysym 'foo) + (Assert (equal save '(foo))) + (Assert (eq (symbol-value mysym) 'foo)) + ) -;(let ((mysym (make-symbol "test-symbol"))) -; (dontusethis-set-symbol-value-handler -; mysym -; 'make-unbound -; (lambda (&rest args) -; (throw 'test-tag args))) -; (Assert (equal (catch 'test-tag -; (set mysym 'foo)) -; `(,mysym (foo) set nil nil)))) +(let ((mysym (make-symbol "test-symbol")) + save) + (dontusethis-set-symbol-value-handler + mysym + 'make-unbound + (lambda (&rest args) + (throw 'test-tag args))) + (Assert (equal (catch 'test-tag + (makunbound mysym)) + `(,mysym nil makunbound nil nil))) + (dontusethis-set-symbol-value-handler + mysym + 'make-unbound + (lambda (&rest args) (setq save (nth 2 args)))) + (Assert (not (boundp mysym))) + (set mysym 'bar) + (Assert (null save)) + (Assert (eq (symbol-value mysym) 'bar)) + (makunbound mysym) + (Assert (not (boundp mysym))) + (Assert (eq save 'makunbound)) + ) + +(when (featurep 'file-coding) + (Assert (eq pathname-coding-system file-name-coding-system)) + (let ((val1 file-name-coding-system) + (val2 pathname-coding-system)) + (Assert (eq val1 val2)) + (let ((file-name-coding-system 'no-conversion-dos)) + (Assert (eq file-name-coding-system 'no-conversion-dos)) + (Assert (eq pathname-coding-system file-name-coding-system))) + (let ((pathname-coding-system 'no-conversion-mac)) + (Assert (eq file-name-coding-system 'no-conversion-mac)) + (Assert (eq pathname-coding-system file-name-coding-system))) + (Assert (eq file-name-coding-system pathname-coding-system)) + (Assert (eq val1 file-name-coding-system))) + (Assert (eq pathname-coding-system file-name-coding-system))) + ;(let ((mysym (make-symbol "test-symbol"))) ; (dontusethis-set-symbol-value-handler @@ -286,4 +323,4 @@ ; (throw 'test-tag args))) ; (Assert (equal (catch 'test-tag ; (set mysym 'foo)) -; `(,mysym (foo) set nil nil)))) +; `(,mysym (foo) make-local nil nil))))