From 33ca950edc3a4c26b259d9f3976d852b6644fb1f Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Fri, 10 Jun 2022 19:34:11 -0400 Subject: [PATCH] ADD a bunch of tests for actions --- local/lib/org-x/test/dag/action1.org | 84 +++++++++- local/lib/org-x/test/org-x-dag-test.el | 209 ++++++++++++++++++++----- 2 files changed, 253 insertions(+), 40 deletions(-) diff --git a/local/lib/org-x/test/dag/action1.org b/local/lib/org-x/test/dag/action1.org index 2cbabaa..39ea9bb 100644 --- a/local/lib/org-x/test/dag/action1.org +++ b/local/lib/org-x/test/dag/action1.org @@ -1,13 +1,93 @@ -* TODO this is a project +* TODO this is an active project :PROPERTIES: :ID: a98df83f-bc98-4767-b2bc-f1054dbf89f9 :CREATED: [2022-06-07 Tue 22:41] :END: -** TODO this is a project task +** NEXT this is a project task :PROPERTIES: :ID: 2db32ed8-0a1f-488c-8e41-dd3549ac8b1b :CREATED: [2022-06-07 Tue 22:41] :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 :PROPERTIES: :ID: 2711e9b9-f765-415d-930f-b7ff16b3140b diff --git a/local/lib/org-x/test/org-x-dag-test.el b/local/lib/org-x/test/org-x-dag-test.el index 3a4ee5c..8c56a14 100644 --- a/local/lib/org-x/test/org-x-dag-test.el +++ b/local/lib/org-x/test/org-x-dag-test.el @@ -51,53 +51,186 @@ (lambda () `(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 - ((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))))))) + ((a-expr . a) (x-expr . x)) + (mapcar #'buttercup--expr-and-value (list a x)) + (either-from a + (lambda () + `(nil . ,(format "Expected %s to be a right, got a left" a-expr))) + (lambda (r) + (if (equal r x) + `(t . ,(format "Expected %s right with %s" a-expr x)) + `(nil . ,(format "Expected %s right with %s, but got right with %s" + a-expr x r))))))) -;; (defun bs-error (id left) -;; (let ((bs (org-x-dag-id->bs id))) -;; (expect (either-is-left-p bs)) -;; (expect (either-from-left bs nil) :to-equal left))) +(defun split-plists (a b) + (let* ((a* (-partition 2 a)) + (b* (-partition 2 b)) + (a- (-difference a* b*)) + (b- (-difference b* a*))) + `(,(-flatten-n 1 a-) ,(-flatten-n 1 b-)))) -;; (defun bs-action-equal (id ancestry local) -;; (let ((bs (org-x-dag-id-bs id))) -;; (expect (either-is-right-p bs)) -;; (from-either (org-x-dag-id-bs id) -;; (expect (org-x-dag-id-bs id) :to-equal bs)) +(defun plist-diff-msg (expr a b) + (-let (((a-diff b-diff) (split-plists a b))) + (cond + ((and a-diff b-diff) + (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" - ;; TODO this won't actually fail if there is an error + (before-all + (setup)) + (it "Sync completes without error" - (setup) - (org-x-dag-sync t)) + (expect (org-x-dag-sync t) :not :to-throw)) - (it "One random hash is present in the dag" - (expect (org-x-dag-id->title "06592f95-9cf5-4d7e-8546-da7796d76813") - :to-equal - "don't be a dick")) + (describe "Action buffer statuses" + (describe "Projects" + (it "Active" + (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" - (expect (either :left "blabla") :to-be-left-with "blabla")) + ;; TODO these tests are broken because I don't have a robust way + ;; 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" - (expect '(:a 1) :to-have-same-as-plist '(:b 1)))) + (it "Wait" + (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) ;;; org-x-dag-test.el ends here