ADD tests for task status

local/lib/org-x/test/org-x-test-buffer-state.el

@@ -23,14 +23,134 @@
 (require 'dash)
 (require 'org-x)
 
-(def-example-group "String Conversion"
+(defun org-ts-to-unixtime (timestamp-string)
-  "Convert nodes to strings."
+  "Convert TIMESTAMP-STRING to unixtime."
+  (let ((decoded (org-parse-time-string timestamp-string)))
+    (->> (-snoc decoded (current-time-zone))
+         (apply #'encode-time)
+         (float-time)
+         (round))))
 
-  (defexamples-content org-x-is-timestamped-heading-p
+(defun org-x-gen-ts (offset)
-    nil
+  "Generate an org timestamp string.
-    (:buffer "* headline")
+OFFSET is the length of time from now in seconds (positive is in
-    (org-x-is-timestamped-heading-p)
+the future)."
-    => nil))
+  (->> (float-time)
+    (+ offset)
+    (org-ml-unixtime-to-time-long)
+    (org-ml-build-timestamp!)
+    (org-ml-to-string)))
+
+(defun org-x-test-parse-forms (s)
+  "Evaluate forms in string S.
+Forms are denoted like %(FORM)%."
+  (--reduce-from (-let (((rep sform) it))
+                   (s-replace rep (format "%s" (eval (read sform))) acc))
+                 s
+                 (s-match-strings-all "%\\((.*?)\\)%" s)))
+
+(defmacro org-ml--with-org-buffer (string &rest body)
+  "Call `org-ml--with-org-env' with BODY and STRING as the buffer."
+  (let ((s (->> (if (listp string) (s-join "\n" string) string)
+             (org-x-test-parse-forms))))
+    `(org-ml--with-org-env (insert ,s) ,@body)))
+
+(defmacro org-x--test-buffer-strings (name test &rest specs)
+  "Run TEST form for SPECS called by toplevel NAME."
+  (declare (indent 2))
+  (let ((forms (->> (-partition 4 specs)
+                 ;; the _op argument is just for looks to make the decl clearer
+                 (--map (-let (((title buffer _op result) it))
+                          `(it ,title
+                             (expect (org-ml--with-org-buffer ,buffer ,test)
+                                     :to-equal
+                                     ,result)))))))
+    `(describe ,name ,@forms)))
+
+(org-x--test-buffer-strings "Task status"
+    (org-x-task-status)
+
+  "no status"
+  "* headline"
+  => nil
+
+  "active"
+  "* TODO headline"
+  => :active
+
+  "active (not yet expired date)"
+  ("* TODO headline"
+   ":PROPERTIES:"
+   ":CREATED: %(org-x-gen-ts (- (* 2 24 60 60)))%"
+   ":X-EXPIRE: %(org-x-gen-ts (* 1 24 60 60))%"
+   ":END:")
+  => :active
+
+  "active (not yet expired dtl)"
+  ("* TODO headline"
+   ":PROPERTIES:"
+   ":CREATED: %(org-x-gen-ts (- (* 2 24 60 60)))%"
+   ":X-DAYS_TO_LIVE: 3"
+   ":END:")
+  => :active
+
+  "done unclosed"
+  "* DONE headline"
+  => :done-unclosed
+
+  "undone closed"
+  ("* TODO headline"
+   "CLOSED: %(org-x-gen-ts 0)%")
+  => :undone-closed
+
+  "complete"
+  ("* DONE headline"
+   "CLOSED: %(org-x-gen-ts 0)%")
+  => :complete
+
+  "archivable"
+  ("* DONE headline"
+   "CLOSED: %(org-x-gen-ts (- (* (1+ org-x-archive-delay) 24 60 60)))%")
+  => :archivable
+
+  "expired (date)"
+  ("* TODO headline"
+   ":PROPERTIES:"
+   ":CREATED: %(org-x-gen-ts (- (* 2 24 60 60)))%"
+   ":X-EXPIRE: %(org-x-gen-ts (- (* 1 24 60 60)))%"
+   ":END:")
+  => :expired
+
+  "expired (dtl)"
+  ("* TODO headline"
+   ":PROPERTIES:"
+   ":CREATED: %(org-x-gen-ts (- (* 2 24 60 60)))%"
+   ":X-DAYS_TO_LIVE: 1"
+   ":END:")
+  => :expired
+
+  "inert (created timestamp)"
+  ("* TODO headline"
+   ":PROPERTIES:"
+   ":CREATED: %(org-x-gen-ts (- (* (1+ org-x-inert-delay-days) 24 60 60)))%"
+   ":END:")
+  => :inert
+
+  "not inert (future deadline)"
+  ("* TODO headline"
+   "DEADLINE: %(org-x-gen-ts (* 1 24 60 60))%"
+   ":PROPERTIES:"
+   ":CREATED: %(org-x-gen-ts (- (* (1+ org-x-inert-delay-days) 24 60 60)))%"
+   ":END:")
+  => :active
+
+  "not inert (future schedule)"
+  ("* TODO headline"
+   "SCHEDULED: %(org-x-gen-ts (* 1 24 60 60))%"
+   ":PROPERTIES:"
+   ":CREATED: %(org-x-gen-ts (- (* (1+ org-x-inert-delay-days) 24 60 60)))%"
+   ":END:")
+  => :active)
 
 (provide 'org-x-test-buffer-state)
 ;;; org-x-test-buffer-state.el ends here

local/lib/org-x/test/org-x-test-common.el

@@ -37,67 +37,67 @@
        (org-mode)
        ,@body)))
 
-(defun example-to-should (actual sym expected)
+;; (defun example-to-should (actual sym expected)
-  (let ((expected
+;;   (let ((expected
-         (if (eq (and (listp expected) (car expected)) :result)
+;;          (if (eq (and (listp expected) (car expected)) :result)
-             (s-join "\n" (cdr expected))
+;;              (s-join "\n" (cdr expected))
-           expected)))
+;;            expected)))
-    (cond ((eq sym '=>)
+;;     (cond ((eq sym '=>)
-           `(expect ,actual :to-equal ,expected))
+;;            `(expect ,actual :to-equal ,expected))
-          ;; this will only work with defexamples-content
+;;           ;; this will only work with defexamples-content
-          ((eq sym '$>)
+;;           ((eq sym '$>)
-           `(expect (progn ,actual (s-trim (buffer-string))) :to-equal ,expected))
+;;            `(expect (progn ,actual (s-trim (buffer-string))) :to-equal ,expected))
-          ;; TODO I never use this?
+;;           ;; TODO I never use this?
-          ((eq sym '~>)
+;;           ((eq sym '~>)
-           `(should (approx-equal ,actual ,expected)))
+;;            `(should (approx-equal ,actual ,expected)))
-          ((eq sym '!!>)
+;;           ((eq sym '!!>)
-           `(should-error (eval ',actual) :type ',expected))
+;;            `(should-error (eval ',actual) :type ',expected))
-          (t
+;;           (t
-           (error "Invalid test case: %S" `(,actual ,sym ,expected))))))
+;;            (error "Invalid test case: %S" `(,actual ,sym ,expected))))))
 
-(defmacro defexamples (cmd &rest examples)
+;; (defmacro defexamples (cmd &rest examples)
-  (let ((tests (->> examples
+;;   (let ((tests (->> examples
-                    (remove :begin-hidden)
+;;                     (remove :begin-hidden)
-                    (remove :end-hidden)
+;;                     (remove :end-hidden)
-                    (-partition 3)
+;;                     (-partition 3)
-                    (--map (apply #'example-to-should it)))))
+;;                     (--map (apply #'example-to-should it)))))
-    (when tests
+;;     (when tests
-      `(it ,(format "%S" cmd) (org-ml--with-org-env ,@tests)))))
+;;       `(it ,(format "%S" cmd) (org-ml--with-org-env ,@tests)))))
 
-(defmacro defexamples-content (cmd _docstring &rest args)
+;; (defmacro defexamples-content (cmd _docstring &rest args)
-  (cl-flet*
+;;   (cl-flet*
-      ((make-test-form
+;;       ((make-test-form
-        (test contents)
+;;         (test contents)
-        `(org-ml--with-org-env
+;;         `(org-ml--with-org-env
-          (when ,contents (insert ,contents))
+;;           (when ,contents (insert ,contents))
-          (goto-char (point-min))
+;;           (goto-char (point-min))
-          ,test))
+;;           ,test))
-       (make-tests
+;;        (make-tests
-        (list)
+;;         (list)
-        (let ((contents (->> (car list) (-drop 1) (s-join "\n")))
+;;         (let ((contents (->> (car list) (-drop 1) (s-join "\n")))
-              (tests
+;;               (tests
-               (->> (-drop 1 list)
+;;                (->> (-drop 1 list)
-                    (--remove (eq (and (listp it) (car it)) :comment))
+;;                     (--remove (eq (and (listp it) (car it)) :comment))
-                    (-partition 3)
+;;                     (-partition 3)
-                    (--map (apply #'example-to-should it)))))
+;;                     (--map (apply #'example-to-should it)))))
-          (--map (make-test-form it contents) tests))))
+;;           (--map (make-test-form it contents) tests))))
-    (let ((body
+;;     (let ((body
-           (->> args
+;;            (->> args
-                (remove :begin-hidden)
+;;                 (remove :begin-hidden)
-                (remove :end-hidden)
+;;                 (remove :end-hidden)
-                (-partition-before-pred
+;;                 (-partition-before-pred
-                 (lambda (it) (eq (and (listp it) (car it)) :buffer)))
+;;                  (lambda (it) (eq (and (listp it) (car it)) :buffer)))
-                (-mapcat #'make-tests))))
+;;                 (-mapcat #'make-tests))))
-      (when body
+;;       (when body
-        `(it ,(format "%S" cmd) ,@body)))))
+;;         `(it ,(format "%S" cmd) ,@body)))))
 
-(defmacro def-example-subgroup (title _subtitle &rest specs)
+;; (defmacro def-example-subgroup (title _subtitle &rest specs)
-  (when specs
+;;   (when specs
-    `(describe ,title ,@specs)))
+;;     `(describe ,title ,@specs)))
 
-(defmacro def-example-group (title _subtitle &rest specs)
+;; (defmacro def-example-group (title _subtitle &rest specs)
-  (when specs
+;;   (when specs
-    `(describe ,title ,@specs)))
+;;     `(describe ,title ,@specs)))
 
 (provide 'org-ml-test-common)
 ;;; org-ml-test-common.el ends here