Cleaned up tests, added new macro

lisp/org-ql-custom-stuck-projects.el

@@ -70,7 +70,7 @@
                                           (reverse))))
                              (setf display (append res display)))))
                         ('task
-                         (when (member (opr/type-of-task) '(stuck wait))
+                         (when (eq 'stuck (opr/type-of-task))
                            (push (org-ql--add-markers (org-element-headline-parser (point)))
                                  display))))))
                   (reverse display))))))))

tests/files/canary.org

@@ -0,0 +1,17 @@
+
+* This test should pass
+#+begin_src emacs-lisp
+  (should t)
+#+end_src
+
+* This test should also pass
+DEADLINE: <2022-09-30 Fri> SCHEDULED: <2022-09-30 Fri>
+:PROPERTIES:
+:HELLO:    WORLD
+:END:
+#+begin_src common-lisp
+  (should nil)
+#+end_src
+#+begin_src emacs-lisp
+  (should t)
+#+end_src

tests/files/meta-active-base.org

@@ -8,12 +8,3 @@ DEADLINE: <1997-01-01 Wed>
 ** META Subproject
 *** TASK Active task
 SCHEDULED: <1997-01-01 Wed>
-* META should be active if there are past-due waiting tasks
-** WAIT for this to happen
-SCHEDULED: <1970-01-01 Thu>
-- State "WAIT"       from              [2022-09-29 Thu 16:53]
-* META should be active, as long as one componenent is active, since WAIT is "invisible"
-** WAIT for this thing
-SCHEDULED: <2037-12-31 Thu>
-** TASK Active task
-SCHEDULED: <1970-01-01 Thu>

tests/files/meta-stuck-base.org

@@ -13,6 +13,3 @@
 * META should be stuck even if there are deadlined dones
 ** DONE Deadlined done task
 DEADLINE: <2021-06-21 Mon>
-* META should be stuck if there is one single WAIT task that is scheduled, and no other tasks
-** WAIT for this thing
-SCHEDULED: <2037-12-31 Thu>

tests/files/seq-invis.org

@@ -1,4 +0,0 @@
-* SEQ should be invisible if there is a wait task in the future
-** WAIT Waiting task
-SCHEDULED: <3000-01-01 Wed>
-

tests/files/wait-active.org

@@ -1,2 +0,0 @@
-* WAIT tasks are active if their scheduled date has passed
-SCHEDULED: <1970-01-01 Thu>

tests/files/wait-behavior.org

@@ -0,0 +1,41 @@
+* WAIT tasks are stuck if there is no schedule
+#+begin_src emacs-lisp
+  (should (eq 'stuck (opr/type-of-task)))
+#+end_src
+* WAIT tasks are active if their scheduled date has passed
+SCHEDULED: <1970-01-01 Thu>
+#+begin_src emacs-lisp
+  (should (eq 'active (opr/type-of-task)))
+#+end_src
+* WAIT tasks are wait if their scheduled date is in the future
+SCHEDULED: <2037-01-01 Thu>
+#+begin_src emacs-lisp
+  (should (eq 'wait (opr/type-of-task)))
+#+end_src
+* META should be stuck if there is one single WAIT task that is scheduled, and no other tasks
+#+begin_src emacs-lisp
+  (should (eq 'stuck (opr/type-of-project)))
+#+end_src
+** WAIT for this thing
+SCHEDULED: <2037-12-31 Thu>
+* META should be stuck if there are past-due waiting tasks
+#+begin_src emacs-lisp
+  (should (eq 'active (opr/type-of-project)))
+#+end_src
+** WAIT for this to happen
+SCHEDULED: <1970-01-01 Thu>
+- State "WAIT"       from              [2022-09-29 Thu 16:53]
+* META should be active, as long as one componenent is active, since WAIT is "invisible"
+#+begin_src emacs-lisp
+  (should (eq 'active (opr/type-of-project)))
+#+end_src
+** WAIT for this thing
+SCHEDULED: <2037-12-31 Thu>
+** TASK Active task
+SCHEDULED: <1970-01-01 Thu>
+* SEQ should be invisible if there is a wait task in the future
+#+begin_src emacs-lisp
+  (should (eq 'invis (opr/type-of-project)))
+#+end_src
+** WAIT Waiting task
+SCHEDULED: <3000-01-01 Wed>

tests/files/wait-stuck.org

@@ -1,2 +0,0 @@
-
-* WAIT tasks are stuck if there is no schedule

tests/my-org-tests.el

@@ -26,14 +26,50 @@
                                           (let ((,buffer-gensym (find-file-noselect ,file)))
                                             (with-current-buffer ,buffer-gensym
                                               (goto-char ,(point))
-                                              ,@body)
+                                              ,@body)))
-                                            (kill-buffer ,buffer-gensym)))
                                do (org-end-of-subtree t t)))
                (kill-buffer buffer)))))))
 
+(defmacro org-test/test-each (file)
+  (declare (indent defun))
+  (let ((file (expand-file-name file org-tests-directory))
+        (buffer-gensym (gensym "buffer")))
+    `(progn
+       ,@(save-window-excursion
+           (let ((buffer (find-file-noselect file)))
+             (prog1 (with-current-buffer buffer
+                      (beginning-of-buffer)
+                      (when (not (org-at-heading-p))
+                        (outline-next-heading))
+                      (let ((end-of-tree (save-excursion (org-end-of-subtree t t))))
+                        (cl-loop until (eobp)
+                                 for test-name = (intern (replace-regexp-in-string " " "-" (org-get-heading t nil t t)))
+                                 if (member "disabled" (org-get-tags))
+                                 do (add-to-list 'org-disabled-tests
+                                                 test-name)
+                                 else
+                                 when (not (member test-name org-disabled-tests))
+                                 collect `(ert-deftest ,test-name ()
+                                            (let ((,buffer-gensym (find-file-noselect ,file)))
+                                              (with-current-buffer ,buffer-gensym
+                                                (goto-char ,(point))
+                                                ,@(save-excursion
+                                                    (while (progn (next-line)
+                                                                  (beginning-of-line)
+                                                                  (not (and (let ((context (org-element-context)))
+                                                                              (and (eq 'src-block
+                                                                                       (car context))
+                                                                                   (string= "emacs-lisp"
+                                                                                            (plist-get (cadr context) :language))))))))
+                                                    (let ((body (org-babel--expand-body (org-babel-get-src-block-info))))
+                                                      (read (concat "(" body ")")))))))
+                                 do (org-end-of-subtree t t))))))))))
+
 (ert-deftest canary-test ()
   (should t))
 
+(org-test/test-each "canary.org")
+
 (org-test/parents-should "seq-stuck.org"
   (should (eq 'stuck (opr/type-of-project))))
 
@@ -67,14 +103,7 @@
   (should (null (my/org-agenda-skip-unless-prod-tag)))
   (should (not (null (my/org-agenda-skip-unless-dev-tag)))))
 
-(org-test/parents-should "wait-stuck.org"
+(org-test/test-each "wait-behavior.org")
-  (should (eq 'stuck (opr/type-of-task))))
-
-(org-test/parents-should "wait-wait.org"
-  (should (eq 'wait (opr/type-of-task))))
-
-(org-test/parents-should "wait-active.org"
-  (should (eq 'active (opr/type-of-task))))
 
 (ert-run-tests-interactively t)