test/binding-testsuite.el

   1 (defvar binding-test-buffer-A (get-buffer-create "A"))
   2 (defvar binding-test-buffer-B (get-buffer-create "B"))
   3
   4 (defvar binding-test-always-local 'always)
   5 (make-variable-buffer-local 'binding-test-always-local)
   6
   7 (defvar binding-test-some-local 'some)
   8 (with-current-buffer binding-test-buffer-A
   9   (set (make-local-variable 'binding-test-some-local) 'local))
  10
  11 (defvar fails 0)
  12 (defvar total 0)
  13
  14 (defun check (v name)
  15   (if v
  16       (message "PASS: %s" name)
  17     (message "FAIL: %s" name)
  18     (setq fails (1+ fails)))
  19   (setq total (1+ total)))
  20
  21 (defun binding-test-manual ()
  22   "A test case from the elisp manual."
  23   (set-buffer binding-test-buffer-A)
  24   (let ((binding-test-some-local 'something-else))
  25     (check (eq binding-test-some-local 'something-else)
  26            "let binding failed")
  27     (set-buffer binding-test-buffer-B)
  28     (check (eq binding-test-some-local 'some)
  29            "set-buffer failed to rebind"))
  30   (check (eq binding-test-some-local 'some)
  31          "let erroneously rebound")
  32   (set-buffer binding-test-buffer-A)
  33   (check (eq binding-test-some-local 'local)
  34          "let failed to unbind"))
  35
  36 (defun binding-test-setq-default ()
  37   "Test that a setq-default has no effect when there is a local binding."
  38   (set-buffer binding-test-buffer-B)
  39   ;; This variable is not local in this buffer.
  40   (let ((binding-test-some-local 'something-else))
  41     (setq-default binding-test-some-local 'new-default))
  42   (check (eq binding-test-some-local 'some)
  43          "set-buffer failed to rebind"))
  44
  45 (defun binding-test-makunbound ()
  46   "Tests of makunbound, from the manual."
  47   (set-buffer binding-test-buffer-B)
  48   (check (boundp 'binding-test-some-local)
  49          "verify variable is bound")
  50   (let ((binding-test-some-local 'outer))
  51     (let ((binding-test-some-local 'inner))
  52       (makunbound 'binding-test-some-local)
  53       (check (not (boundp 'binding-test-some-local))
  54              "verify variable is unbound"))
  55     (check (and (boundp 'binding-test-some-local)
  56                 (eq binding-test-some-local 'outer))
  57            "verify variable is bound again")))
  58
  59 (defun binding-test-defvar-bool ()
  60   "Test DEFVAR_BOOL"
  61   (let ((display-hourglass 5))
  62     (check (eq display-hourglass t)
  63            "DEFVAR_BOOL value rewriting")))
  64
  65 (defun binding-test-defvar-int ()
  66   "Test DEFVAR_INT"
  67   (check (condition-case nil
  68              (progn (setq window-min-height 5.0)
  69                     nil)
  70            (wrong-type-argument t))
  71          "DEFVAR_INT with wrong type"))
  72
  73 (defun binding-test-set-constant ()
  74   "Test setting a constant"
  75   (check (condition-case nil
  76              (progn (setq t 'bob)
  77                     nil)
  78            (setting-constant t))
  79          "Setting t")
  80   (check (condition-case nil
  81              (progn (setq nil 'bob)
  82                     nil)
  83            (setting-constant t))
  84          "Setting nil")
  85   (check (condition-case nil
  86              (progn (setq :keyword 'bob)
  87                     nil)
  88            (setting-constant t))
  89          "Setting keyword")
  90   (check (condition-case nil
  91              (progn (setq :keyword :keyword)
  92                     t)
  93            (setting-constant nil))
  94          "Setting keyword to itself"))
  95
  96 ;; kill-local-variable
  97 ;; defconst; can modify
  98 ;; defvar and defconst modify the local binding [ doesn't matter for us ]
  99 ;; various kinds of special internal forwarding objects
 100 ;;   a couple examples in manual, not enough
 101 ;; frame-local vars
 102 ;; variable aliases
 103
 104 (defun binding-test-all ()
 105   (save-excursion (binding-test-manual))
 106   (save-excursion (binding-test-setq-default))
 107   (save-excursion (binding-test-makunbound))
 108   (binding-test-defvar-bool)
 109   (binding-test-defvar-int)
 110   (binding-test-set-constant)
 111
 112   (if (eq fails 0)
 113       (message "All %d binding tests passed" total)
 114     (message "%d/%d binding tests failed" fails total)))