ADD a bunch of tests for actions

This commit is contained in:
Nathan Dwarshuis 2022-06-10 19:34:11 -04:00
parent 334681d6fc
commit 33ca950edc
2 changed files with 253 additions and 40 deletions

View File

@ -1,13 +1,93 @@
* TODO this is a project * TODO this is an active project
:PROPERTIES: :PROPERTIES:
:ID: a98df83f-bc98-4767-b2bc-f1054dbf89f9 :ID: a98df83f-bc98-4767-b2bc-f1054dbf89f9
:CREATED: [2022-06-07 Tue 22:41] :CREATED: [2022-06-07 Tue 22:41]
:END: :END:
** TODO this is a project task ** NEXT this is a project task
:PROPERTIES: :PROPERTIES:
:ID: 2db32ed8-0a1f-488c-8e41-dd3549ac8b1b :ID: 2db32ed8-0a1f-488c-8e41-dd3549ac8b1b
:CREATED: [2022-06-07 Tue 22:41] :CREATED: [2022-06-07 Tue 22:41]
:END: :END:
* TODO this is an active project (scheduled)
:PROPERTIES:
:ID: 3788c7bc-390e-4caf-af8e-06831ff3276b
:CREATED: [2022-06-10 Fri 19:29]
:END:
** TODO this is a scheduled task
SCHEDULED: <2022-06-10 Fri>
:PROPERTIES:
:ID: 19a7d558-e087-47ec-b686-feee29d352a1
:CREATED: [2022-06-10 Fri 19:29]
:END:
* TODO this is a waiting project
:PROPERTIES:
:ID: 26586b4d-7fc7-4a9f-b86f-e3c26a83a507
:CREATED: [2022-06-10 Fri 19:18]
:END:
** WAIT this is a waiting subtask
:PROPERTIES:
:ID: cf58280a-ac7c-4951-a3de-a3f79f92f2b0
:CREATED: [2022-06-10 Fri 19:18]
:END:
* HOLD this is a held project
:PROPERTIES:
:ID: d5065c21-b717-41fe-8232-22afbd6b2243
:CREATED: [2022-06-10 Fri 19:14]
:END:
** TODO this is a subtask masked by a hold
:PROPERTIES:
:ID: ee9c6ec9-7626-40f5-9f06-3c91bc1338ed
:CREATED: [2022-06-10 Fri 19:14]
:END:
* TODO this is a project held by a subtask
:PROPERTIES:
:ID: a771dc18-0c5f-4196-903d-ada3c8a9d817
:CREATED: [2022-06-10 Fri 19:15]
:END:
** HOLD this is a held subtask
:PROPERTIES:
:ID: 4f743d31-2df4-4e32-85de-cedae0cffeb2
:CREATED: [2022-06-10 Fri 19:15]
:END:
* TODO this is a stuck project
:PROPERTIES:
:CREATED: [2022-06-07 Tue 22:41]
:ID: c93fe96f-7130-4433-a960-98c07a3b21f4
:END:
** TODO this is a subtask
:PROPERTIES:
:ID: 2def43a3-e814-4793-adc7-38ddbbf30411
:CREATED: [2022-06-10 Fri 19:08]
:END:
* DONE this is a completed project
CLOSED: [2022-06-10 Fri 19:10]
:PROPERTIES:
:ID: 87682ef6-cd4c-41a7-8f0d-6ac41e572b05
:CREATED: [2022-06-10 Fri 19:10]
:END:
** DONE this is a completed subtask
CLOSED: [2022-06-10 Fri 19:26]
:PROPERTIES:
:ID: 61866e72-7153-44d1-ae0f-af527fe5f9f4
:CREATED: [2022-06-10 Fri 19:10]
:END:
** CANC this is a cancelled task
CLOSED: [2022-06-10 Fri 19:26]
:PROPERTIES:
:ID: 322af50a-f431-4940-8caf-cc5acdf5a555
:CREATED: [2022-06-10 Fri 19:25]
:END:
* CANC this is a cancelled project
CLOSED: [2022-06-10 Fri 19:13]
:PROPERTIES:
:ID: eca77dea-4a40-4697-a69d-d1ec798fe9ba
:CREATED: [2022-06-10 Fri 19:13]
:END:
** TODO this is a subtask masked by a cancel
:PROPERTIES:
:ID: a834a585-acd1-44e9-8e62-17793146d6ab
:CREATED: [2022-06-10 Fri 19:13]
:END:
* TODO this is an iterator * TODO this is an iterator
:PROPERTIES: :PROPERTIES:
:ID: 2711e9b9-f765-415d-930f-b7ff16b3140b :ID: 2711e9b9-f765-415d-930f-b7ff16b3140b

View File

@ -51,53 +51,186 @@
(lambda () (lambda ()
`(nil . ,(format "Expected %s to be a left, got a right" a-expr)))))) `(nil . ,(format "Expected %s to be a left, got a right" a-expr))))))
(buttercup-define-matcher :to-have-same-as-plist (a b) (buttercup-define-matcher :to-be-right-with (a x)
(cl-destructuring-bind (cl-destructuring-bind
((a-expr . a) (b-expr . b)) ((a-expr . a) (x-expr . x))
(mapcar #'buttercup--expr-and-value (list a b)) (mapcar #'buttercup--expr-and-value (list a x))
(let* ((a* (-partition 2 a)) (either-from a
(b* (-partition 2 b)) (lambda ()
(a-diff (->> (-difference a* b*) (--map (format "%S" it)) (s-join ", "))) `(nil . ,(format "Expected %s to be a right, got a left" a-expr)))
(b-diff (->> (-difference b* a*) (--map (format "%S" it)) (s-join ", ")))) (lambda (r)
(cond (if (equal r x)
((and a-diff b-diff) `(t . ,(format "Expected %s right with %s" a-expr x))
(cons nil (format "Expected %s to have pairs '%s' and not to have pairs '%s'" `(nil . ,(format "Expected %s right with %s, but got right with %s"
a-expr b-diff a-diff))) a-expr x r)))))))
(a-diff
(cons nil (format "Expected %s not to have pairs '%s'" a-expr a-diff)))
(b-diff
(cons nil (format "Expected %s to have pairs '%s'" a-expr b-diff)))
(t
(cons t (format "Expected %s not to have same items as '%s'"
a-expr b-expr)))))))
;; (defun bs-error (id left) (defun split-plists (a b)
;; (let ((bs (org-x-dag-id->bs id))) (let* ((a* (-partition 2 a))
;; (expect (either-is-left-p bs)) (b* (-partition 2 b))
;; (expect (either-from-left bs nil) :to-equal left))) (a- (-difference a* b*))
(b- (-difference b* a*)))
`(,(-flatten-n 1 a-) ,(-flatten-n 1 b-))))
;; (defun bs-action-equal (id ancestry local) (defun plist-diff-msg (expr a b)
;; (let ((bs (org-x-dag-id-bs id))) (-let (((a-diff b-diff) (split-plists a b)))
;; (expect (either-is-right-p bs)) (cond
;; (from-either (org-x-dag-id-bs id) ((and a-diff b-diff)
;; (expect (org-x-dag-id-bs id) :to-equal bs)) (format "Expected %s to have pairs '%s' and not to have pairs '%s'"
expr b-diff a-diff))
(a-diff
(format "Expected %s not to have pairs '%s'" expr a-diff))
(b-diff
(format "Expected %s to have pairs '%s'" expr b-diff)))))
(defun status-diff-msg (expr type subtype data to-test)
(-let* (((type* . rest) to-test)
((subtype* last) (-split-at (length subtype) rest))
(data* (car last)))
(cond
((not (eq type* type))
(format "Expected %s to have type '%s' but instead had type '%s'"
expr type type*))
((and subtype (not (equal subtype* subtype)))
(format "Expected %s to have subtype '%s' but instead had subtype '%s'"
expr subtype subtype*))
(t
(plist-diff-msg expr data data*)))))
(defun ancestry-diff-msg (expr ancestry inner-fun to-test)
(declare (indent 3))
(-let* (((&plist :ancestry A :local L) to-test))
(or (plist-diff-msg expr A ancestry)
(funcall inner-fun L))))
(defun buffer-status-diff-msg (expr type inner-fun to-test)
(declare (indent 3))
(-let (((type* . rest) to-test))
(if (eq type type*) (funcall inner-fun rest)
(format "Expected buffer-status %s to be type '%s' but instead was type '%s'"
expr type type*))))
(defun right-diff-msg (expr inner-fun to-test)
(declare (indent 2))
(either-from to-test
(lambda ()
(format "Expected %s to be a right, got a left" expr))
inner-fun))
(buttercup-define-matcher :id-to-be-action (to-test canceled held deadline
type subtype data)
(cl-destructuring-bind
((test-expr . test) (_ . c) (_ . h) (_ . e) (_ . y) (_ . s) (_ . d))
(->> (list to-test canceled held deadline type subtype data)
(-map #'buttercup--expr-and-value))
(let* ((ancestry (list :canceled-parent-p c
:held-parent-p h
:parent-deadline e))
(f (->> (-partial #'status-diff-msg test-expr y s d)
(-partial #'ancestry-diff-msg test-expr ancestry)
(-partial #'buffer-status-diff-msg test-expr :action)
(-partial #'right-diff-msg test-expr))))
(-if-let (m (funcall f (org-x-dag-id->bs test)))
(cons nil m)
(cons t (format "Expected '%s' not to be the indicated action" test-expr))))))
;; (buttercup-define-matcher :to-have-same-as-plist (a b)
;; (cl-destructuring-bind
;; ((a-expr . a) (b-expr . b))
;; (mapcar #'buttercup--expr-and-value (list a b))
;; (let* ((a* (-partition 2 a))
;; (b* (-partition 2 b))
;; (a-diff (->> (-difference a* b*) (--map (format "%S" it)) (s-join ", ")))
;; (b-diff (->> (-difference b* a*) (--map (format "%S" it)) (s-join ", "))))
;; (cond
;; ((and a-diff b-diff)
;; (cons nil (format "Expected %s to have pairs '%s' and not to have pairs '%s'"
;; a-expr b-diff a-diff)))
;; (a-diff
;; (cons nil (format "Expected %s not to have pairs '%s'" a-expr a-diff)))
;; (b-diff
;; (cons nil (format "Expected %s to have pairs '%s'" a-expr b-diff)))
;; (t
;; (cons t (format "Expected %s not to have same items as '%s'"
;; a-expr b-expr)))))))
(defmacro bs-ltg-active (id)
(declare (indent 1))
`(expect (org-x-dag-id->bs ,id) :to-be-right-with '(:lifetime :active)))
(describe "Sync DAG" (describe "Sync DAG"
;; TODO this won't actually fail if there is an error (before-all
(setup))
(it "Sync completes without error" (it "Sync completes without error"
(setup) (expect (org-x-dag-sync t) :not :to-throw))
(org-x-dag-sync t))
(it "One random hash is present in the dag" (describe "Action buffer statuses"
(expect (org-x-dag-id->title "06592f95-9cf5-4d7e-8546-da7796d76813") (describe "Projects"
:to-equal (it "Active"
"don't be a dick")) (expect "a98df83f-bc98-4767-b2bc-f1054dbf89f9" :id-to-be-action
nil nil nil :sp-proj '(:proj-active) '(:child-scheds nil)))
(it "test my own macros" ;; TODO these tests are broken because I don't have a robust way
(expect (either :left "blabla") :to-be-left-with "blabla")) ;; to compare the equality of org elements here (likely will need to
;; steal something from the org-ml code, and then tell the plist
;; checker which equality tests to use)
;; (it "Active (scheduled)"
;; (let ((sched (org-ml-from-string 'timestamp "<2022-06-10 Fri>")))
;; (expect "3788c7bc-390e-4caf-af8e-06831ff3276b" :id-to-be-action
;; nil nil nil :sp-proj '(:proj-active)
;; `(:child-scheds (,sched)))))
(it "test my own macros" (it "Wait"
(expect '(:a 1) :to-have-same-as-plist '(:b 1)))) (expect "26586b4d-7fc7-4a9f-b86f-e3c26a83a507" :id-to-be-action
nil nil nil :sp-proj '(:proj-wait) nil))
(it "Held (toplevel)"
(expect "d5065c21-b717-41fe-8232-22afbd6b2243" :id-to-be-action
nil nil nil :sp-proj '(:proj-held) nil))
(it "Held (subtask)"
(expect "a771dc18-0c5f-4196-903d-ada3c8a9d817" :id-to-be-action
nil nil nil :sp-proj '(:proj-held) nil))
(it "Stuck"
(expect "c93fe96f-7130-4433-a960-98c07a3b21f4" :id-to-be-action
nil nil nil :sp-proj '(:proj-stuck) nil))
(it "Completed"
(expect "87682ef6-cd4c-41a7-8f0d-6ac41e572b05" :id-to-be-action
nil nil nil :sp-proj '(:proj-complete)
'(:canceledp nil :epoch 1654902600)))
(it "Canceled"
(expect "eca77dea-4a40-4697-a69d-d1ec798fe9ba" :id-to-be-action
nil nil nil :sp-proj '(:proj-complete)
'(:canceledp t :epoch 1654902780))))
(describe "Tasks"
(it "Active"
(expect "2db32ed8-0a1f-488c-8e41-dd3549ac8b1b" :id-to-be-action
nil nil nil :sp-task '(:task-active)
'(:todo "NEXT" :sched nil :dead nil)))
(it "Waiting"
(expect "cf58280a-ac7c-4951-a3de-a3f79f92f2b0" :id-to-be-action
nil nil nil :sp-task '(:task-active)
'(:todo "WAIT" :sched nil :dead nil)))
(it "Held"
(expect "4f743d31-2df4-4e32-85de-cedae0cffeb2" :id-to-be-action
nil nil nil :sp-task '(:task-active)
'(:todo "HOLD" :sched nil :dead nil)))
(it "Completed"
(expect "61866e72-7153-44d1-ae0f-af527fe5f9f4" :id-to-be-action
nil nil nil :sp-task '(:task-complete)
'(:canceledp nil :epoch 1654903560)))
(it "Canceled"
(expect "322af50a-f431-4940-8caf-cc5acdf5a555" :id-to-be-action
nil nil nil :sp-task '(:task-complete)
'(:canceledp t :epoch 1654903560))))))
(provide 'org-x-dag-test) (provide 'org-x-dag-test)
;;; org-x-dag-test.el ends here ;;; org-x-dag-test.el ends here