From: Tom Tromey <tromey@redhat.com>
Date: Wed, 9 Sep 2009 17:48:02 +0000 (+0200)
Subject: Added a small test suite for binding operations.
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e3025288974b478e6d591313868d0ded9bd3d269;p=emacs.git

Added a small test suite for binding operations.

Run it like: emacs --batch -l binding-testsuite.el -f binding-test-all
---

diff --git a/test/binding-testsuite.el b/test/binding-testsuite.el
new file mode 100644
index 00000000000..257ea428deb
--- /dev/null
+++ b/test/binding-testsuite.el
@@ -0,0 +1,114 @@
+(defvar binding-test-buffer-A (get-buffer-create "A"))
+(defvar binding-test-buffer-B (get-buffer-create "B"))
+
+(defvar binding-test-always-local 'always)
+(make-variable-buffer-local 'binding-test-always-local)
+
+(defvar binding-test-some-local 'some)
+(with-current-buffer binding-test-buffer-A
+  (set (make-local-variable 'binding-test-some-local) 'local))
+
+(defvar fails 0)
+(defvar total 0)
+
+(defun check (v name)
+  (if v
+      (message "PASS: %s" name)
+    (message "FAIL: %s" name)
+    (setq fails (1+ fails)))
+  (setq total (1+ total)))
+
+(defun binding-test-manual ()
+  "A test case from the elisp manual."
+  (set-buffer binding-test-buffer-A)
+  (let ((binding-test-some-local 'something-else))
+    (check (eq binding-test-some-local 'something-else)
+	   "let binding failed")
+    (set-buffer binding-test-buffer-B)
+    (check (eq binding-test-some-local 'some)
+	   "set-buffer failed to rebind"))
+  (check (eq binding-test-some-local 'some)
+	 "let erroneously rebound")
+  (set-buffer binding-test-buffer-A)
+  (check (eq binding-test-some-local 'local)
+	 "let failed to unbind"))
+
+(defun binding-test-setq-default ()
+  "Test that a setq-default has no effect when there is a local binding."
+  (set-buffer binding-test-buffer-B)
+  ;; This variable is not local in this buffer.
+  (let ((binding-test-some-local 'something-else))
+    (setq-default binding-test-some-local 'new-default))
+  (check (eq binding-test-some-local 'some)
+	 "set-buffer failed to rebind"))
+
+(defun binding-test-makunbound ()
+  "Tests of makunbound, from the manual."
+  (set-buffer binding-test-buffer-B)
+  (check (boundp 'binding-test-some-local)
+	 "verify variable is bound")
+  (let ((binding-test-some-local 'outer))
+    (let ((binding-test-some-local 'inner))
+      (makunbound 'binding-test-some-local)
+      (check (not (boundp 'binding-test-some-local))
+	     "verify variable is unbound"))
+    (check (and (boundp 'binding-test-some-local)
+		(eq binding-test-some-local 'outer))
+	   "verify variable is bound again")))
+
+(defun binding-test-defvar-bool ()
+  "Test DEFVAR_BOOL"
+  (let ((display-hourglass 5))
+    (check (eq display-hourglass t)
+	   "DEFVAR_BOOL value rewriting")))
+
+(defun binding-test-defvar-int ()
+  "Test DEFVAR_INT"
+  (check (condition-case nil
+	     (progn (setq window-min-height 5.0)
+		    nil)
+	   (wrong-type-argument t))
+	 "DEFVAR_INT with wrong type"))
+
+(defun binding-test-set-constant ()
+  "Test setting a constant"
+  (check (condition-case nil
+	     (progn (setq t 'bob)
+		    nil)
+	   (setting-constant t))
+	 "Setting t")
+  (check (condition-case nil
+	     (progn (setq nil 'bob)
+		    nil)
+	   (setting-constant t))
+	 "Setting nil")
+  (check (condition-case nil
+	     (progn (setq :keyword 'bob)
+		    nil)
+	   (setting-constant t))
+	 "Setting keyword")
+  (check (condition-case nil
+	     (progn (setq :keyword :keyword)
+		    t)
+	   (setting-constant nil))
+	 "Setting keyword to itself"))
+
+;; kill-local-variable
+;; defconst; can modify
+;; defvar and defconst modify the local binding [ doesn't matter for us ]
+;; various kinds of special internal forwarding objects
+;;   a couple examples in manual, not enough
+;; frame-local vars
+;; variable aliases
+
+(defun binding-test-all ()
+  (save-excursion (binding-test-manual))
+  (save-excursion (binding-test-setq-default))
+  (save-excursion (binding-test-makunbound))
+  (binding-test-defvar-bool)
+  (binding-test-defvar-int)
+  (binding-test-set-constant)
+
+  (if (eq fails 0)
+      (message "All %d binding tests passed" total)
+    (message "%d/%d binding tests failed" fails total)))