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))))