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