From f000e0df23a93fb820c3867cdff5706f445df9e4 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sun, 4 Apr 2021 23:34:35 -0400 Subject: [PATCH] ADD tests for task status --- .../lib/org-x/test/org-x-test-buffer-state.el | 134 +++++++++++++++++- local/lib/org-x/test/org-x-test-common.el | 114 +++++++-------- 2 files changed, 184 insertions(+), 64 deletions(-) diff --git a/local/lib/org-x/test/org-x-test-buffer-state.el b/local/lib/org-x/test/org-x-test-buffer-state.el index e535d5f..29a1c9e 100644 --- a/local/lib/org-x/test/org-x-test-buffer-state.el +++ b/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" - "Convert nodes to strings." +(defun org-ts-to-unixtime (timestamp-string) + "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 - nil - (:buffer "* headline") - (org-x-is-timestamped-heading-p) - => nil)) +(defun org-x-gen-ts (offset) + "Generate an org timestamp string. +OFFSET is the length of time from now in seconds (positive is in +the future)." + (->> (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 diff --git a/local/lib/org-x/test/org-x-test-common.el b/local/lib/org-x/test/org-x-test-common.el index d4b3180..4d576e5 100644 --- a/local/lib/org-x/test/org-x-test-common.el +++ b/local/lib/org-x/test/org-x-test-common.el @@ -37,67 +37,67 @@ (org-mode) ,@body))) -(defun example-to-should (actual sym expected) - (let ((expected - (if (eq (and (listp expected) (car expected)) :result) - (s-join "\n" (cdr expected)) - expected))) - (cond ((eq sym '=>) - `(expect ,actual :to-equal ,expected)) - ;; this will only work with defexamples-content - ((eq sym '$>) - `(expect (progn ,actual (s-trim (buffer-string))) :to-equal ,expected)) - ;; TODO I never use this? - ((eq sym '~>) - `(should (approx-equal ,actual ,expected))) - ((eq sym '!!>) - `(should-error (eval ',actual) :type ',expected)) - (t - (error "Invalid test case: %S" `(,actual ,sym ,expected)))))) +;; (defun example-to-should (actual sym expected) +;; (let ((expected +;; (if (eq (and (listp expected) (car expected)) :result) +;; (s-join "\n" (cdr expected)) +;; expected))) +;; (cond ((eq sym '=>) +;; `(expect ,actual :to-equal ,expected)) +;; ;; this will only work with defexamples-content +;; ((eq sym '$>) +;; `(expect (progn ,actual (s-trim (buffer-string))) :to-equal ,expected)) +;; ;; TODO I never use this? +;; ((eq sym '~>) +;; `(should (approx-equal ,actual ,expected))) +;; ((eq sym '!!>) +;; `(should-error (eval ',actual) :type ',expected)) +;; (t +;; (error "Invalid test case: %S" `(,actual ,sym ,expected)))))) -(defmacro defexamples (cmd &rest examples) - (let ((tests (->> examples - (remove :begin-hidden) - (remove :end-hidden) - (-partition 3) - (--map (apply #'example-to-should it))))) - (when tests - `(it ,(format "%S" cmd) (org-ml--with-org-env ,@tests))))) +;; (defmacro defexamples (cmd &rest examples) +;; (let ((tests (->> examples +;; (remove :begin-hidden) +;; (remove :end-hidden) +;; (-partition 3) +;; (--map (apply #'example-to-should it))))) +;; (when tests +;; `(it ,(format "%S" cmd) (org-ml--with-org-env ,@tests))))) -(defmacro defexamples-content (cmd _docstring &rest args) - (cl-flet* - ((make-test-form - (test contents) - `(org-ml--with-org-env - (when ,contents (insert ,contents)) - (goto-char (point-min)) - ,test)) - (make-tests - (list) - (let ((contents (->> (car list) (-drop 1) (s-join "\n"))) - (tests - (->> (-drop 1 list) - (--remove (eq (and (listp it) (car it)) :comment)) - (-partition 3) - (--map (apply #'example-to-should it))))) - (--map (make-test-form it contents) tests)))) - (let ((body - (->> args - (remove :begin-hidden) - (remove :end-hidden) - (-partition-before-pred - (lambda (it) (eq (and (listp it) (car it)) :buffer))) - (-mapcat #'make-tests)))) - (when body - `(it ,(format "%S" cmd) ,@body))))) +;; (defmacro defexamples-content (cmd _docstring &rest args) +;; (cl-flet* +;; ((make-test-form +;; (test contents) +;; `(org-ml--with-org-env +;; (when ,contents (insert ,contents)) +;; (goto-char (point-min)) +;; ,test)) +;; (make-tests +;; (list) +;; (let ((contents (->> (car list) (-drop 1) (s-join "\n"))) +;; (tests +;; (->> (-drop 1 list) +;; (--remove (eq (and (listp it) (car it)) :comment)) +;; (-partition 3) +;; (--map (apply #'example-to-should it))))) +;; (--map (make-test-form it contents) tests)))) +;; (let ((body +;; (->> args +;; (remove :begin-hidden) +;; (remove :end-hidden) +;; (-partition-before-pred +;; (lambda (it) (eq (and (listp it) (car it)) :buffer))) +;; (-mapcat #'make-tests)))) +;; (when body +;; `(it ,(format "%S" cmd) ,@body))))) -(defmacro def-example-subgroup (title _subtitle &rest specs) - (when specs - `(describe ,title ,@specs))) +;; (defmacro def-example-subgroup (title _subtitle &rest specs) +;; (when specs +;; `(describe ,title ,@specs))) -(defmacro def-example-group (title _subtitle &rest specs) - (when specs - `(describe ,title ,@specs))) +;; (defmacro def-example-group (title _subtitle &rest specs) +;; (when specs +;; `(describe ,title ,@specs))) (provide 'org-ml-test-common) ;;; org-ml-test-common.el ends here