ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ADD tests for task status

This commit is contained in:
Nathan Dwarshuis 2021-04-04 23:34:35 -04:00
parent 7ad244a1a3
commit f000e0df23
2 changed files with 184 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
local/lib/org-x/test/org-x-test-buffer-state.el
View File

@ -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

114
local/lib/org-x/test/org-x-test-common.el
View File

@ -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