path: root/.ai/scripts/tests/test-todo-cleanup.el

;;; test-todo-cleanup.el --- ERT tests for todo-cleanup.el  -*- lexical-binding: t; -*-
;;
;; Run from the repo root:
;;   emacs --batch -q -L .ai/scripts -l ert \
;;         -l .ai/scripts/tests/test-todo-cleanup.el \
;;         -f ert-run-tests-batch-and-exit
;;
;; or from .ai/scripts/tests/:
;;   emacs --batch -q -L .. -l ert -l test-todo-cleanup.el \
;;         -f ert-run-tests-batch-and-exit
;;
;; Covers the `--archive-done' mode: moving level-2 DONE/CANCELLED subtrees
;; out of the "Open Work" section into the "Resolved" section.

(require 'ert)
(require 'cl-lib)

(defconst tc-test--dir
  (file-name-directory (or load-file-name buffer-file-name default-directory))
  "Directory of this test file, captured at load time.")

;; Make `todo-cleanup' loadable from the parent directory.  Loading it is
;; inert: its CLI dispatch only fires when the trailing command-line args look
;; like a real invocation (recognized flags / readable file paths), which they
;; don't during `ert-run-tests-batch-and-exit'.
(add-to-list 'load-path (expand-file-name ".." tc-test--dir))
(require 'todo-cleanup)

;;; ---------------------------------------------------------------------------
;;; Harness

(defun tc-test--reset (&optional check)
  (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-archived-to-file 0 tc-issues nil
        tc-check-only (and check t)
        tc-archive-done t tc-sync-child-priority nil
        tc-current-file nil
        ;; Aging step OFF by default so the in-file-move tests are unaffected by
        ;; the wall clock; the aging harness re-enables it with fixed params.
        tc-archive-retain-days nil tc-archive-reference-date nil tc-archive-file nil))

(defun tc-test--reset-sync (&optional check)
  (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-archived-to-file 0 tc-issues nil
        tc-check-only (and check t)
        tc-archive-done nil tc-sync-child-priority t
        tc-current-file nil
        tc-archive-retain-days nil tc-archive-reference-date nil tc-archive-file nil))

(defun tc-test--drop-buffer (file)
  (let ((buf (find-buffer-visiting file)))
    (when buf
      (with-current-buffer buf (set-buffer-modified-p nil))
      (kill-buffer buf))))

(defun tc-test--archive (content &optional runs check)
  "Write CONTENT to a temp .org file, run `--archive-done' RUNS times (default 1).
Return a plist: :result final file contents, :archived count from the last run,
:issues from the last run.  CHECK non-nil ⇒ --check (preview, no writes)."
  (let ((file (make-temp-file "tc-test-" nil ".org"))
        last-archived last-issues)
    (unwind-protect
        (progn
          (with-temp-file file (insert content))
          (dotimes (_ (or runs 1))
            (tc-test--reset check)
            (tc-process-file file)
            (setq last-archived tc-archived last-issues tc-issues)
            (tc-test--drop-buffer file))
          (list :result (with-temp-buffer (insert-file-contents file)
                                          (buffer-string))
                :archived last-archived
                :issues last-issues))
      (tc-test--drop-buffer file)
      (delete-file file))))

(defun tc-test--archive-report (content &optional runs check)
  "Like `tc-test--archive' but also returns :report — the captured stdout of
`tc--emit-archive-report' from the last run.  After the run loop the globals
still hold the last run's `tc-archived'/`tc-issues'/`tc-check-only', so the
captured report is the one that run would have printed."
  (let ((file (make-temp-file "tc-test-" nil ".org"))
        last-archived last-issues report)
    (unwind-protect
        (progn
          (with-temp-file file (insert content))
          (dotimes (_ (or runs 1))
            (tc-test--reset check)
            (tc-process-file file)
            (setq last-archived tc-archived last-issues tc-issues)
            (tc-test--drop-buffer file))
          (setq report (with-output-to-string (tc--emit-archive-report)))
          (list :report report
                :archived last-archived
                :issues last-issues))
      (tc-test--drop-buffer file)
      (delete-file file))))

(defun tc-test--section (content needle)
  "Text of the level-1 section in CONTENT whose heading line contains NEEDLE —
from the heading line through (not including) the next level-1 heading or EOF."
  (with-temp-buffer
    (insert content)
    (goto-char (point-min))
    (let (start)
      (while (and (not start) (re-search-forward "^\\* .*$" nil t))
        (when (string-match-p (regexp-quote needle) (match-string 0))
          (setq start (match-beginning 0))))
      (unless start (error "no level-1 heading containing %S" needle))
      (goto-char start)
      (forward-line 1)
      (buffer-substring-no-properties
       start
       (if (re-search-forward "^\\* " nil t) (match-beginning 0) (point-max))))))

(defun tc-test--has (string substring)
  (and (string-match-p (regexp-quote substring) string) t))

(defun tc-test--before-p (string a b)
  "Non-nil when SUBSTRING A occurs before SUBSTRING B in STRING."
  (let ((ia (string-match (regexp-quote a) string))
        (ib (string-match (regexp-quote b) string)))
    (and ia ib (< ia ib))))

(defun tc-test--skip-detail (issues)
  (let ((skip (cl-find-if (lambda (i) (eq (plist-get i :kind) 'archive-skip)) issues)))
    (and skip (plist-get skip :detail))))

(defun tc-test--moved-headings (issues)
  (mapcar (lambda (i) (plist-get i :heading))
          (cl-remove-if-not
           (lambda (i) (memq (plist-get i :kind) '(archive-moved archive-would)))
           (reverse issues))))

;;; ---------------------------------------------------------------------------
;;; Fixtures (synthetic — real project todo.org files are examples only)

(defconst tc-test--basic "\
* Demo Open Work
** TODO [#A] First open task
   first body
** DONE [#A] A finished task
   finished body
** TODO [#B] Another open task
* Demo Resolved
** DONE [#A] Previously archived
")

(defconst tc-test--mixed "\
* Proj Open Work
** TODO Keep me open
** DONE Done one
*** TODO leftover child of done one
** A structural heading with no state
** CANCELLED Cancelled two :quick:
** TODO Has a done child
*** DONE this nested done stays
** DONE Done three
* Proj Resolved
** DONE Old archived item
")

(defconst tc-test--nothing "\
* X Open Work
** TODO a
** WAITING b
** NEXT c
* X Resolved
** DONE old
")

(defconst tc-test--no-resolved "\
* Y Open Work
** DONE finished
** TODO ongoing
")

(defconst tc-test--no-open "\
* Z Resolved
** DONE old
* Some Other Section
** TODO whatever
")

(defconst tc-test--two-resolved "\
* P Open Work
** DONE done
* P Resolved
** DONE old1
* Q Resolved Notes
** DONE old2
")

;; No trailing newline — exercises the EOF / final-line case.  Open Work is the
;; last section, so a DONE level-2 here is also the last subtree in the file.
(defconst tc-test--eof "\
* W Resolved
** DONE pre-existing
* W Open Work
** TODO keep open
** DONE last thing
   body of last thing")

(defconst tc-test--lowercase "\
* winvm open work
** TODO test rebuilt vm
** DONE fix display resolution
* winvm resolved
** DONE fork linoffice as winvm
")

;;; ---------------------------------------------------------------------------
;;; Tests

(ert-deftest tc-archive-moves-one-done-level-2 ()
  (let* ((out (tc-test--archive tc-test--basic))
         (res (plist-get out :result))
         (open (tc-test--section res "Demo Open Work"))
         (resolved (tc-test--section res "Demo Resolved")))
    (should (= 1 (plist-get out :archived)))
    (should (tc-test--has resolved "A finished task"))
    (should (tc-test--has resolved "finished body"))
    (should-not (tc-test--has open "A finished task"))
    (should (tc-test--has open "First open task"))
    (should (tc-test--has open "Another open task"))
    ;; appended at the end of the Resolved section
    (should (tc-test--before-p resolved "Previously archived" "A finished task"))))

(ert-deftest tc-archive-moves-multiple-done-and-cancelled ()
  (let* ((out (tc-test--archive tc-test--mixed))
         (res (plist-get out :result))
         (open (tc-test--section res "Proj Open Work"))
         (resolved (tc-test--section res "Proj Resolved")))
    (should (= 3 (plist-get out :archived)))
    ;; stays in Open Work
    (should (tc-test--has open "Keep me open"))
    (should (tc-test--has open "A structural heading with no state"))
    (should (tc-test--has open "Has a done child"))
    (should (tc-test--has open "this nested done stays"))
    ;; moved to Resolved
    (should (tc-test--has resolved "Done one"))
    (should (tc-test--has resolved "Cancelled two"))
    (should (tc-test--has resolved "Done three"))
    ;; a level-2 DONE moves its (open) children along with it
    (should (tc-test--has resolved "leftover child of done one"))
    (should-not (tc-test--has open "leftover child of done one"))
    ;; gone from Open Work
    (should-not (tc-test--has open "Done one"))
    (should-not (tc-test--has open "Cancelled two"))
    (should-not (tc-test--has open "Done three"))
    ;; order: pre-existing first, then in document order
    (should (tc-test--before-p resolved "Old archived item" "Done one"))
    (should (tc-test--before-p resolved "Done one" "Cancelled two"))
    (should (tc-test--before-p resolved "Cancelled two" "Done three"))))

(ert-deftest tc-archive-structural-heading-does-not-move ()
  (let* ((out (tc-test--archive tc-test--mixed))
         (open (tc-test--section (plist-get out :result) "Proj Open Work")))
    (should (tc-test--has open "A structural heading with no state"))))

(ert-deftest tc-archive-nothing-to-do-is-noop ()
  (let ((out (tc-test--archive tc-test--nothing)))
    (should (= 0 (plist-get out :archived)))
    (should (equal tc-test--nothing (plist-get out :result)))))

(ert-deftest tc-archive-missing-resolved-section-skips ()
  (let ((out (tc-test--archive tc-test--no-resolved)))
    (should (= 0 (plist-get out :archived)))
    (should (equal tc-test--no-resolved (plist-get out :result)))
    (should (string-match-p "Resolved" (or (tc-test--skip-detail (plist-get out :issues)) "")))))

(ert-deftest tc-archive-missing-open-work-section-skips ()
  (let ((out (tc-test--archive tc-test--no-open)))
    (should (= 0 (plist-get out :archived)))
    (should (equal tc-test--no-open (plist-get out :result)))
    (should (string-match-p "Open Work" (or (tc-test--skip-detail (plist-get out :issues)) "")))))

(ert-deftest tc-archive-ambiguous-resolved-section-skips ()
  (let ((out (tc-test--archive tc-test--two-resolved)))
    (should (= 0 (plist-get out :archived)))
    (should (equal tc-test--two-resolved (plist-get out :result)))
    (should (string-match-p "Resolved" (or (tc-test--skip-detail (plist-get out :issues)) "")))))

(ert-deftest tc-archive-subtree-at-eof ()
  (let* ((out (tc-test--archive tc-test--eof))
         (res (plist-get out :result))
         (open (tc-test--section res "W Open Work"))
         (resolved (tc-test--section res "W Resolved")))
    (should (= 1 (plist-get out :archived)))
    (should (tc-test--has resolved "last thing"))
    (should (tc-test--has resolved "body of last thing"))
    (should (tc-test--has open "keep open"))
    (should-not (tc-test--has open "last thing"))
    ;; result stays well-formed: a newline separates the moved body from the
    ;; following section heading
    (should (string-match-p "body of last thing\n\\* W Open Work" res))))

(ert-deftest tc-archive-matches-lowercase-headings ()
  (let* ((out (tc-test--archive tc-test--lowercase))
         (res (plist-get out :result))
         (open (tc-test--section res "winvm open work"))
         (resolved (tc-test--section res "winvm resolved")))
    (should (= 1 (plist-get out :archived)))
    (should (tc-test--has resolved "fix display resolution"))
    (should-not (tc-test--has open "fix display resolution"))
    (should (tc-test--has open "test rebuilt vm"))))

(ert-deftest tc-archive-is-idempotent ()
  (dolist (fixture (list tc-test--basic tc-test--mixed tc-test--eof
                         tc-test--lowercase tc-test--nothing))
    (let ((once (plist-get (tc-test--archive fixture 1) :result))
          (twice (plist-get (tc-test--archive fixture 2) :result)))
      (should (equal once twice)))))

(ert-deftest tc-archive-check-mode-previews-without-writing ()
  (let ((out (tc-test--archive tc-test--basic 1 t)))
    (should (= 1 (plist-get out :archived)))
    (should (equal tc-test--basic (plist-get out :result)))
    (should (member "A finished task" (tc-test--moved-headings (plist-get out :issues))))))

(ert-deftest tc-archive-check-mode-is-idempotent ()
  (let ((once (tc-test--archive tc-test--mixed 1 t))
        (twice (tc-test--archive tc-test--mixed 2 t)))
    (should (equal tc-test--mixed (plist-get once :result)))
    (should (equal tc-test--mixed (plist-get twice :result)))
    (should (= 3 (plist-get once :archived)))
    (should (= 3 (plist-get twice :archived)))))

;;; ---------------------------------------------------------------------------
;;; Report suppression: a real-mode no-op stays silent so a double-run wrap
;;; (wrap-it-up then open-tasks.org Phase A) doesn't print an alarming
;;; "0 subtree(s) moved" next to the first run's diff.

(ert-deftest tc-archive-real-mode-zero-moves-is-silent ()
  (let ((out (tc-test--archive-report tc-test--nothing)))
    (should (= 0 (plist-get out :archived)))
    (should (equal "" (plist-get out :report)))))

(ert-deftest tc-archive-double-run-second-pass-is-silent ()
  ;; First run archives, second run finds nothing — the second prints nothing.
  (let ((out (tc-test--archive-report tc-test--basic 2)))
    (should (= 0 (plist-get out :archived)))
    (should (equal "" (plist-get out :report)))))

(ert-deftest tc-archive-check-mode-zero-moves-still-reports ()
  ;; A preview the caller explicitly asked for still says "0 would move".
  (let ((out (tc-test--archive-report tc-test--nothing nil t)))
    (should (= 0 (plist-get out :archived)))
    (should (tc-test--has (plist-get out :report) "0 subtree(s) would move"))))

(ert-deftest tc-archive-real-mode-moves-are-reported ()
  (let ((out (tc-test--archive-report tc-test--basic)))
    (should (= 1 (plist-get out :archived)))
    (should (tc-test--has (plist-get out :report) "1 subtree(s) moved"))))

(ert-deftest tc-archive-real-mode-skip-is-reported ()
  ;; 0 moved but a section is missing — the skip is a real condition and must
  ;; not be swallowed by the silence rule.
  (let ((out (tc-test--archive-report tc-test--no-resolved)))
    (should (= 0 (plist-get out :archived)))
    (should (tc-test--has (plist-get out :report) "skipped"))))

;;; ---------------------------------------------------------------------------
;;; --archive-done file-aging: keep last week in-file, move older to task-archive

(defun tc-test--age (content &optional opts)
  "Run `--archive-done' with the file-aging step enabled.
OPTS is a plist: :retain (days; default 7, may be nil to disable), :ref
\(YEAR MONTH DAY reference date), :runs (default 1), :check. Writes CONTENT to a
temp todo file and points `tc-archive-file' at a not-yet-existing temp archive.
Returns a plist: :result (todo contents), :archive (archive-file contents or
nil), :archived (in-file move count), :to-file (aged count), :issues — all from
the last run."
  (let* ((retain (if (plist-member opts :retain) (plist-get opts :retain) 7))
         (ref (plist-get opts :ref))
         (runs (or (plist-get opts :runs) 1))
         (check (plist-get opts :check))
         (todo (make-temp-file "tc-age-todo-" nil ".org"))
         (adir (make-temp-file "tc-age-arch-" t))
         (afile (expand-file-name "task-archive.org" adir))
         last)
    (unwind-protect
        (progn
          (with-temp-file todo (insert content))
          (dotimes (_ runs)
            (tc-test--reset check)
            (setq tc-archive-retain-days retain
                  tc-archive-reference-date ref
                  tc-archive-file afile)
            (tc-process-file todo)
            (setq last (list :archived tc-archived :to-file tc-archived-to-file
                             :issues tc-issues))
            (tc-test--drop-buffer todo))
          (append
           last
           (list :result (with-temp-buffer (insert-file-contents todo) (buffer-string))
                 :archive (and (file-readable-p afile)
                               (with-temp-buffer (insert-file-contents afile)
                                                 (buffer-string))))))
      (tc-test--drop-buffer todo)
      (delete-file todo)
      (delete-directory adir t))))

;; Reference "today" for these fixtures is 2026-06-29; with retain 7 the cutoff
;; is 2026-06-22, so a task closed on or after 2026-06-22 stays in-file.
(defconst tc-test--age-resolved "\
* Age Open Work
** TODO [#A] still open
* Age Resolved
** DONE [#B] recent within window
CLOSED: [2026-06-25 Thu]
recent body
** DONE [#C] old beyond window
CLOSED: [2026-05-01 Fri]
old body line
** CANCELLED [#C] old cancelled too
CLOSED: [2026-04-15 Wed]
** DONE [#B] exactly at cutoff stays
CLOSED: [2026-06-22 Sun]
** DONE [#C] undated no-date archived
no closed date in this body
")

(defconst tc-test--age-straggler "\
* Age Open Work
** TODO [#A] still open
** DONE [#C] old straggler
CLOSED: [2026-03-01 Sun]
straggler body
* Age Resolved
** DONE [#B] recent stays
CLOSED: [2026-06-26 Fri]
")

(ert-deftest tc-age-moves-old-and-undated-resolved ()
  "Normal: closed-beyond-window AND undated subtrees leave the file; only those
closed within the window (cutoff inclusive) stay."
  (let* ((out (tc-test--age tc-test--age-resolved '(:ref (2026 6 29))))
         (resolved (tc-test--section (plist-get out :result) "Age Resolved"))
         (arch (plist-get out :archive)))
    (should (= 3 (plist-get out :to-file)))
    (should-not (tc-test--has resolved "old beyond window"))
    (should-not (tc-test--has resolved "old cancelled too"))
    (should-not (tc-test--has resolved "undated no-date archived"))
    (should (tc-test--has resolved "recent within window"))
    (should (tc-test--has resolved "exactly at cutoff stays"))
    (should arch)
    (should (tc-test--has arch "Resolved (archived)"))
    (should (tc-test--has arch "old beyond window"))
    (should (tc-test--has arch "old body line"))
    (should (tc-test--has arch "old cancelled too"))
    (should (tc-test--has arch "undated no-date archived"))
    (should-not (tc-test--has arch "recent within window"))))

(ert-deftest tc-age-disabled-when-retain-nil ()
  "Boundary: nil retain disables the aging step entirely (legacy behavior)."
  (let ((out (tc-test--age tc-test--age-resolved '(:retain nil :ref (2026 6 29)))))
    (should (= 0 (plist-get out :to-file)))
    (should (equal tc-test--age-resolved (plist-get out :result)))
    (should-not (plist-get out :archive))))

(ert-deftest tc-age-is-idempotent ()
  "Boundary: a second run finds nothing new to age; the todo file is stable."
  (let ((once (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :runs 1)))
        (twice (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :runs 2))))
    (should (equal (plist-get once :result) (plist-get twice :result)))
    (should (= 0 (plist-get twice :to-file)))))

(ert-deftest tc-age-check-mode-previews-without-writing ()
  "Boundary: --check reports the aged count but writes neither file."
  (let ((out (tc-test--age tc-test--age-resolved '(:ref (2026 6 29) :check t))))
    (should (= 3 (plist-get out :to-file)))
    (should (equal tc-test--age-resolved (plist-get out :result)))
    (should-not (plist-get out :archive))))

(ert-deftest tc-age-straggler-moves-through-to-archive ()
  "Normal: an old-dated DONE in Open Work moves to Resolved then ages out in one run."
  (let* ((out (tc-test--age tc-test--age-straggler '(:ref (2026 6 29))))
         (open (tc-test--section (plist-get out :result) "Age Open Work"))
         (resolved (tc-test--section (plist-get out :result) "Age Resolved"))
         (arch (plist-get out :archive)))
    (should-not (tc-test--has open "old straggler"))
    (should-not (tc-test--has resolved "old straggler"))
    (should (tc-test--has arch "old straggler"))
    (should (tc-test--has arch "straggler body"))
    (should (tc-test--has resolved "recent stays"))
    (should (= 1 (plist-get out :archived)))
    (should (= 1 (plist-get out :to-file)))))

(ert-deftest tc-age-append-preserves-existing-archive ()
  "Error/edge: appending to a populated archive keeps prior entries and one scaffold."
  (let* ((adir (make-temp-file "tc-arch-" t))
         (afile (expand-file-name "task-archive.org" adir)))
    (unwind-protect
        (progn
          (tc--append-subtrees-to-archive-file afile (list "** DONE one\n"))
          (tc--append-subtrees-to-archive-file afile (list "** DONE two\n"))
          (let ((content (with-temp-buffer (insert-file-contents afile)
                                           (buffer-string)))
                (n 0) (start 0))
            (should (tc-test--has content "** DONE one"))
            (should (tc-test--has content "** DONE two"))
            (should (tc-test--before-p content "** DONE one" "** DONE two"))
            (while (string-match "\\* Resolved (archived)" content start)
              (setq n (1+ n) start (match-end 0)))
            (should (= 1 n))))
      (delete-directory adir t))))

;;; ---------------------------------------------------------------------------
;;; --archive-done aging: the archive follows the todo file's gitignore status

(defun tc-test--age-in-git-repo (gitignore-todo)
  "Init a temp git repo, write todo.org with an old Resolved entry, optionally
gitignore todo.org, then run `--archive-done' aging with the DEFAULT archive path
(archive/task-archive.org beside the todo file). Return a plist: :gitignore (final
.gitignore contents or nil), :archive-ignored (whether git ignores the archive),
:archive-exists."
  (let* ((root (make-temp-file "tc-git-" t))
         (todo (expand-file-name "todo.org" root))
         (archive (expand-file-name "archive/task-archive.org" root))
         (gi (expand-file-name ".gitignore" root)))
    (unwind-protect
        (let ((default-directory root))
          (call-process "git" nil nil nil "init" "-q")
          (with-temp-file todo (insert tc-test--age-resolved))
          (when gitignore-todo (with-temp-file gi (insert "/todo.org\n")))
          (tc-test--reset nil)
          (setq tc-archive-retain-days 7
                tc-archive-reference-date '(2026 6 29)
                tc-archive-file nil)          ; default path, beside the todo file
          (tc-process-file todo)
          (tc-test--drop-buffer todo)
          (list :gitignore (and (file-readable-p gi)
                                (with-temp-buffer (insert-file-contents gi)
                                                  (buffer-string)))
                :archive-ignored
                (eq 0 (call-process "git" nil nil nil "check-ignore" "-q" archive))
                :archive-exists (file-readable-p archive)))
      (delete-directory root t))))

(ert-deftest tc-age-self-protect-gitignores-archive-when-todo-ignored ()
  "When the todo file is gitignored, the aged-out archive is added to .gitignore
so it inherits the same privacy."
  (let ((out (tc-test--age-in-git-repo t)))
    (should (plist-get out :archive-exists))
    (should (string-match-p "task-archive" (or (plist-get out :gitignore) "")))
    (should (plist-get out :archive-ignored))))

(ert-deftest tc-age-self-protect-leaves-tracked-todo-archive-tracked ()
  "When the todo file is tracked, the archive is not gitignored — no .gitignore
entry is added for it."
  (let ((out (tc-test--age-in-git-repo nil)))
    (should (plist-get out :archive-exists))
    (should-not (plist-get out :archive-ignored))
    (should-not (string-match-p "task-archive" (or (plist-get out :gitignore) "")))))

;;; ---------------------------------------------------------------------------
;;; Realistic synthetic sample (committed under fixtures/)

(defun tc-test--sample-file ()
  (expand-file-name "fixtures/todo-sample.org" tc-test--dir))

(ert-deftest tc-archive-realistic-sample ()
  (let* ((src (tc-test--sample-file)))
    (skip-unless (file-readable-p src))
    (let* ((content (with-temp-buffer (insert-file-contents src) (buffer-string)))
           (out (tc-test--archive content))
           (res (plist-get out :result))
           (out2 (tc-test--archive content 2)))
      ;; every DONE/CANCELLED level-2 entry under "Open Work" moved out
      (let ((open (tc-test--section res "Sample Open Work")))
        (should-not (string-match-p "^\\*\\* \\(DONE\\|CANCELLED\\) " open)))
      ;; structural and still-open level-2 entries stayed
      (let ((open (tc-test--section res "Sample Open Work")))
        (should (string-match-p "^\\*\\* TODO " open))
        (should (string-match-p "^\\*\\* DOING " open)))
      ;; idempotent
      (should (equal res (plist-get out2 :result)))
      ;; something actually moved
      (should (> (plist-get out :archived) 0)))))

;;; ---------------------------------------------------------------------------
;;; Sync-child-priority harness + fixtures

(defun tc-test--sync (content &optional runs check)
  "Write CONTENT to a temp .org file, run `--sync-child-priority' RUNS times
\(default 1\). Return a plist: :result final file contents, :bumped count from
the last run, :issues from the last run. CHECK non-nil ⇒ --check (preview)."
  (let ((file (make-temp-file "tc-test-sync-" nil ".org"))
        last-bumped last-issues)
    (unwind-protect
        (progn
          (with-temp-file file (insert content))
          (dotimes (_ (or runs 1))
            (tc-test--reset-sync check)
            (tc-process-file file)
            (setq last-bumped tc-bumped last-issues tc-issues)
            (tc-test--drop-buffer file))
          (list :result (with-temp-buffer (insert-file-contents file)
                                          (buffer-string))
                :bumped last-bumped
                :issues last-issues))
      (tc-test--drop-buffer file)
      (delete-file file))))

(defun tc-test--priority-of (content heading-substring)
  "Return the priority letter (a string like \"A\") on the first heading line
in CONTENT that contains HEADING-SUBSTRING, or nil if the heading has no
priority cookie."
  (with-temp-buffer
    (insert content)
    (goto-char (point-min))
    (let (found-line found-prio)
      (while (and (not found-line) (re-search-forward "^\\*+ .*$" nil t))
        (let ((line (match-string 0)))
          (when (string-match-p (regexp-quote heading-substring) line)
            (setq found-line line)
            (when (string-match "\\[#\\([A-Z]\\)\\]" line)
              (setq found-prio (match-string 1 line))))))
      (unless found-line
        (error "no heading containing %S" heading-substring))
      found-prio)))

(defun tc-test--sync-bumped-headings (issues)
  "Return the heading texts of every `:kind' sync-bumped or sync-would entry
in ISSUES, in document order."
  (mapcar (lambda (i) (plist-get i :child-heading))
          (cl-remove-if-not
           (lambda (i) (memq (plist-get i :kind) '(sync-bumped sync-would)))
           (reverse issues))))

(defconst tc-test--sync-basic "\
* Open Work
** TODO [#B] Parent
*** TODO [#D] Drifted child
*** TODO [#B] Already in sync
")

(defconst tc-test--sync-multi "\
* Open Work
** TODO [#B] Parent
*** TODO [#A] Higher-priority child stays
*** TODO [#B] Equal-priority child stays
*** TODO [#C] Lower-priority child bumps
*** TODO [#D] Way-lower-priority child bumps
*** TODO Priority-less child stays
")

(defconst tc-test--sync-no-sync-tag "\
* Open Work
** TODO [#B] Parent
*** TODO [#D] Regular drifted child
*** TODO [#D] Follow-up: opted-out :no-sync:
")

(defconst tc-test--sync-priority-less-parent "\
* Open Work
** TODO Parent with no priority
*** TODO [#D] Child with priority should not move
")

(defconst tc-test--sync-cascade "\
* Open Work
** TODO [#A] Top
*** TODO [#B] Middle
**** TODO [#D] Leaf
")

(defconst tc-test--sync-no-change "\
* Open Work
** TODO [#B] Parent
*** TODO [#A] Child higher
*** TODO [#B] Child equal
")

;; A dated-log heading inside a parent task whose title quotes other priorities
;; in =[#X]= verbatim. Those quoted cookies must NOT be read as the heading's
;; own priority — the cookie has to sit in canonical position to count.
(defconst tc-test--sync-cookie-in-title "\
* Open Work
** TODO [#B] Parent
*** 2026-05-14 Reprioritized children =[#D]= → =[#B]= to match parent
*** TODO [#D] Regular drifted child
")

;;; ---------------------------------------------------------------------------
;;; Sync-child-priority tests

(ert-deftest tc-sync-bumps-lower-priority-child ()
  (let* ((out (tc-test--sync tc-test--sync-basic))
         (res (plist-get out :result)))
    (should (= 1 (plist-get out :bumped)))
    (should (equal "B" (tc-test--priority-of res "Drifted child")))
    (should (equal "B" (tc-test--priority-of res "Already in sync")))
    (should (equal "B" (tc-test--priority-of res "Parent")))))

(ert-deftest tc-sync-leaves-higher-and-equal-children-alone ()
  (let* ((out (tc-test--sync tc-test--sync-multi))
         (res (plist-get out :result)))
    (should (= 2 (plist-get out :bumped)))
    (should (equal "A" (tc-test--priority-of res "Higher-priority child")))
    (should (equal "B" (tc-test--priority-of res "Equal-priority child")))
    (should (equal "B" (tc-test--priority-of res "Lower-priority child")))
    (should (equal "B" (tc-test--priority-of res "Way-lower-priority child")))
    (should-not (tc-test--priority-of res "Priority-less child"))))

(ert-deftest tc-sync-skips-no-sync-tagged-child ()
  (let* ((out (tc-test--sync tc-test--sync-no-sync-tag))
         (res (plist-get out :result)))
    (should (= 1 (plist-get out :bumped)))
    (should (equal "B" (tc-test--priority-of res "Regular drifted child")))
    (should (equal "D" (tc-test--priority-of res "Follow-up: opted-out")))))

(ert-deftest tc-sync-leaves-priority-less-parent-alone ()
  (let ((out (tc-test--sync tc-test--sync-priority-less-parent)))
    (should (= 0 (plist-get out :bumped)))
    (should (equal tc-test--sync-priority-less-parent (plist-get out :result)))))

(ert-deftest tc-sync-cascades-through-multiple-levels ()
  (let* ((out (tc-test--sync tc-test--sync-cascade))
         (res (plist-get out :result)))
    ;; one pass should collapse [#A] → [#B] → [#D] to all [#A] because
    ;; org-map-entries visits the parent first, bumps the middle, then visits
    ;; the (now bumped) middle and bumps its leaf
    (should (= 2 (plist-get out :bumped)))
    (should (equal "A" (tc-test--priority-of res "Top")))
    (should (equal "A" (tc-test--priority-of res "Middle")))
    (should (equal "A" (tc-test--priority-of res "Leaf")))))

(ert-deftest tc-sync-no-change-when-all-children-at-or-above-parent ()
  (let ((out (tc-test--sync tc-test--sync-no-change)))
    (should (= 0 (plist-get out :bumped)))
    (should (equal tc-test--sync-no-change (plist-get out :result)))))

(ert-deftest tc-sync-ignores-cookie-shaped-text-in-title ()
  (let* ((out (tc-test--sync tc-test--sync-cookie-in-title))
         (res (plist-get out :result)))
    ;; Only the real drifted child bumps; the dated-log heading with
    ;; =[#D]= / =[#B]= verbatim text in its title is untouched.
    (should (= 1 (plist-get out :bumped)))
    (should (equal "B" (tc-test--priority-of res "Regular drifted child")))
    ;; Substring still appears in the dated-log heading; the heading itself
    ;; was not rewritten.
    (should (string-match-p "Reprioritized children =\\[#D\\]= → =\\[#B\\]= to match parent" res))))

(ert-deftest tc-sync-is-idempotent ()
  (dolist (fixture (list tc-test--sync-basic
                         tc-test--sync-multi
                         tc-test--sync-no-sync-tag
                         tc-test--sync-priority-less-parent
                         tc-test--sync-cascade
                         tc-test--sync-no-change
                         tc-test--sync-cookie-in-title))
    (let ((once (plist-get (tc-test--sync fixture 1) :result))
          (twice (plist-get (tc-test--sync fixture 2) :result)))
      (should (equal once twice)))))

(ert-deftest tc-sync-check-mode-previews-without-writing ()
  (let ((out (tc-test--sync tc-test--sync-basic 1 t)))
    (should (= 1 (plist-get out :bumped)))
    (should (equal tc-test--sync-basic (plist-get out :result)))
    (should (member "Drifted child"
                    (tc-test--sync-bumped-headings (plist-get out :issues))))))

(ert-deftest tc-sync-check-mode-is-idempotent ()
  (let ((once (tc-test--sync tc-test--sync-cascade 1 t))
        (twice (tc-test--sync tc-test--sync-cascade 2 t)))
    (should (equal tc-test--sync-cascade (plist-get once :result)))
    (should (equal tc-test--sync-cascade (plist-get twice :result)))
    (should (= 2 (plist-get once :bumped)))
    (should (= 2 (plist-get twice :bumped)))))

;;; ---------------------------------------------------------------------------
;;; --convert-subtasks harness + tests

(defun tc-test--reset-convert (&optional check)
  (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-converted 0 tc-archived-to-file 0
        tc-issues nil
        tc-check-only (and check t)
        tc-archive-done nil tc-sync-child-priority nil tc-convert-subtasks t
        tc-current-file nil
        tc-archive-retain-days nil tc-archive-reference-date nil tc-archive-file nil))

(defun tc-test--convert (content &optional runs check)
  "Write CONTENT to a temp .org file, run `--convert-subtasks' RUNS times (default 1).
Return a plist: :result final file contents, :converted count from the last run,
:issues from the last run.  CHECK non-nil ⇒ --check (preview, no writes)."
  (let ((file (make-temp-file "tc-test-" nil ".org"))
        last-converted last-issues)
    (unwind-protect
        (progn
          (with-temp-file file (insert content))
          (dotimes (_ (or runs 1))
            (tc-test--reset-convert check)
            (tc-process-file file)
            (setq last-converted tc-converted last-issues tc-issues)
            (tc-test--drop-buffer file))
          (list :result (with-temp-buffer (insert-file-contents file)
                                          (buffer-string))
                :converted last-converted
                :issues last-issues))
      (tc-test--drop-buffer file)
      (delete-file file))))

;; The UTC offset in a converted header is the test machine's local offset for
;; that date, so assertions match it as `[-+]NNNN' rather than a fixed value —
;; the mode's job is to emit a well-formed offset, not to run in one timezone.

(defconst tc-test--convert-timed
  "* Project Open Work
** TODO [#B] Parent task
*** DONE [#C] F12 opens the terminal :feature:quick:
CLOSED: [2026-06-27 Sat 12:50]
Verified live: docks, toggles, colors clean.
")

(ert-deftest tc-convert-timed-subtask-normal ()
  "Normal: a timed CLOSED close becomes a dated header, keyword/priority/tags/CLOSED gone."
  (let* ((out (tc-test--convert tc-test--convert-timed))
         (res (plist-get out :result)))
    (should (= 1 (plist-get out :converted)))
    (should (string-match-p
             "^\\*\\*\\* 2026-06-27 Sat @ 12:50:00 [-+][0-9]\\{4\\} F12 opens the terminal$"
             res))
    (should-not (string-match-p "CLOSED:" res))
    (should-not (string-match-p "DONE" res))
    (should (string-match-p "Verified live: docks, toggles, colors clean\\." res))
    (should (string-match-p "^\\*\\* TODO \\[#B\\] Parent task$" res))))

(defconst tc-test--convert-dateonly
  "* Project Open Work
** PROJECT [#B] Parent
**** DONE [#B] Write full spec :refactor:
CLOSED: [2026-05-04 Mon]
Body.
")

(ert-deftest tc-convert-dateonly-boundary-midnight ()
  "Boundary: a date-only CLOSED (no time) yields 00:00:00, at level 4."
  (let ((res (plist-get (tc-test--convert tc-test--convert-dateonly) :result)))
    (should (string-match-p
             "^\\*\\*\\*\\* 2026-05-04 Mon @ 00:00:00 [-+][0-9]\\{4\\} Write full spec$"
             res))
    (should-not (string-match-p "CLOSED:" res))))

(defconst tc-test--convert-level2
  "* Project Open Work
** DONE [#B] Top-level task
CLOSED: [2026-06-01 Mon 09:00]
Body.
")

(ert-deftest tc-convert-leaves-level-2-alone-boundary ()
  "Boundary: a level-2 DONE task is a top-level task, not a sub-task — untouched."
  (let ((out (tc-test--convert tc-test--convert-level2)))
    (should (= 0 (plist-get out :converted)))
    (should (equal tc-test--convert-level2 (plist-get out :result)))))

(ert-deftest tc-convert-idempotent-boundary ()
  "Boundary: a second run over an already-dated entry converts nothing new."
  (let ((once (tc-test--convert tc-test--convert-timed 1))
        (twice (tc-test--convert tc-test--convert-timed 2)))
    (should (equal (plist-get once :result) (plist-get twice :result)))
    (should (= 0 (plist-get twice :converted)))))

(defconst tc-test--convert-nested
  "* Project Open Work
** TODO [#B] Parent
*** DONE Outer sub :feature:
CLOSED: [2026-06-10 Wed 08:15]
**** DONE Inner sub
CLOSED: [2026-06-09 Tue 07:00]
Inner body.
")

(ert-deftest tc-convert-nested-done-subtasks-boundary ()
  "Boundary: a done sub-task nested under a done sub-task — both convert."
  (let* ((out (tc-test--convert tc-test--convert-nested))
         (res (plist-get out :result)))
    (should (= 2 (plist-get out :converted)))
    (should (string-match-p
             "^\\*\\*\\* 2026-06-10 Wed @ 08:15:00 [-+][0-9]\\{4\\} Outer sub$" res))
    (should (string-match-p
             "^\\*\\*\\*\\* 2026-06-09 Tue @ 07:00:00 [-+][0-9]\\{4\\} Inner sub$" res))
    (should-not (string-match-p "CLOSED:" res))))

(defconst tc-test--convert-cancelled
  "* Project Open Work
** TODO [#B] Parent
*** CANCELLED [#C] Abandoned idea :feature:
CLOSED: [2026-06-15 Mon 10:00]
")

(ert-deftest tc-convert-cancelled-subtask-boundary ()
  "Boundary: a CANCELLED sub-task converts too (terminal state)."
  (let ((res (plist-get (tc-test--convert tc-test--convert-cancelled) :result)))
    (should (string-match-p
             "^\\*\\*\\* 2026-06-15 Mon @ 10:00:00 [-+][0-9]\\{4\\} Abandoned idea$" res))
    (should-not (string-match-p "CANCELLED" res))))

(defconst tc-test--convert-noclosed
  "* Project Open Work
** TODO [#B] Parent
*** DONE Orphan with no closed date
Body only.
")

(ert-deftest tc-convert-skips-subtask-without-closed-error ()
  "Error: a done sub-task with no parseable CLOSED is flagged and left unchanged."
  (let ((out (tc-test--convert tc-test--convert-noclosed)))
    (should (= 0 (plist-get out :converted)))
    (should (equal tc-test--convert-noclosed (plist-get out :result)))
    (should (cl-some (lambda (i) (eq (plist-get i :kind) 'convert-skip))
                     (plist-get out :issues)))))

(ert-deftest tc-convert-check-mode-previews-without-writing ()
  "Check mode reports the conversion but writes nothing."
  (let ((out (tc-test--convert tc-test--convert-timed 1 t)))
    (should (= 1 (plist-get out :converted)))
    (should (equal tc-test--convert-timed (plist-get out :result)))
    (should (cl-some (lambda (i) (eq (plist-get i :kind) 'convert-would))
                     (plist-get out :issues)))))

(defconst tc-test--convert-closed-with-deadline
  "* Project Open Work
** TODO [#B] Parent task
*** DONE [#C] Ship the panel :feature:
CLOSED: [2026-06-27 Sat 12:50] DEADLINE: <2026-06-30 Tue>
Body line.
")

(ert-deftest tc-convert-preserves-deadline-on-shared-planning-line-boundary ()
  "Boundary: removing the CLOSED cookie keeps a DEADLINE sharing its planning line."
  (let* ((out (tc-test--convert tc-test--convert-closed-with-deadline))
         (res (plist-get out :result)))
    (should (= 1 (plist-get out :converted)))
    (should (string-match-p
             "^\\*\\*\\* 2026-06-27 Sat @ 12:50:00 [-+][0-9]\\{4\\} Ship the panel$"
             res))
    (should-not (string-match-p "CLOSED:" res))
    (should (string-match-p "^DEADLINE: <2026-06-30 Tue>$" res))
    (should (string-match-p "^Body line\\.$" res))))

(provide 'test-todo-cleanup)
;;; test-todo-cleanup.el ends here