feat(todo-cleanup): add --archive-done mode with ERT test suite

--archive-done moves every level-2 subtree whose TODO state is DONE or CANCELLED out of the "Open Work" section into the "Resolved" section of the same org file, subtree intact. Sections match on a unique level-1 heading containing "Open Work" (case-insensitive) and one containing "Resolved"; a missing or ambiguous section skips the file with a message rather than crashing. Only direct level-2 children move. A DONE entry nested under an open parent stays put. Opt-in, never run by default, doesn't also run the hygiene passes; --check previews without writing.

The CLI dispatch moved into tc-main behind a guard so the new ERT suite can require the file without firing it. Hygiene mode is unchanged.

13 ERT cases (the repo's first elisp tests) cover the move and the stay-put cases, EOF with no final newline, missing or ambiguous sections, lowercase headings, idempotency, and --check. tests/fixtures/todo-sample.org is the synthetic sample, and the Makefile test target now runs the ERT suites alongside pytest.

2 files changed, 356 insertions, 0 deletions

diff --git a/.ai/scripts/tests/fixtures/todo-sample.org b/.ai/scripts/tests/fixtures/todo-sample.org
new file mode 100644
index 0000000..8b9e723
--- /dev/null
+++ b/.ai/scripts/tests/fixtures/todo-sample.org
@@ -0,0 +1,37 @@
+#+TITLE: Sample todo.org for todo-cleanup tests
+#+AUTHOR: synthetic fixture
+
+# A deliberately varied (but synthetic) todo.org: umbrella "Open Work" /
+# "Resolved" headings, mixed TODO/DOING/WAITING/DONE/CANCELLED states,
+# priorities, tags, nested level-3 children, and a few structural (no-state)
+# section headings. `--archive-done' should move only the direct level-2
+# DONE/CANCELLED subtrees from "Open Work" into "Resolved", intact, and leave
+# everything else alone.
+
+* Sample Open Work
+** TODO [#A] Write the README
+   This one stays — still open.
+** DOING [#A] Refactor the parser
+   In progress; stays.
+** DONE [#A] Bootstrap the test harness                              :tooling:
+   Finished. Should move to Resolved with this body intact.
+** WAITING [#B] Vendor reply on the licensing question
+   Blocked, not done — stays.
+** A grouping heading with no TODO state
+*** TODO [#B] sub-task one
+*** DONE [#C] sub-task two — done, but nested under an open parent, so stays
+** CANCELLED [#B] Drop the legacy importer                           :chore:
+   Decided against it. Should move to Resolved.
+** TODO [#B] Ship the migration                                      :quick:
+*** DONE [#C] write the up migration
+*** TODO [#C] write the down migration
+** DONE [#B] Tag the 1.0 release
+*** DONE [#C] update the changelog
+*** TODO [#C] announce on the list
+   Parent is DONE, so the whole subtree (open child included) moves.
+** NEXT [#C] Pick the next milestone
+
+* Sample Resolved
+** DONE [#A] Initial project skeleton
+   Pre-existing archived entry; new arrivals append after this one.
+** CANCELLED [#C] Evaluate the other framework
diff --git a/.ai/scripts/tests/test-todo-cleanup.el b/.ai/scripts/tests/test-todo-cleanup.el
new file mode 100644
index 0000000..9d11b5c
--- /dev/null
+++ b/.ai/scripts/tests/test-todo-cleanup.el
@@ -0,0 +1,319 @@
+;;; 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-issues nil
+        tc-check-only (and check t) tc-archive-done t tc-current-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--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)))))
+
+;;; ---------------------------------------------------------------------------
+;;; 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)))))
+
+(provide 'test-todo-cleanup)
+;;; test-todo-cleanup.el ends here