ADD tests for task status
This commit is contained in:
parent
7ad244a1a3
commit
f000e0df23
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue