* test/lisp/allout-tests.el: New file.
* lisp/allout.el (allout-run-unit-tests-on-load)
(allout-run-unit-tests): Remove.
(allout-tests-obliterate-variable)
(allout-tests-globally-unbound, allout-tests-globally-true)
(allout-tests-locally-true, allout-test-resumptions): Move to
allout-tests.el
* test/lisp/allout-widgets-tests.el: New file.
* lisp/allout-widgets.el (allout-widgets-run-unit-tests-on-load)
(allout-widgets-run-unit-tests): Remove.
(allout-test-range-overlaps): Move to allout-widgets-tests.el.
:group 'allout-widgets)
(make-obsolete-variable 'allout-widgets-item-image-properties-xemacs nil "28.1")
;;;_ . Developer
-;;;_ = allout-widgets-run-unit-tests-on-load
-(defcustom allout-widgets-run-unit-tests-on-load nil
- "When non-nil, unit tests will be run at end of loading allout-widgets.
-
-Generally, allout widgets code developers are the only ones who'll want to
-set this.
-
-\(If set, this makes it an even better practice to exercise changes by
-doing byte-compilation with a repeat count, so the file is loaded after
-compilation.)
-
-See `allout-widgets-run-unit-tests' to see what's run."
- :version "24.1"
- :type 'boolean
- :group 'allout-widgets-developer)
;;;_ = allout-widgets-time-decoration-activity
(defcustom allout-widgets-time-decoration-activity nil
"Retain timing info of the last cooperative redecoration.
(setq new-ranges (nreverse new-ranges))
(if ranges (setq new-ranges (append new-ranges ranges)))
(list (if included-from t) new-ranges)))
-;;;_ > allout-test-range-overlaps ()
-(defun allout-test-range-overlaps ()
- "`allout-range-overlaps' unit tests."
- (let* (ranges
- got
- (try (lambda (from to)
- (setq got (allout-range-overlaps from to ranges))
- (setq ranges (cadr got))
- got)))
-;; ;; biggie:
-;; (setq ranges nil)
-;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall
-;; ;; ~ 13 seconds for doing repeated funcall
-;; (message "time-trial: %s, resulting size %s"
-;; (time-trial
-;; '(let ((size 10000)
-;; doing)
-;; (dotimes (count size)
-;; (setq doing (random size))
-;; (funcall try doing (+ doing (random 5)))
-;; ;;(list doing (+ doing (random 5)))
-;; )))
-;; (length ranges))
-;; (sit-for 2)
-
- ;; fresh:
- (setq ranges nil)
- (cl-assert (equal (funcall try 3 5) '(nil ((3 5)))))
- ;; add range at end:
- (cl-assert (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
- ;; add range at beginning:
- (cl-assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
- ;; insert range somewhere in the middle:
- (cl-assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
- ;; consolidate some:
- (cl-assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
- ;; add more:
- (cl-assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
- ;; add more:
- (cl-assert (equal (funcall try 20 22)
- '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
- ;; encompass more:
- (cl-assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
- ;; encompass all:
- (cl-assert (equal (funcall try 2 25) '(t ((1 25)))))
-
- ;; fresh slate:
- (setq ranges nil)
- (cl-assert (equal (funcall try 20 25) '(nil ((20 25)))))
- (cl-assert (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
- (cl-assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
- (cl-assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
- (cl-assert (equal (funcall try 10 30) '(t ((10 35)))))
- (cl-assert (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
- (cl-assert (equal (funcall try 2 100) '(t ((2 100)))))
-
- (setq ranges nil)
- ))
;;;_ > allout-widgetize-buffer (&optional doing)
(defun allout-widgetize-buffer (&optional doing)
"EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree.
(overlays-in start end)))))
(length button-overlays)))
-;;;_ : Run unit tests:
-(defun allout-widgets-run-unit-tests ()
- (message "Running allout-widget tests...")
-
- (allout-test-range-overlaps)
-
- (message "Running allout-widget tests... Done.")
- (sit-for .5))
-
-(when allout-widgets-run-unit-tests-on-load
- (allout-widgets-run-unit-tests))
-
;;;_ : provide
(provide 'allout-widgets)
;;;_* Dependency loads
(require 'overlay)
-(eval-when-compile (require 'cl-lib))
;;;_* USER CUSTOMIZATION VARIABLES:
(defgroup allout-developer nil
"Allout settings developers care about, including topic encryption and more."
:group 'allout)
-;;;_ = allout-run-unit-tests-on-load
-(defcustom allout-run-unit-tests-on-load nil
- "When non-nil, unit tests will be run at end of loading the allout module.
-
-Generally, allout code developers are the only ones who'll want to set this.
-
-\(If set, this makes it an even better practice to exercise changes by
-doing byte-compilation with a repeat count, so the file is loaded after
-compilation.)
-
-See `allout-run-unit-tests' to see what's run."
- :type 'boolean
- :group 'allout-developer)
-
;;;_ + Miscellaneous customization
;;;_ = allout-enable-file-variable-adjustment
(isearch-repeat 'forward)
(isearch-mode t)))
-;;;_ #11 Unit tests -- this should be last item before "Provide"
-;;;_ > allout-run-unit-tests ()
-(defun allout-run-unit-tests ()
- "Run the various allout unit tests."
- (message "Running allout tests...")
- (allout-test-resumptions)
- (message "Running allout tests... Done.")
- (sit-for .5))
-;;;_ : test resumptions:
-;;;_ > allout-tests-obliterate-variable (name)
-(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)))
-;;;_ > allout-test-resumptions ()
-(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.")
-(defun allout-test-resumptions ()
- ;; FIXME: Use ERT.
- "Exercise allout resumptions."
- ;; for each resumption case, we also test that the right local/global
- ;; scopes are affected during resumption effects:
-
- ;; ensure that 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))
- (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
- (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
- (cl-assert (boundp 'allout-tests-globally-unbound))
- (cl-assert (equal allout-tests-globally-unbound t))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
- (current-buffer))))
- (cl-assert (not (boundp 'allout-tests-globally-unbound))))
-
- ;; 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))
- (cl-assert (equal (default-value 'allout-tests-globally-true) t))
- (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
- (cl-assert (equal allout-tests-globally-true nil))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-true
- (current-buffer))))
- (cl-assert (boundp 'allout-tests-globally-true))
- (cl-assert (equal allout-tests-globally-true t)))
-
- ;; ensure that prior local value is resumed
- (with-temp-buffer
- (allout-tests-obliterate-variable 'allout-tests-locally-true)
- (set (make-local-variable '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))
- (cl-assert (not (default-boundp 'allout-tests-locally-true)))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true nil))
- (allout-do-resumptions)
- (cl-assert (boundp 'allout-tests-locally-true))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true t))
- (cl-assert (not (default-boundp 'allout-tests-locally-true))))
-
- ;; 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)
- (set (make-local-variable '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:
- (cl-assert (not (default-boundp 'allout-tests-globally-unbound)))
- (cl-assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
- (cl-assert (equal allout-tests-globally-unbound 2))
- (cl-assert (default-boundp 'allout-tests-globally-true))
- (cl-assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
- (cl-assert (equal allout-tests-globally-true 3))
- (cl-assert (not (default-boundp 'allout-tests-locally-true)))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true 4))
- (allout-do-resumptions)
- (cl-assert (not (local-variable-p 'allout-tests-globally-unbound
- (current-buffer))))
- (cl-assert (not (boundp 'allout-tests-globally-unbound)))
- (cl-assert (not (local-variable-p 'allout-tests-globally-true
- (current-buffer))))
- (cl-assert (boundp 'allout-tests-globally-true))
- (cl-assert (equal allout-tests-globally-true t))
- (cl-assert (boundp 'allout-tests-locally-true))
- (cl-assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
- (cl-assert (equal allout-tests-locally-true t))
- (cl-assert (not (default-boundp 'allout-tests-locally-true))))
-
- ;; 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)
- (set (make-local-variable '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))
- )
-;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true:
-(when allout-run-unit-tests-on-load
- (allout-run-unit-tests))
-
-;;;_ #12 Provide
+;;;_ #11 Provide
(provide 'allout)
;;;_* Local emacs vars.
--- /dev/null
+;;; allout-tests.el --- Tests for allout.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 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)
+ (set (make-local-variable '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)
+ (set (make-local-variable '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)
+ (set (make-local-variable '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
--- /dev/null
+;;; allout-widgets-tests.el --- Tests for allout-widgets.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 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-widgets)
+
+(require 'cl-lib)
+
+(ert-deftest allout-test-range-overlaps ()
+ "`allout-range-overlaps' unit tests."
+ (let* (ranges
+ got
+ (try (lambda (from to)
+ (setq got (allout-range-overlaps from to ranges))
+ (setq ranges (cadr got))
+ got)))
+;; ;; biggie:
+;; (setq ranges nil)
+;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall
+;; ;; ~ 13 seconds for doing repeated funcall
+;; (message "time-trial: %s, resulting size %s"
+;; (time-trial
+;; '(let ((size 10000)
+;; doing)
+;; (dotimes (count size)
+;; (setq doing (random size))
+;; (funcall try doing (+ doing (random 5)))
+;; ;;(list doing (+ doing (random 5)))
+;; )))
+;; (length ranges))
+;; (sit-for 2)
+
+ ;; fresh:
+ (setq ranges nil)
+ (should (equal (funcall try 3 5) '(nil ((3 5)))))
+ ;; add range at end:
+ (should (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
+ ;; add range at beginning:
+ (should (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
+ ;; insert range somewhere in the middle:
+ (should (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
+ ;; consolidate some:
+ (should (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
+ ;; add more:
+ (should (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
+ ;; add more:
+ (should (equal (funcall try 20 22)
+ '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
+ ;; encompass more:
+ (should (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
+ ;; encompass all:
+ (should (equal (funcall try 2 25) '(t ((1 25)))))
+
+ ;; fresh slate:
+ (setq ranges nil)
+ (should (equal (funcall try 20 25) '(nil ((20 25)))))
+ (should (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
+ (should (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
+ (should (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
+ (should (equal (funcall try 10 30) '(t ((10 35)))))
+ (should (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
+ (should (equal (funcall try 2 100) '(t ((2 100)))))
+
+ (setq ranges nil)))
+
+(provide 'allout-widgets-tests)
+;;; allout-widgets-tests.el ends here
projects / emacs.git / commitdiff