1;;; allout-tests.el --- Tests for allout.el -*- lexical-binding: t -*- 2 3;; Copyright (C) 2020-2021 Free Software Foundation, Inc. 4 5;; This file is part of GNU Emacs. 6 7;; GNU Emacs is free software: you can redistribute it and/or modify 8;; it under the terms of the GNU General Public License as published by 9;; the Free Software Foundation, either version 3 of the License, or 10;; (at your option) any later version. 11 12;; GNU Emacs is distributed in the hope that it will be useful, 13;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15;; GNU General Public License for more details. 16 17;; You should have received a copy of the GNU General Public License 18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 19 20;;; Commentary: 21 22;;; Code: 23 24(require 'ert) 25(require 'allout) 26 27(require 'cl-lib) 28 29(defun allout-tests-obliterate-variable (name) 30 "Completely unbind variable with NAME." 31 (if (local-variable-p name (current-buffer)) (kill-local-variable name)) 32 (while (boundp name) (makunbound name))) 33 34(defvar allout-tests-globally-unbound nil 35 "Fodder for allout resumptions tests -- defvar just for byte compiler.") 36(defvar allout-tests-globally-true nil 37 "Fodder for allout resumptions tests -- defvar just for byte compiler.") 38(defvar allout-tests-locally-true nil 39 "Fodder for allout resumptions tests -- defvar just for byte compiler.") 40 41;; For each resumption case, we also test that the right local/global 42;; scopes are affected during resumption effects. 43 44(ert-deftest allout-test-resumption-unbound-return-to-unbound () 45 "Previously unbound variables return to the unbound state." 46 (with-temp-buffer 47 (allout-tests-obliterate-variable 'allout-tests-globally-unbound) 48 (allout-add-resumptions '(allout-tests-globally-unbound t)) 49 (should (not (default-boundp 'allout-tests-globally-unbound))) 50 (should (local-variable-p 'allout-tests-globally-unbound (current-buffer))) 51 (should (boundp 'allout-tests-globally-unbound)) 52 (should (equal allout-tests-globally-unbound t)) 53 (allout-do-resumptions) 54 (should (not (local-variable-p 'allout-tests-globally-unbound 55 (current-buffer)))) 56 (should (not (boundp 'allout-tests-globally-unbound))))) 57 58(ert-deftest allout-test-resumption-variable-resumed () 59 "Ensure that variable with prior global value is resumed." 60 (with-temp-buffer 61 (allout-tests-obliterate-variable 'allout-tests-globally-true) 62 (setq allout-tests-globally-true t) 63 (allout-add-resumptions '(allout-tests-globally-true nil)) 64 (should (equal (default-value 'allout-tests-globally-true) t)) 65 (should (local-variable-p 'allout-tests-globally-true (current-buffer))) 66 (should (equal allout-tests-globally-true nil)) 67 (allout-do-resumptions) 68 (should (not (local-variable-p 'allout-tests-globally-true 69 (current-buffer)))) 70 (should (boundp 'allout-tests-globally-true)) 71 (should (equal allout-tests-globally-true t)))) 72 73(ert-deftest allout-test-resumption-prior-value-resumed () 74 "Ensure that prior local value is resumed." 75 (with-temp-buffer 76 (allout-tests-obliterate-variable 'allout-tests-locally-true) 77 (setq-local allout-tests-locally-true t) 78 (cl-assert (not (default-boundp 'allout-tests-locally-true)) 79 nil (concat "Test setup mistake -- variable supposed to" 80 " not have global binding, but it does.")) 81 (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)) 82 nil (concat "Test setup mistake -- variable supposed to have" 83 " local binding, but it lacks one.")) 84 (allout-add-resumptions '(allout-tests-locally-true nil)) 85 (should (not (default-boundp 'allout-tests-locally-true))) 86 (should (local-variable-p 'allout-tests-locally-true (current-buffer))) 87 (should (equal allout-tests-locally-true nil)) 88 (allout-do-resumptions) 89 (should (boundp 'allout-tests-locally-true)) 90 (should (local-variable-p 'allout-tests-locally-true (current-buffer))) 91 (should (equal allout-tests-locally-true t)) 92 (should (not (default-boundp 'allout-tests-locally-true))))) 93 94(ert-deftest allout-test-resumption-multiple-holds () 95 "Ensure that last of multiple resumptions holds, for various scopes." 96 (with-temp-buffer 97 (allout-tests-obliterate-variable 'allout-tests-globally-unbound) 98 (allout-tests-obliterate-variable 'allout-tests-globally-true) 99 (setq allout-tests-globally-true t) 100 (allout-tests-obliterate-variable 'allout-tests-locally-true) 101 (setq-local allout-tests-locally-true t) 102 (allout-add-resumptions '(allout-tests-globally-unbound t) 103 '(allout-tests-globally-true nil) 104 '(allout-tests-locally-true nil)) 105 (allout-add-resumptions '(allout-tests-globally-unbound 2) 106 '(allout-tests-globally-true 3) 107 '(allout-tests-locally-true 4)) 108 ;; reestablish many of the basic conditions are maintained after re-add: 109 (should (not (default-boundp 'allout-tests-globally-unbound))) 110 (should (local-variable-p 'allout-tests-globally-unbound (current-buffer))) 111 (should (equal allout-tests-globally-unbound 2)) 112 (should (default-boundp 'allout-tests-globally-true)) 113 (should (local-variable-p 'allout-tests-globally-true (current-buffer))) 114 (should (equal allout-tests-globally-true 3)) 115 (should (not (default-boundp 'allout-tests-locally-true))) 116 (should (local-variable-p 'allout-tests-locally-true (current-buffer))) 117 (should (equal allout-tests-locally-true 4)) 118 (allout-do-resumptions) 119 (should (not (local-variable-p 'allout-tests-globally-unbound 120 (current-buffer)))) 121 (should (not (boundp 'allout-tests-globally-unbound))) 122 (should (not (local-variable-p 'allout-tests-globally-true 123 (current-buffer)))) 124 (should (boundp 'allout-tests-globally-true)) 125 (should (equal allout-tests-globally-true t)) 126 (should (boundp 'allout-tests-locally-true)) 127 (should (local-variable-p 'allout-tests-locally-true (current-buffer))) 128 (should (equal allout-tests-locally-true t)) 129 (should (not (default-boundp 'allout-tests-locally-true))))) 130 131(ert-deftest allout-test-resumption-unbinding () 132 "Ensure that deliberately unbinding registered variables doesn't foul things." 133 (with-temp-buffer 134 (allout-tests-obliterate-variable 'allout-tests-globally-unbound) 135 (allout-tests-obliterate-variable 'allout-tests-globally-true) 136 (setq allout-tests-globally-true t) 137 (allout-tests-obliterate-variable 'allout-tests-locally-true) 138 (setq-local allout-tests-locally-true t) 139 (allout-add-resumptions '(allout-tests-globally-unbound t) 140 '(allout-tests-globally-true nil) 141 '(allout-tests-locally-true nil)) 142 (allout-tests-obliterate-variable 'allout-tests-globally-unbound) 143 (allout-tests-obliterate-variable 'allout-tests-globally-true) 144 (allout-tests-obliterate-variable 'allout-tests-locally-true) 145 (allout-do-resumptions))) 146 147(provide 'allout-tests) 148;;; allout-tests.el ends here 149