mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-05 22:20:24 -08:00
Convert allout unit tests to ERT
* 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.
This commit is contained in:
Stefan Kangas
parent
acf958667b
commit
610b771d4a
4 changed files with 236 additions and 230 deletions
|
|
@ -209,21 +209,6 @@ See `allout-widgets-mode' for allout widgets mode features."
|
|||
: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.
|
||||
|
|
@ -1353,64 +1338,6 @@ FROM and TO must be in increasing order, as must be the pairs in RANGES."
|
|||
(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.
|
||||
|
|
@ -2380,18 +2307,6 @@ The elements of LIST are not copied, just the list structure itself."
|
|||
(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)
|
||||
|
||||
|
|
|
|||
146
lisp/allout.el
146
lisp/allout.el
|
|
@ -77,7 +77,6 @@
|
|||
|
||||
;;;_* Dependency loads
|
||||
(require 'overlay)
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
;;;_* USER CUSTOMIZATION VARIABLES:
|
||||
|
||||
|
|
@ -840,20 +839,6 @@ for restoring when all encryptions are established.")
|
|||
(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
|
||||
|
|
@ -6518,136 +6503,7 @@ If BEG is bigger than END we return 0."
|
|||
(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.
|
||||
|
|
|
|||
148
test/lisp/allout-tests.el
Normal file
148
test/lisp/allout-tests.el
Normal file
|
|
@ -0,0 +1,148 @@
|
|||
;;; 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
|
||||
87
test/lisp/allout-widgets-tests.el
Normal file
87
test/lisp/allout-widgets-tests.el
Normal file
|
|
@ -0,0 +1,87 @@
|
|||
;;; 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
|
||||
Loading…
Add table
Add a link
Reference in a new issue