From 6b04aa2d5397cebca99e133ecc0853c8ca36bd56 Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Tue, 5 May 2026 04:49:40 -0500 Subject: test: explain-text helpers and SM-or-Leitner dispatch 9 ERT tests covering: - get-explain-text: no :explain: parent returns existing-text, parent with :explain: tag adds its body, recursion stops at top-level outline depth - explain-answer-presenter: creates after-string overlay with Explanation: prefix, replaces prior overlay on second call - explain-cleaner: removes the overlay, no-op on missing overlay - sm-or-leitner: runs SM (via org-drill-again) when pending entries exceed leitner-completed, falls through to Leitner otherwise --- tests/test-org-drill-explain-text-and-leitner.el | 161 +++++++++++++++++++++++ 1 file changed, 161 insertions(+) create mode 100644 tests/test-org-drill-explain-text-and-leitner.el diff --git a/tests/test-org-drill-explain-text-and-leitner.el b/tests/test-org-drill-explain-text-and-leitner.el new file mode 100644 index 0000000..99f794a --- /dev/null +++ b/tests/test-org-drill-explain-text-and-leitner.el @@ -0,0 +1,161 @@ +;;; test-org-drill-explain-text-and-leitner.el --- Tests for explain helpers and leitner dispatch -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for: +;; +;; - `org-drill-get-explain-text': walks up the outline collecting body +;; text from any parent heading tagged `:explain:'. +;; - `org-drill-explain-answer-presenter': appends an explanation +;; overlay below the entry. +;; - `org-drill-explain-cleaner': removes the explanation overlay. +;; - `org-drill-sm-or-leitner': chooses between SM and Leitner +;; learning based on the pending entry count. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) +(require 'org-drill) + +;;;; Helpers + +(defmacro with-org-buffer (content &rest body) + (declare (indent 1)) + `(with-temp-buffer + (let ((org-startup-folded nil)) + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +;;;; org-drill-get-explain-text + +(ert-deftest test-get-explain-text-no-explain-parent-returns-existing-text () + "When no parent has :explain:, returns the existing-text arg unchanged." + (with-org-buffer "* Parent\n** Child :drill:\nbody\n" + (re-search-forward "^\\*\\* Child") + (org-back-to-heading t) + (should (equal '("preserved") + (org-drill-get-explain-text '("preserved")))))) + +(ert-deftest test-get-explain-text-with-explain-parent-collects-body () + "Parent tagged :explain: contributes its body text to the result." + (with-org-buffer "* Parent :explain: +explain-body +** Child :drill: +drill-body +" + (re-search-forward "^\\*\\* Child") + (org-back-to-heading t) + (let ((result (org-drill-get-explain-text))) + (should (listp result)) + (should (= 1 (length result))) + (should (string-match-p "explain-body" (car result)))))) + +(ert-deftest test-get-explain-text-stops-at-top-level () + "Recursion stops when outline-level reaches 1 (no further parents)." + (with-org-buffer "* Top\nbody\n" + (org-back-to-heading t) + ;; outline-level is 1 → returns existing-text immediately. + (should (null (org-drill-get-explain-text))))) + +;;;; org-drill-explain-answer-presenter + +(ert-deftest test-explain-answer-presenter-creates-overlay-with-explanation () + "Creates an overlay below the entry whose after-string contains the +collected explanation text." + (with-org-buffer "* Parent :explain: +the-explanation +** Child :drill: +the-question +" + (re-search-forward "^\\*\\* Child") + (org-back-to-heading t) + (setq org-drill-explain-overlay nil) + (org-drill-explain-answer-presenter) + (should org-drill-explain-overlay) + (let ((after-text (overlay-get org-drill-explain-overlay 'after-string))) + (should (string-match-p "Explanation:" after-text)) + (should (string-match-p "the-explanation" after-text))) + (delete-overlay org-drill-explain-overlay) + (setq org-drill-explain-overlay nil))) + +(ert-deftest test-explain-answer-presenter-replaces-existing-overlay () + "Calling twice doesn't accumulate overlays — the prior one is cleared." + (with-org-buffer "* Parent :explain:\nA\n** Child :drill:\nQ\n" + (re-search-forward "^\\*\\* Child") + (org-back-to-heading t) + (setq org-drill-explain-overlay nil) + (org-drill-explain-answer-presenter) + (let ((first-overlay org-drill-explain-overlay)) + (org-drill-explain-answer-presenter) + ;; First overlay is no longer live in the buffer. + (should-not (memq first-overlay (overlays-in (point-min) (point-max))))) + (delete-overlay org-drill-explain-overlay) + (setq org-drill-explain-overlay nil))) + +;;;; org-drill-explain-cleaner + +(ert-deftest test-explain-cleaner-removes-the-overlay () + (with-org-buffer "* Parent :explain:\nA\n** Child :drill:\nQ\n" + (re-search-forward "^\\*\\* Child") + (org-back-to-heading t) + (setq org-drill-explain-overlay nil) + (org-drill-explain-answer-presenter) + (should org-drill-explain-overlay) + (org-drill-explain-cleaner) + (should-not (memq org-drill-explain-overlay + (overlays-in (point-min) (point-max)))) + (setq org-drill-explain-overlay nil))) + +(ert-deftest test-explain-cleaner-no-overlay-no-error () + "Cleaner is safe to call when no overlay exists." + (setq org-drill-explain-overlay nil) + ;; Should not error. + (org-drill-explain-cleaner)) + +;;;; org-drill-sm-or-leitner + +(ert-deftest test-sm-or-leitner-with-pending-entries-runs-again () + "When the prior session has pending entries beyond leitner-completed, +sm-or-leitner runs the SM (org-drill-again) flow." + (let ((again-called nil) + (leitner-called nil) + (session (org-drill-session))) + (oset session new-entries + (list (let ((m (make-marker))) (set-marker m 1) m) + (let ((m (make-marker))) (set-marker m 1) m))) + (oset session start-time (float-time (current-time))) + (let ((org-drill-last-session session) + (org-drill-leitner-completed 0)) + (cl-letf (((symbol-function 'org-drill-again) + (lambda () (setq again-called t))) + ((symbol-function 'org-drill-leitner) + (lambda (&rest _) (setq leitner-called t))) + ((symbol-function 'sit-for) #'ignore) + ((symbol-function 'org-drill-map-entries) #'ignore)) + (org-drill-sm-or-leitner) + (should again-called) + (should-not leitner-called))))) + +(ert-deftest test-sm-or-leitner-no-pending-entries-runs-leitner () + "When there's nothing pending in SM-style, fall through to Leitner." + (let ((again-called nil) + (leitner-called nil) + (session (org-drill-session))) + (let ((org-drill-last-session session) + (org-drill-leitner-completed 0)) + (cl-letf (((symbol-function 'org-drill-again) + (lambda () (setq again-called t))) + ((symbol-function 'org-drill-leitner) + (lambda (&rest _) (setq leitner-called t))) + ((symbol-function 'sit-for) #'ignore) + ((symbol-function 'org-drill-map-entries) #'ignore)) + (org-drill-sm-or-leitner) + (should-not again-called) + (should leitner-called))))) + +(provide 'test-org-drill-explain-text-and-leitner) + +;;; test-org-drill-explain-text-and-leitner.el ends here -- cgit v1.2.3