blob: e99a171e4dbcaf92685069ae1403c7f5f1abe1be (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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
|
