ADD tests for task status
This commit is contained in:
parent
7ad244a1a3
commit
f000e0df23
|
@ -23,14 +23,134 @@
|
||||||
(require 'dash)
|
(require 'dash)
|
||||||
(require 'org-x)
|
(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)
|
(provide 'org-x-test-buffer-state)
|
||||||
;;; org-x-test-buffer-state.el ends here
|
;;; org-x-test-buffer-state.el ends here
|
||||||
|
|
|
@ -37,67 +37,67 @@
|
||||||
(org-mode)
|
(org-mode)
|
||||||
,@body)))
|
,@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)
|
(provide 'org-ml-test-common)
|
||||||
;;; org-ml-test-common.el ends here
|
;;; org-ml-test-common.el ends here
|
||||||
|
|
Loading…
Reference in New Issue