blob: 1beed34e3e2e67f10cd836dff485726c7c970019 (
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
;;; 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)))))
;;;; org-drill--resolve-presenter
(ert-deftest test-org-drill-resolve-presenter-bare-symbol ()
"A bare presenter symbol pairs with the default answer function."
(let ((org-drill-card-type-alist '(("simple" . my-present))))
(should (equal '(my-present . org-drill-present-default-answer)
(org-drill--resolve-presenter "simple")))))
(ert-deftest test-org-drill-resolve-presenter-list-with-answer ()
"A list entry uses its first element as presenter and second as answer."
(let ((org-drill-card-type-alist '(("two" my-present my-answer))))
(should (equal '(my-present . my-answer)
(org-drill--resolve-presenter "two")))))
(ert-deftest test-org-drill-resolve-presenter-list-without-answer ()
"A single-element list entry falls back to the default answer function."
(let ((org-drill-card-type-alist '(("one" my-present))))
(should (equal '(my-present . org-drill-present-default-answer)
(org-drill--resolve-presenter "one")))))
(ert-deftest test-org-drill-resolve-presenter-unknown-is-nil ()
"An unknown card type resolves to a nil presenter (which entry-f skips)."
(let ((org-drill-card-type-alist '(("simple" . my-present))))
(should (equal '(nil . org-drill-present-default-answer)
(org-drill--resolve-presenter "no-such-type")))))
;;;; org-drill--classify-presentation-result
(ert-deftest test-org-drill-classify-result-nil-is-quit ()
(should (eq 'quit (org-drill--classify-presentation-result nil))))
(ert-deftest test-org-drill-classify-result-edit ()
(should (eq 'edit (org-drill--classify-presentation-result 'edit))))
(ert-deftest test-org-drill-classify-result-skip ()
(should (eq 'skip (org-drill--classify-presentation-result 'skip))))
(ert-deftest test-org-drill-classify-result-other-is-answer ()
"Any other non-nil value means proceed to the answer."
(should (eq 'answer (org-drill--classify-presentation-result t)))
(should (eq 'answer (org-drill--classify-presentation-result 5))))
(provide 'test-org-drill-entry-f)
;;; test-org-drill-entry-f.el ends here
|
