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