aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-05-05 05:01:35 -0500
committerCraig Jennings <c@cjennings.net>2026-05-05 05:01:35 -0500
commit656faefc0e030ea476f9937116b727331cec607f (patch)
tree1421c17a9f038f77be34c37c78cc397ae6f7ba9c
parent27f6f3087a3191200d657c94762984f10dcf89ca (diff)
downloadorg-drill-656faefc0e030ea476f9937116b727331cec607f.tar.gz
org-drill-656faefc0e030ea476f9937116b727331cec607f.zip
test: org-drill-entry-f per-card dispatcher
5 ERT tests for the per-entry dispatcher: - unknown DRILL_CARD_TYPE returns 'skip and doesn't call answer-fn - presenter returns nil (quit) → entry-f returns nil - presenter returns 'edit → propagates unchanged - presenter returns 'skip → propagates unchanged - presenter returns t (successful) → default answer presenter runs and the complete-func (reschedule) is invoked with the session
-rw-r--r--tests/test-org-drill-entry-f.el102
1 files changed, 102 insertions, 0 deletions
diff --git a/tests/test-org-drill-entry-f.el b/tests/test-org-drill-entry-f.el
new file mode 100644
index 0000000..e99a171
--- /dev/null
+++ b/tests/test-org-drill-entry-f.el
@@ -0,0 +1,102 @@
+;;; test-org-drill-entry-f.el --- Tests for org-drill-entry-f dispatcher -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Tests for `org-drill-entry-f', the per-entry dispatcher. Given a
+;; card's DRILL_CARD_TYPE, looks up the presentation function in
+;; `org-drill-card-type-alist' and invokes it. Returns whatever the
+;; presenter returns, with quit / edit / skip propagated and successful
+;; ratings handed off to the answer function.
+;;
+;; Tests verify the dispatch contract: the right presentation function
+;; is called for the configured card type, and unknown card types
+;; result in `skip'.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+(require 'org)
+(require 'org-drill)
+
+;;;; Helpers
+
+(defmacro with-drill-entry (card-type &rest body)
+ "Run BODY at point on a drill entry with DRILL_CARD_TYPE = CARD-TYPE."
+ (declare (indent 1))
+ `(with-temp-buffer
+ (let ((org-startup-folded nil))
+ (insert (format "* Question :drill:\n:PROPERTIES:\n:DRILL_CARD_TYPE: %s\n:END:\nbody body body\n"
+ ,card-type))
+ (org-mode)
+ (goto-char (point-min))
+ ,@body)))
+
+;;;; Unknown card type → 'skip
+
+(ert-deftest test-entry-f-unknown-card-type-returns-skip ()
+ "An unrecognised DRILL_CARD_TYPE causes the entry to be skipped."
+ (with-drill-entry "no-such-card-type"
+ (let ((session (org-drill-session))
+ (answer-called nil))
+ (cl-letf (((symbol-function 'sit-for) #'ignore))
+ (let ((result (org-drill-entry-f
+ session
+ (lambda (_) (setq answer-called t)))))
+ (should (eq 'skip result))
+ (should-not answer-called))))))
+
+;;;; Quit propagates
+
+(ert-deftest test-entry-f-presenter-returns-nil-propagates-as-quit ()
+ "If the presenter returns nil (quit), entry-f returns nil too."
+ (with-drill-entry "simple"
+ (let ((session (org-drill-session)))
+ (cl-letf (((symbol-function 'org-drill-present-simple-card)
+ (lambda (_) nil))
+ ((symbol-function 'sit-for) #'ignore))
+ (let ((result (org-drill-entry-f session #'ignore)))
+ (should (null result)))))))
+
+;;;; Edit propagates
+
+(ert-deftest test-entry-f-presenter-returns-edit-propagates ()
+ "An 'edit return from the presenter passes through unchanged."
+ (with-drill-entry "simple"
+ (let ((session (org-drill-session)))
+ (cl-letf (((symbol-function 'org-drill-present-simple-card)
+ (lambda (_) 'edit))
+ ((symbol-function 'sit-for) #'ignore))
+ (let ((result (org-drill-entry-f session #'ignore)))
+ (should (eq 'edit result)))))))
+
+;;;; Skip propagates
+
+(ert-deftest test-entry-f-presenter-returns-skip-propagates ()
+ (with-drill-entry "simple"
+ (let ((session (org-drill-session)))
+ (cl-letf (((symbol-function 'org-drill-present-simple-card)
+ (lambda (_) 'skip))
+ ((symbol-function 'sit-for) #'ignore))
+ (let ((result (org-drill-entry-f session #'ignore)))
+ (should (eq 'skip result)))))))
+
+;;;; Successful presenter return → answer-fn called
+
+(ert-deftest test-entry-f-presenter-success-calls-answer-fn ()
+ "When the presenter returns t, the default answer presenter runs and
+the complete-func (e.g., reschedule) is invoked with the session."
+ (with-drill-entry "simple"
+ (let ((session (org-drill-session))
+ (complete-called nil))
+ (cl-letf (((symbol-function 'org-drill-present-simple-card)
+ (lambda (_) t))
+ ((symbol-function 'org-drill-present-default-answer)
+ (lambda (s reschedule-fn) (funcall reschedule-fn s)))
+ ((symbol-function 'sit-for) #'ignore))
+ (org-drill-entry-f session
+ (lambda (_) (setq complete-called t)))
+ (should complete-called)))))
+
+(provide 'test-org-drill-entry-f)
+
+;;; test-org-drill-entry-f.el ends here