emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 610b771 2/4: Convert allout unit tests to ERT


From: Stefan Kangas
Subject: master 610b771 2/4: Convert allout unit tests to ERT
Date: Wed, 23 Sep 2020 14:57:19 -0400 (EDT)

branch: master
commit 610b771d4a7fcb9d704bbd31032dc51009670e8f
Author: Stefan Kangas <stefan@marxist.se>
Commit: Stefan Kangas <stefan@marxist.se>

    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.
---
 lisp/allout-widgets.el            |  85 ----------------------
 lisp/allout.el                    | 146 +------------------------------------
 test/lisp/allout-tests.el         | 148 ++++++++++++++++++++++++++++++++++++++
 test/lisp/allout-widgets-tests.el |  87 ++++++++++++++++++++++
 4 files changed, 236 insertions(+), 230 deletions(-)

diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 03fc3e2..ac49d3b 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -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)
 
diff --git a/lisp/allout.el b/lisp/allout.el
index 955b700..044c82a 100644
--- a/lisp/allout.el
+++ b/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.
diff --git a/test/lisp/allout-tests.el b/test/lisp/allout-tests.el
new file mode 100644
index 0000000..f7cd6db
--- /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 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
diff --git a/test/lisp/allout-widgets-tests.el 
b/test/lisp/allout-widgets-tests.el
new file mode 100644
index 0000000..2b1bcaa
--- /dev/null
+++ b/test/lisp/allout-widgets-tests.el
@@ -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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]