;;;_ test-org-choose.el --- Test code for org-choose ;;;_. Headers ;;;_ , License ;; Copyright (C) 2009 Tom Breton (Tehom) ;; Author: Tom Breton (Tehom) ;; Keywords: lisp ;; This file 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 2, or (at your option) ;; any later version. ;; This file 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; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;;_ , Commentary: ;; ;;;_ , Requires (require 'rtest-define) (require 'mockbuf) (require 'el-mock) (require 'org) (require 'org-id) (require 'org-choose) ;;;_. Body ;;;_ , Example files (defconst test-org-choose:th:examples-dir (rtest:expand-filename-by-load-file "examples") "Directory where examples are" ) (rtest:defexample test-org-choose:thd:file-simple (expand-file-name "simple.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-w-1-chosen (expand-file-name "w-1-chosen.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-nonautomatic (expand-file-name "nonautomatic.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-w-2-types (expand-file-name "w-2-types.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-w-some-nils (expand-file-name "w-some-nils.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:file-nosibs (expand-file-name "no-sibs.org" test-org-choose:th:examples-dir)) (rtest:defexample test-org-choose:thd:nofile-1-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-choose:thd:nofile-1-raw-marks '(choose "REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN") "Raw marks") (rtest:defexample test-org-choose:thd:nofile-1-output-marks '(choose "REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN") "Output marks") (rtest:defexample test-org-choose:thd:nofile-1-setup-args (list nil nil nil 5 test-org-choose:thd:nofile-1-list-o-marks) "Arguments given to org-choose-setup-vars" ) (rtest:defexample test-org-choose:thd:nofile-1-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range nil :top-upper-range nil :range-length nil :static-default 0 :all-keywords test-org-choose:thd:nofile-1-list-o-marks)) test-org-choose:thd:nofile-1-list-o-marks) "The mark data corresponding to nofile-1") (rtest:defexample test-org-choose:thd:nofile-2-list-o-marks '("ZERO" "ONE" "TWO" "THREE" "FOUR" "FIVE" "SIX")) (rtest:defexample test-org-choose:thd:nofile-2-raw-marks '(choose "ZERO" "ONE" "TWO(b)" "THREE(c,-)" "FOUR(d,0)" "FIVE(e,+)" "SIX(,)") "Raw marks") (rtest:defexample test-org-choose:thd:nofile-2-output-marks '(choose "ZERO" "ONE" "TWO(b)" "THREE(c)" "FOUR(d)" "FIVE(e)" "SIX") "Output marks") (rtest:defexample test-org-choose:thd:nofile-2-setup-args (list 3 5 4 7 test-org-choose:thd:nofile-2-list-o-marks) "Arguments given to org-choose-setup-vars" ) (rtest:defexample test-org-choose:thd:nofile-2-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range 3 :top-upper-range 5 :range-length 1 :static-default 4 :all-keywords test-org-choose:thd:nofile-2-list-o-marks)) test-org-choose:thd:nofile-2-list-o-marks) "The mark data corresponding to nofile example 2") ;;An example of one that's not automatically managed (rtest:defexample test-org-choose:thd:nofile-3-raw-marks '(sequence "ZERO" "ONE" "TWO(b)" "THREE(c)" "FOUR(d)" "FIVE(e)" "SIX") "Input marks") (rtest:defexample test-org-choose:thd:nofile-3-output-marks nil "Output marks") ;;An example where the top of the range is implicit (rtest:defexample test-org-choose:thd:nofile-4-list-o-marks '("ZERO" "ONE" "TWO" "THREE" "FOUR" "FIVE" "SIX")) (rtest:defexample test-org-choose:thd:nofile-4-raw-marks '(choose "ZERO" "ONE" "TWO(b)" "THREE(c,-)" "FOUR(d,0)" "FIVE(e)" "SIX") "Input marks") (rtest:defexample test-org-choose:thd:nofile-4-setup-args (list 3 nil 4 7 test-org-choose:thd:nofile-4-list-o-marks) "Arguments given to org-choose-setup-vars") (rtest:defexample test-org-choose:thd:nofile-4-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range 3 :top-upper-range 6 :range-length 2 :static-default 4 :all-keywords test-org-choose:thd:nofile-4-list-o-marks)) test-org-choose:thd:nofile-4-list-o-marks) "The mark data corresponding to nofile example 2") (rtest:defexample test-org-choose:thd:nofile-4-kwd-alist (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'choose "ZERO" "SIX" "SIX")) test-org-choose:thd:nofile-4-list-o-marks)) (rtest:defexample test-org-choose:thd:file-simple-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-choose:thd:file-simple-setup-args (list 1 4 2 5 test-org-choose:thd:file-simple-list-o-marks) "Arguments given to org-choose-setup-vars" ) (rtest:defexample test-org-choose:thd:file-simple-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range 1 :top-upper-range 4 :range-length 2 :static-default 2 :all-keywords test-org-choose:thd:file-simple-list-o-marks)) test-org-choose:thd:file-simple-list-o-marks) "The mark data corresponding to file1") (rtest:defexample test-org-choose:thd:file-simple-high-ix 3) (rtest:defexample test-org-choose:thd:file-simple-sib-maybe-id "67a7cbba-c78b-47fe-886a-08a80f67e4ab" "ID of a sibling") (rtest:defexample test-org-choose:thd:file-simple-sib-maybe-ix 2 "Mark index of that sibling") (rtest:defexample test-org-choose:thd:file-simple-sib-rejected-id "953d4524-f15e-4198-ab33-5769732f51ad" "ID of another sibling") (rtest:defexample test-org-choose:thd:file-simple-sib-leaning-id "be01f611-6175-4e40-a3b5-525a9c1e3b4d" "ID of another sibling") (rtest:defexample test-org-choose:thd:file-simple-sib-not-chosen-id "b7760ac9-e0bf-41a0-9661-720d42670432" "ID of another sibling") (rtest:defexample test-org-choose:thd:file-simple-parent-id "a13a4b6f-02d6-445c-a38e-7e51b9ba29d4" "ID of the parent of those nodes") (rtest:defexample test-org-choose:thd:file-simple-original-marks '("MAYBE""REJECTED""LEANING_TOWARDS""NOT_CHOSEN")) (rtest:defexample test-org-choose:thd:file-w-1-chosen-mark-data test-org-choose:thd:file-simple-mark-data) (rtest:defexample test-org-choose:thd:file-w-1-chosen-high-ix 4) (rtest:defexample test-org-choose:thd:file-w-1-chosen-sib-not-chosen-a-id "b390f9b1-57d0-4a17-9811-47b49fee196f" "ID of a not-chosen sibling") (rtest:defexample test-org-choose:thd:file-w-1-chosen-sib-maybe-id "5a449704-494c-412f-b21d-8ffe07b8092c" "ID of another not-chosen sibling") (rtest:defexample test-org-choose:thd:file-w-1-chosen-sib-chosen-id "c0958364-1f99-4dfc-a671-f21bb5f708bb" "ID of the chosen sibling") (rtest:defexample test-org-choose:thd:file-w-1-chosen-parent-id "b2a6f78c-6199-461b-9850-18980b85b1ab") (rtest:defexample test-org-choose:thd:file-w-1-chosen-list-o-marks test-org-choose:thd:file-simple-list-o-marks) (rtest:defexample test-org-choose:thd:file-w-1-chosen-original-marks '("NOT_CHOSEN" "REJECTED" "CHOSEN " "MAYBE")) (rtest:defexample test-org-choose:thd:file-nonautomatic-list-o-marks '("NO" "MAYBE_YN" "YES")) (rtest:defexample test-org-choose:thd:file-nonautomatic-raw-marks '(choose "NO" "MAYBE_YN(,0)" "YES")) (rtest:defexample test-org-choose:thd:file-nonautomatic-setup-args (list nil nil 1 3 test-org-choose:thd:file-nonautomatic-list-o-marks) "Arguments given to org-choose-setup-vars") (rtest:defexample test-org-choose:thd:file-nonautomatic-high-ix 2) (rtest:defexample test-org-choose:thd:file-nonautomatic-sib-yes-id "6a27cc97-6e65-4c4e-9014-7fbcf27f52fa") (rtest:defexample test-org-choose:thd:file-nonautomatic-mark-data (mapcar #'(lambda (x) (make-org-choose-mark-data. :keyword x :bot-lower-range nil :top-upper-range nil :range-length nil :static-default 1 :all-keywords test-org-choose:thd:file-nonautomatic-list-o-marks) ) test-org-choose:thd:file-nonautomatic-list-o-marks) "The mark data corresponding to file3") (rtest:defexample test-org-choose:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'sequence "TODO" "DONE" "DONE")) '("TODO" "DONE")) "A kwd-alist that includes only the 2 normal TODO marks. NB, this is context. It is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-choose:thd:context:kwd-alist (append test-org-choose:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'choose "NO" "YES" "YES")) test-org-choose:thd:file-nonautomatic-list-o-marks)) "A kwd-alist to combines 2 normal TODO marks and the file-nonautomatic marks. NB, this is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-choose:thd:context:kwd-alist-simple (append test-org-choose:thd:context:kwd-alist-normal-todo (mapcar #'(lambda (x) ;;(KEY interpretation head done-word final-done-word) (list x 'choose "REJECTED" "CHOSEN" "CHOSEN")) test-org-choose:thd:file-simple-list-o-marks)) "A kwd-alist that includes the marks in simple.org plus 2 normal TODO marks. NB, this is context. It is not *produced* by any test code, it is used to control what marks are understood." ) (rtest:defexample test-org-choose:thd:file-w-2-types-mark-data (append test-org-choose:thd:file-simple-mark-data test-org-choose:thd:file-nonautomatic-mark-data)) (rtest:defexample test-org-choose:thd:file-w-2-types-t1-high-ix 3) (rtest:defexample test-org-choose:thd:file-w-2-types-t1-leaning-id "c8e7d7af-15a2-4650-a604-50ade52bd06c") (rtest:defexample test-org-choose:thd:file-w-2-types-t1-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-choose:thd:file-w-2-types-t2-high-ix 2) (rtest:defexample test-org-choose:thd:file-w-2-types-t2-yes-id "02e917f5-ac3d-477f-baf5-7eb7c8961683") (rtest:defexample test-org-choose:thd:file-w-2-types-t2-list-o-marks '("YES" "MAYBE_YN" "NO")) (rtest:defexample test-org-choose:thd:file-w-some-nils-high-ix 4) (rtest:defexample test-org-choose:thd:file-w-some-nils-sib-marked-id "a4e52131-1145-49f5-8b4b-dc4264900a05") (rtest:defexample test-org-choose:thd:file-w-some-nils-sib-nil-id "d9729468-db22-4870-8969-9500da63d560") (rtest:defexample test-org-choose:thd:file-w-some-nils-list-o-marks '("REJECTED" "NOT_CHOSEN" "MAYBE" "LEANING_TOWARDS" "CHOSEN")) (rtest:defexample test-org-choose:thd:file-nosibs-sib "78fb63fa-4fad-4c7f-aa4a-954ee3431754") (rtest:defexample test-org-choose:thd:file-nosibs-high-ix 0) ;;;_ , Tests of org-choose-filter-one (rtest:defexample test-org-choose:thd:singlemark-1-input-output '("ONE(,0)" ("ONE" "ONE" default-mark)) "Pairs of single marks: Input and output" ) (rtest:defexample test-org-choose:thd:singlemark-2-input-output '("TWO" ("TWO" "TWO")) "Pairs of single marks: Input and output" ) (rtest:defexample test-org-choose:thd:singlemark-3-input-output '("THREE(b)" ("THREE" "THREE(b)")) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-4-input-output '("FOUR(c,0)" ("FOUR" "FOUR(c)" default-mark)) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-5-input-output '("FIVE(d,+)" ("FIVE" "FIVE(d)" top-upper-range)) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-6-input-output '("SIX(e,-)" ("SIX" "SIX(e)" bot-lower-range)) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-7-input-output '("SEVEN(,)" ("SEVEN" "SEVEN")) "Pairs of single marks: Input and output") (rtest:defexample test-org-choose:thd:singlemark-8-input-output '("EIGHT(x!/@,)" ("EIGHT" "EIGHT(x!/@)")) "Pairs of single marks: Input and output") (rtest:deftest org-choose-filter-one ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-1-input-output)) (second test-org-choose:thd:singlemark-1-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-2-input-output)) (second test-org-choose:thd:singlemark-2-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-3-input-output)) (second test-org-choose:thd:singlemark-3-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-4-input-output)) (second test-org-choose:thd:singlemark-4-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-5-input-output)) (second test-org-choose:thd:singlemark-5-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-6-input-output)) (second test-org-choose:thd:singlemark-6-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-7-input-output)) (second test-org-choose:thd:singlemark-7-input-output))) ( "Does the examples correctly." (equal (org-choose-filter-one (car test-org-choose:thd:singlemark-8-input-output)) (second test-org-choose:thd:singlemark-8-input-output))) ) ;;;_ , Tests of org-choose-setup-vars (rtest:deftest org-choose-setup-vars ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:nofile-1-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-1-mark-data))) ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:nofile-2-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-2-mark-data))) ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:nofile-4-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-4-mark-data))) ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:file-simple-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-simple-mark-data))) ( "The `*-setup-args' examples are proper args to `org-choose-setup-vars'. It sets org-choose-mark-data correspondingly." (with-temp-buffer (apply #'org-choose-setup-vars test-org-choose:thd:file-nonautomatic-setup-args) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data))) ) ;;;_ , Tests of the setup filter (rtest:deftest org-choose-setup-filter ;;I'd like to have also tested that output is conformant. But ;;AFAICT no existing predicate reports that, so I'll only test that ;;output matches what's expected, which I'll eyeball. ( "Situation: Called manually, passed data with another interpretation. Response: Return value is `nil'." (equal (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-3-raw-marks)) test-org-choose:thd:nofile-3-output-marks)) ( "Situation: Called manually, passed known data. Response: Return value is as expected." (equal (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-1-raw-marks)) test-org-choose:thd:nofile-1-output-marks)) ( "Situation: Called manually, passed known data. Response: Return value is as expected." (equal (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-2-raw-marks)) test-org-choose:thd:nofile-2-output-marks)) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-1-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-1-mark-data))) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-2-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-2-mark-data))) ( "Situation: Called manually, passed known data. Response: Variables have been set up as expected." (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:nofile-4-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:nofile-4-mark-data))) ( "Situation: In temp buffer, given the same marks as for file 3. Response: `org-choose-mark-data' have been set up as expected." (with-temp-buffer (org-choose-setup-filter test-org-choose:thd:file-nonautomatic-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data))) ( "Situation: `org-choose-mark-data' has already been set with marks from this set Response: `org-choose-mark-data' gets the expected value and nothing extra." (with-temp-buffer (let ((org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data)) (org-choose-setup-filter test-org-choose:thd:file-nonautomatic-raw-marks) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data)))) ( "Situation: `org-choose-mark-data' has already been set with marks from another set Response: `org-choose-mark-data' gets the new marks and keeps the marks from the other set." (with-temp-buffer (let ((org-choose-mark-data test-org-choose:thd:file-simple-mark-data)) (org-choose-setup-filter test-org-choose:thd:file-nonautomatic-raw-marks) (rtest:sets= org-choose-mark-data (append test-org-choose:thd:file-simple-mark-data test-org-choose:thd:file-nonautomatic-mark-data))))) ;;Insinuated tests, so that setup filter is called automatically by ;;setup. ( "Situation: In example file 1. Response: `org-choose-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-choose:thd:file-simple) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-simple-mark-data))) ( "Situation: In example file 2. Response: `org-choose-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-choose:thd:file-w-1-chosen) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-w-1-chosen-mark-data))) ( "Situation: In example file 3. Response: `org-choose-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-choose:thd:file-nonautomatic) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data))) ( "Situation: In example file 4. Response: `org-choose-mark-data' gets the expected value." (with-buffer-containing-object (:file test-org-choose:thd:file-w-2-types) (rtest:sets= org-choose-mark-data test-org-choose:thd:file-w-2-types-mark-data)))) ;;;_ , Tests of the function to get default ;;;_ . Test helper ;;;_ . org-choose:th:in-buffer-at (defmacro* org-choose:th:in-buffer-at ((&key file id) &rest body) "" `(with-buffer-containing-object (:file ,file) ;;Have to show entries otherwise we might fail to go to them. (show-all) ;;Go to one of the entries. Use `org-find-entry-with-id' so we ;;can't accidentally leave this file, as we could with ;;`org-id-find'. (goto-char (org-find-entry-with-id ,id)) ,@body)) ;;;_ , Tests (put 'org-choose:th:in-buffer-at 'rtest:test-thru 'org-choose-get-entry-index) ;;;_ . org-choose-get-entry-index (rtest:deftest org-choose-get-entry-index ;;These tests are tests after insinuation. ( "Situation: Point is in a marked entry. Response: Return the index of that entry." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id) (equal (org-choose-get-entry-index test-org-choose:thd:file-simple-list-o-marks) test-org-choose:thd:file-simple-sib-maybe-ix))) ( "Situation: Point is in a unmarked entry (nil). Response: Return nil." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-some-nils :id test-org-choose:thd:file-w-some-nils-sib-nil-id) (equal (org-choose-get-entry-index test-org-choose:thd:file-w-some-nils-list-o-marks) nil))) ( "Situation: Point is in an entry with a mark from a different set. Response: Return nil." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-2-types :id test-org-choose:thd:file-w-2-types-t2-yes-id) (equal (org-choose-get-entry-index test-org-choose:thd:file-w-2-types-t1-list-o-marks) nil))) ) ;;;_ . org-choose-get-highest-mark-index (rtest:deftest org-choose-get-highest-mark-index ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-simple-list-o-marks) test-org-choose:thd:file-simple-high-ix))) ( "Situation: Point is in a different one of the sibling entries Response: Returns the highest index." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-simple-list-o-marks) test-org-choose:thd:file-simple-high-ix))) ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-not-chosen-a-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-w-1-chosen-list-o-marks) test-org-choose:thd:file-w-1-chosen-high-ix))) ( "Situation: Point is in one of the sibling entries Response: Returns the highest index." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-nonautomatic :id test-org-choose:thd:file-nonautomatic-sib-yes-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-nonautomatic-list-o-marks) test-org-choose:thd:file-nonautomatic-high-ix))) ( "Situation: Point is in one of the sibling entries of one type. Response: Returns the highest index of siblings of that type, ignoring the others." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-2-types :id test-org-choose:thd:file-w-2-types-t1-leaning-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-w-2-types-t1-list-o-marks) test-org-choose:thd:file-w-2-types-t1-high-ix))) ( "Situation: Point is in one of the sibling entries of one type, in a sibling group that has 2 types. Response: Returns the highest index of siblings of that type, ignoring the others." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-2-types :id test-org-choose:thd:file-w-2-types-t2-yes-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-w-2-types-t2-list-o-marks) test-org-choose:thd:file-w-2-types-t2-high-ix))) ( "Situation: Point is in one of the sibling entries. Some entries are nil. Response: Returns the highest index, ignoring the `nil's." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-some-nils :id test-org-choose:thd:file-w-some-nils-sib-marked-id) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-w-some-nils-list-o-marks) test-org-choose:thd:file-w-some-nils-high-ix))) ( "Situation: There are no entries of choose type. Response: Return 0" (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-nosibs :id test-org-choose:thd:file-nosibs-sib) (equal (org-choose-get-highest-mark-index test-org-choose:thd:file-simple-list-o-marks) 0))) ) ;;;_ . org-choose-get-default-mark-index (put 'org-choose-get-default-mark-index 'rtest:test-thru 'org-choose-get-default-mark) ;;;_ . org-choose-get-mark-N (rtest:deftest org-choose-get-mark-N ( "Behavior: Gets the corresponding mark from the set." (let ((org-choose-mark-data test-org-choose:thd:nofile-4-mark-data)) (equal (org-choose-get-mark-N 0 (assoc "ONE" org-choose-mark-data)) "ZERO"))) ( "Behavior: Gets the corresponding mark from the set." (let ((org-choose-mark-data test-org-choose:thd:nofile-4-mark-data)) (equal (org-choose-get-mark-N 4 (assoc "THREE" org-choose-mark-data)) "FOUR"))) ) ;;;_ . org-choose-get-default-mark ;;;_ , Test helpers (defun org-choose-get-default-mark-index:th (new-mark mark-data) "Test helper" (org-choose-get-default-mark-index (assoc new-mark mark-data))) (defun org-choose:th:collect-childrens-todo-marks (parent-id) "" (save-excursion (show-all) ;;In case anything got hidden (goto-char (org-find-entry-with-id parent-id)) (save-restriction (org-map-entries #'(lambda () (org-entry-get (point) "TODO")) nil 'tree)))) ;;;_ . Tests of org-choose:th:collect-childrens-todo-marks (rtest:deftest org-choose:th:collect-childrens-todo-marks ("Situation: In a known file. Param: The id of the parent entry. Response: Returns the TODO marks of the children." (with-buffer-containing-object (:file test-org-choose:thd:file-simple) (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) test-org-choose:thd:file-simple-original-marks)))) ;;;_ , Tests (rtest:deftest org-choose-get-default-mark ( "Situation: we're not going into a choose type Response: Return nil, signalling to use the mark we were going to." (let ((org-todo-kwd-alist test-org-choose:thd:context:kwd-alist)) (equal (org-choose-get-default-mark nil "DONE") nil))) ( "Situation: We were already in a choose type. Response: Return nil, signalling to use the mark we were going to." (let ((org-todo-kwd-alist test-org-choose:thd:context:kwd-alist)) (equal (org-choose-get-default-mark "YES" "MAYBE_YN") nil))) ;;These tests test the index return for ;;`org-choose-get-default-mark-index' and also test the string ;;return for `org-choose-get-default-mark'. Combining the tests ;;under `and' is not good style but I don't want to write each ;;setup twice. ( "Situation: there are no ranges. Response: return the static default." (let ((org-choose-mark-data test-org-choose:thd:file-nonautomatic-mark-data) (org-todo-kwd-alist test-org-choose:thd:context:kwd-alist)) (with-mock (stub org-choose-get-highest-mark-index => nil) (and (equal (org-choose-get-default-mark-index:th "NO" test-org-choose:thd:file-nonautomatic-mark-data) 1) (equal (org-choose-get-default-mark "NO" nil) "MAYBE_YN"))))) ( "Situation: no current mark is in the upper range. Response: return the static default." (let ((org-choose-mark-data test-org-choose:thd:nofile-4-mark-data) (org-todo-kwd-alist test-org-choose:thd:nofile-4-kwd-alist)) (with-mock (stub org-choose-get-highest-mark-index => 2) (and (equal (org-choose-get-default-mark-index:th "ONE" test-org-choose:thd:nofile-4-mark-data) 4) (equal (org-choose-get-default-mark "ONE" nil) "FOUR") )))) ;;Because the static default is at or above the top of lower range, ;;any mirror-wise constraint is a stronger constraint than it. So ;;no additional test is needed for the interaction between those ;;two constraints. ( "Situation: a current mark is in the upper range. Response: return an accordingly lower index.." (let ((org-choose-mark-data test-org-choose:thd:nofile-4-mark-data) (org-todo-kwd-alist test-org-choose:thd:nofile-4-kwd-alist)) (with-mock (stub org-choose-get-highest-mark-index => 6) (and (equal (org-choose-get-default-mark-index:th "ONE" test-org-choose:thd:nofile-4-mark-data) 3) (equal (org-choose-get-default-mark "ONE" nil) "THREE"))))) ("Situation: Point is on a heading. The only type of TODO in this buffer is a choose type. The default type is MAYBE. No sibling mark is higher than LEANING_TOWARDS. Operation: Add a new todo heading. Result: It then has the mark MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id) (org-insert-todo-heading 1) (equal (org-entry-get (point) "TODO") "MAYBE"))) ("Situation: Point is on a heading with no mark. The only type of TODO in this buffer is a choose type. The default type is MAYBE. No sibling mark is higher than LEANING_TOWARDS. Operation: Add a todo mark to the heading. Result: It then has the mark MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id) (org-insert-heading) (org-todo) (equal (org-entry-get (point) "TODO") "MAYBE"))) ("Situation: Point is on a heading. The only type of TODO in this buffer is a choose type. The default type is MAYBE. A sibling mark is CHOSEN The mark NOT_CHOSEN mirrors the mark CHOSEN. Operation: Add a todo mark to the heading. Result: It then has the mark NOT_CHOSEN." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-not-chosen-a-id) (org-insert-heading) (org-todo) (equal (org-entry-get (point) "TODO") "NOT_CHOSEN")))) ;;;_ , Tests of the trigger function ;;;_ . org-choose-conform-after-promotion ;;;_ , Test helper (defun* org-choose-conform-after-promotion:th (&key file id mark-data other-was other-changed-to expect demoted) "" (org-choose:th:in-buffer-at (:file file :id id) (let* ( (data (or (assoc other-changed-to mark-data) (error "Mark-data should contain the entry being changed to"))) (keywords (org-choose-mark-data.-all-keywords data)) (index (org-choose-get-index-in-keywords other-changed-to keywords)) (old-index (when other-was (org-choose-get-index-in-keywords other-was keywords)))) (if demoted (org-choose-conform-after-demotion 0 ;;Fake position that matches nothing keywords (let ((new-highest (org-choose-highest-other-ok index data)) (static-default (org-choose-mark-data.-static-default data))) (if new-highest (min new-highest static-default) static-default)) (org-choose-highest-other-ok old-index data)) (org-choose-conform-after-promotion 0 ;;Fake position that matches nothing keywords (org-choose-highest-other-ok index data)))) (equal (org-entry-get (point) "TODO") expect))) ;;;_ , Tests (rtest:deftest org-choose-conform-after-promotion ( "Situation: Entry's mark is from some other workflow state. Response: Do nothing." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-w-2-types :id test-org-choose:thd:file-w-2-types-t2-yes-id :mark-data test-org-choose:thd:file-w-2-types-mark-data :other-changed-to "CHOSEN" :expect "YES")) ( "Situation: Entry's mark is already lower than the highest allowed index. Response: No change." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id :mark-data test-org-choose:thd:file-simple-mark-data :other-changed-to "CHOSEN" :expect "REJECTED")) ( "Situation: Entry's mark is higher than the highest allowed index. Response: Demote it." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id :mark-data test-org-choose:thd:file-simple-mark-data :other-changed-to "LEANING_TOWARDS" :expect "MAYBE")) ) ;;;_ . org-choose-conform-after-demotion ;;;_ , Tests (rtest:deftest org-choose-conform-after-demotion ( "Situation: The other entry was not keeping this node below the default. Response: This node is unchanged." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id :mark-data test-org-choose:thd:file-simple-mark-data :other-was "LEANING_TOWARDS" :other-changed-to "MAYBE" :demoted t :expect "MAYBE")) ( "Situation: The other entry was keeping this node below the default. Response: This node is promoted." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-maybe-id :mark-data test-org-choose:thd:file-simple-mark-data :other-was "LEANING_TOWARDS" :other-changed-to "CHOSEN" :demoted t :expect "NOT_CHOSEN")) ( "Situation: The other entry was keeping this node below the default. It was just demoted quite low. Response: This node is promoted only to the default." (org-choose-conform-after-promotion:th :file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-not-chosen-id :mark-data test-org-choose:thd:file-simple-mark-data :other-was "CHOSEN" :other-changed-to "REJECTED" :demoted t :expect "MAYBE")) ) ;;;_ . org-choose-keep-sensible ;;;_ , Helper (defun* org-choose-keep-sensible:th:manual (&key from to) "" (let (org-blocker-hook) (org-todo to) (org-choose-keep-sensible (list :from from :to to :position (point-at-bol))))) ;;;_ , Tests (rtest:deftest org-choose-keep-sensible ;;Non-insinuated tests, `org-choose-keep-sensible' is just ;;called manually. ( "Operation: An entry's todo mark is changed into a TODO from some other workflow state. Response: No change to our entries." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (let ((org-todo-kwd-alist test-org-choose:thd:context:kwd-alist-simple)) (org-choose-keep-sensible:th:manual :from "RESPONSE:" :to "NOT_CHOSEN")) (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-choose-keep-sensible:th:manual :from "RESPONSE:" :to "NOT_CHOSEN") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Leaning_towards becomes Chosen. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id) (org-choose-keep-sensible:th:manual :from "LEANING_TOWARDS" :to "CHOSEN") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("NOT_CHOSEN""REJECTED""CHOSEN""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Rejected becomes Leaning_towards. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-choose-keep-sensible:th:manual :from "REJECTED" :to "LEANING_TOWARDS") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""LEANING_TOWARDS""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was medium-high-marked; it's not high enough to be keeping other nodes down below the default. Operation: That entry is demoted one place. LEANING_TOWARDS becomes MAYBE. Response: It gets demoted. Other nodes are unchanged." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id) (org-choose-keep-sensible:th:manual :from "LEANING_TOWARDS" :to "MAYBE") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""REJECTED""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted one place. CHOSEN becomes LEANING_TOWARDS. Response: It gets demoted. Nodes that it was holding down are promoted. NOT_CHOSEN becomes MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-chosen-id) (org-choose-keep-sensible:th:manual :from "CHOSEN" :to "LEANING_TOWARDS") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-w-1-chosen-parent-id) '( "MAYBE" "REJECTED" "LEANING_TOWARDS" "MAYBE")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted two places. CHOSEN becomes MAYBE. Response: It gets demoted. Nodes that it was holding down are promoted as if by two one-place operations. NOT_CHOSEN becomes MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-chosen-id) (org-choose-keep-sensible:th:manual :from "CHOSEN" :to "MAYBE") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-w-1-chosen-parent-id) '("MAYBE" "REJECTED" "MAYBE" "MAYBE")))) ;;No tests for the situation where a node is demoted to the middle ;;of the upper range and should both potentially raise some others ;;and lower some others. It's unlikely to be an important ;;situation. YAGNI. ;;Tests of org-choose after having been insinuated ;;Implicit operations of `org-todo' ( "Operation: An entry is implicitly promoted. Response: It gets promoted to the next value." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-todo) (equal (org-entry-get (point) "TODO") "NOT_CHOSEN"))) ( "Operation: An entry is implicitly promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-todo) (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ;;Tests that operations still behave after insinuation the same as ;;they did manually. ( "Operation: An entry is explicitly promoted, but not high enough to cause inconsistent state. Response: It gets promoted. Other nodes keep their values" (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-todo "NOT_CHOSEN") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""NOT_CHOSEN""LEANING_TOWARDS""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Leaning_towards becomes Chosen. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id) (org-todo "CHOSEN") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("NOT_CHOSEN""REJECTED""CHOSEN""NOT_CHOSEN")))) ( "Operation: An entry is promoted high enough to cause inconsistent state. Rejected becomes Leaning_towards. Response: It gets promoted. Other nodes are demoted just enough to keep the state consistent." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-rejected-id) (org-todo "LEANING_TOWARDS") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""LEANING_TOWARDS""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was medium-high-marked; it's not high enough to be keeping other nodes down below the default. Operation: That entry is demoted one place. LEANING_TOWARDS becomes MAYBE. Response: It gets demoted." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-simple :id test-org-choose:thd:file-simple-sib-leaning-id) (org-todo "MAYBE") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-simple-parent-id) '("MAYBE""REJECTED""MAYBE""NOT_CHOSEN")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted one place. CHOSEN becomes LEANING_TOWARDS. Response: It gets demoted. Nodes that it was holding down are promoted. NOT_CHOSEN becomes MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-chosen-id) (org-todo "LEANING_TOWARDS") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-w-1-chosen-parent-id) '( "MAYBE" "REJECTED" "LEANING_TOWARDS" "MAYBE")))) ( "Situation: An entry was high-marked, holding other nodes below the top of the low range. Operation: That entry is demoted two places. CHOSEN becomes MAYBE. Response: It gets demoted. Nodes that it was holding down are promoted as if by two one-place operations. NOT_CHOSEN becomes MAYBE." (org-choose:th:in-buffer-at (:file test-org-choose:thd:file-w-1-chosen :id test-org-choose:thd:file-w-1-chosen-sib-chosen-id) (org-todo "MAYBE") (equal (org-choose:th:collect-childrens-todo-marks test-org-choose:thd:file-w-1-chosen-parent-id) '("MAYBE" "REJECTED" "MAYBE" "MAYBE")))) ) ;;;_. Footers ;;;_ , Provides (provide 'test-org-choose) ;;;_ * Local emacs vars. ;;;_ + Local variables: ;;;_ + End: ;;;_ , End ;;; test-org-choose.el ends here