diff options
Diffstat (limited to 'test/lisp/allout-tests.el')
| -rw-r--r-- | test/lisp/allout-tests.el | 148 |
1 files changed, 148 insertions, 0 deletions
diff --git a/test/lisp/allout-tests.el b/test/lisp/allout-tests.el new file mode 100644 index 00000000000..4c3fd9c5dc6 --- /dev/null +++ b/test/lisp/allout-tests.el @@ -0,0 +1,148 @@ +;;; allout-tests.el --- Tests for allout.el -*- lexical-binding: t -*- + +;; Copyright (C) 2020-2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'allout) + +(require 'cl-lib) + +(defun allout-tests-obliterate-variable (name) + "Completely unbind variable with NAME." + (if (local-variable-p name (current-buffer)) (kill-local-variable name)) + (while (boundp name) (makunbound name))) + +(defvar allout-tests-globally-unbound nil + "Fodder for allout resumptions tests -- defvar just for byte compiler.") +(defvar allout-tests-globally-true nil + "Fodder for allout resumptions tests -- defvar just for byte compiler.") +(defvar allout-tests-locally-true nil + "Fodder for allout resumptions tests -- defvar just for byte compiler.") + +;; For each resumption case, we also test that the right local/global +;; scopes are affected during resumption effects. + +(ert-deftest allout-test-resumption-unbound-return-to-unbound () + "Previously unbound variables return to the unbound state." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-add-resumptions '(allout-tests-globally-unbound t)) + (should (not (default-boundp 'allout-tests-globally-unbound))) + (should (local-variable-p 'allout-tests-globally-unbound (current-buffer))) + (should (boundp 'allout-tests-globally-unbound)) + (should (equal allout-tests-globally-unbound t)) + (allout-do-resumptions) + (should (not (local-variable-p 'allout-tests-globally-unbound + (current-buffer)))) + (should (not (boundp 'allout-tests-globally-unbound))))) + +(ert-deftest allout-test-resumption-variable-resumed () + "Ensure that variable with prior global value is resumed." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-add-resumptions '(allout-tests-globally-true nil)) + (should (equal (default-value 'allout-tests-globally-true) t)) + (should (local-variable-p 'allout-tests-globally-true (current-buffer))) + (should (equal allout-tests-globally-true nil)) + (allout-do-resumptions) + (should (not (local-variable-p 'allout-tests-globally-true + (current-buffer)))) + (should (boundp 'allout-tests-globally-true)) + (should (equal allout-tests-globally-true t)))) + +(ert-deftest allout-test-resumption-prior-value-resumed () + "Ensure that prior local value is resumed." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (setq-local allout-tests-locally-true t) + (cl-assert (not (default-boundp 'allout-tests-locally-true)) + nil (concat "Test setup mistake -- variable supposed to" + " not have global binding, but it does.")) + (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)) + nil (concat "Test setup mistake -- variable supposed to have" + " local binding, but it lacks one.")) + (allout-add-resumptions '(allout-tests-locally-true nil)) + (should (not (default-boundp 'allout-tests-locally-true))) + (should (local-variable-p 'allout-tests-locally-true (current-buffer))) + (should (equal allout-tests-locally-true nil)) + (allout-do-resumptions) + (should (boundp 'allout-tests-locally-true)) + (should (local-variable-p 'allout-tests-locally-true (current-buffer))) + (should (equal allout-tests-locally-true t)) + (should (not (default-boundp 'allout-tests-locally-true))))) + +(ert-deftest allout-test-resumption-multiple-holds () + "Ensure that last of multiple resumptions holds, for various scopes." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (setq-local allout-tests-locally-true t) + (allout-add-resumptions '(allout-tests-globally-unbound t) + '(allout-tests-globally-true nil) + '(allout-tests-locally-true nil)) + (allout-add-resumptions '(allout-tests-globally-unbound 2) + '(allout-tests-globally-true 3) + '(allout-tests-locally-true 4)) + ;; reestablish many of the basic conditions are maintained after re-add: + (should (not (default-boundp 'allout-tests-globally-unbound))) + (should (local-variable-p 'allout-tests-globally-unbound (current-buffer))) + (should (equal allout-tests-globally-unbound 2)) + (should (default-boundp 'allout-tests-globally-true)) + (should (local-variable-p 'allout-tests-globally-true (current-buffer))) + (should (equal allout-tests-globally-true 3)) + (should (not (default-boundp 'allout-tests-locally-true))) + (should (local-variable-p 'allout-tests-locally-true (current-buffer))) + (should (equal allout-tests-locally-true 4)) + (allout-do-resumptions) + (should (not (local-variable-p 'allout-tests-globally-unbound + (current-buffer)))) + (should (not (boundp 'allout-tests-globally-unbound))) + (should (not (local-variable-p 'allout-tests-globally-true + (current-buffer)))) + (should (boundp 'allout-tests-globally-true)) + (should (equal allout-tests-globally-true t)) + (should (boundp 'allout-tests-locally-true)) + (should (local-variable-p 'allout-tests-locally-true (current-buffer))) + (should (equal allout-tests-locally-true t)) + (should (not (default-boundp 'allout-tests-locally-true))))) + +(ert-deftest allout-test-resumption-unbinding () + "Ensure that deliberately unbinding registered variables doesn't foul things." + (with-temp-buffer + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (setq allout-tests-globally-true t) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (setq-local allout-tests-locally-true t) + (allout-add-resumptions '(allout-tests-globally-unbound t) + '(allout-tests-globally-true nil) + '(allout-tests-locally-true nil)) + (allout-tests-obliterate-variable 'allout-tests-globally-unbound) + (allout-tests-obliterate-variable 'allout-tests-globally-true) + (allout-tests-obliterate-variable 'allout-tests-locally-true) + (allout-do-resumptions))) + +(provide 'allout-tests) +;;; allout-tests.el ends here |