diff options
Diffstat (limited to '.ai/scripts/tests/test-todo-cleanup.el')
| -rw-r--r-- | .ai/scripts/tests/test-todo-cleanup.el | 610 |
1 files changed, 606 insertions, 4 deletions
diff --git a/.ai/scripts/tests/test-todo-cleanup.el b/.ai/scripts/tests/test-todo-cleanup.el index ad9260b..a92d238 100644 --- a/.ai/scripts/tests/test-todo-cleanup.el +++ b/.ai/scripts/tests/test-todo-cleanup.el @@ -30,16 +30,22 @@ ;;; Harness (defun tc-test--reset (&optional check) - (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-issues nil + (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-archived-to-file 0 tc-issues nil + tc-sealed 0 tc-seal nil tc-convert-subtasks nil tc-check-only (and check t) tc-archive-done t tc-sync-child-priority nil - tc-current-file 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-issues nil + (setq tc-fixes 0 tc-archived 0 tc-bumped 0 tc-archived-to-file 0 tc-issues nil + tc-sealed 0 tc-seal nil tc-check-only (and check t) tc-archive-done nil tc-sync-child-priority t - tc-current-file nil)) + 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))) @@ -355,6 +361,207 @@ from the heading line through (not including) the next level-1 heading or EOF." (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)) + ;; Private backup dir: this helper writes a file literally named + ;; todo.org and runs a real (non-check) pass, so without this its + ;; backup lands in the shared temp dir under the exact production + ;; name and is indistinguishable from a real one. + (temporary-file-directory + (file-name-as-directory (make-temp-file "tc-git-bk-" 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) + (delete-directory temporary-file-directory 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 () @@ -380,6 +587,95 @@ from the heading line through (not including) the next level-1 heading or EOF." (should (> (plist-get out :archived) 0))))) ;;; --------------------------------------------------------------------------- +;;; --archive-done retention default + +(ert-deftest tc-archive-retain-default-is-one-month () + "The shipped retention default is one month (31 days), not the legacy 7. +The defvar initializes from this defconst; the live var itself is mutated by +other tests, so the immutable defconst is the stable contract to pin." + (should (= 31 tc-archive-retain-days-default))) + +;;; --------------------------------------------------------------------------- +;;; --seal: rename the working archive to resolved-YYYY-MM-DD.org + +(defun tc-test--seal (&optional opts) + "Run `--seal' against a temp todo file with a temp archive dir. +OPTS is a plist: :archive-content (seed task-archive.org with this; nil = no +working archive), :ref (YEAR MONTH DAY seal date; default (2026 7 18)), +:check, :presealed (also create resolved-<ref>.org first, to test collision). +Returns a plist: :sealed count, :issues, :working-exists, :sealed-exists, +:sealed-name, :report." + (let* ((ref (or (plist-get opts :ref) '(2026 7 18))) + (check (plist-get opts :check)) + (archive-content (plist-get opts :archive-content)) + (todo (make-temp-file "tc-seal-todo-" nil ".org")) + (adir (make-temp-file "tc-seal-arch-" t)) + (afile (expand-file-name "task-archive.org" adir)) + (sealed-name (format "resolved-%04d-%02d-%02d.org" + (nth 0 ref) (nth 1 ref) (nth 2 ref))) + (sealed (expand-file-name sealed-name adir))) + (unwind-protect + (progn + (with-temp-file todo (insert "* Open Work\n** TODO [#A] live\n")) + (when archive-content (with-temp-file afile (insert archive-content))) + (when (plist-get opts :presealed) + (with-temp-file sealed (insert "pre-existing seal\n"))) + (tc-test--reset check) + ;; Set every mode flag explicitly: tc-test--reset leaves + ;; tc-convert-subtasks untouched, so a convert test running earlier in + ;; the suite would otherwise still own the dispatch and run convert. + (setq tc-archive-done nil tc-sync-child-priority nil + tc-convert-subtasks nil tc-seal t tc-sealed 0 + tc-archive-reference-date ref + tc-archive-file afile) + (let ((report (with-output-to-string (tc-process-file todo) (tc-emit-report)))) + (tc-test--drop-buffer todo) + (list :sealed tc-sealed + :issues tc-issues + :working-exists (file-readable-p afile) + :sealed-exists (file-readable-p sealed) + :sealed-name sealed-name + :report report))) + (tc-test--drop-buffer todo) + (delete-file todo) + (delete-directory adir t)))) + +(ert-deftest tc-seal-renames-working-archive-to-dated-file () + "Normal: --seal renames task-archive.org to resolved-<seal-date>.org." + (let ((out (tc-test--seal '(:archive-content "* Resolved (archived)\n** DONE old\n" + :ref (2026 7 18))))) + (should (= 1 (plist-get out :sealed))) + (should-not (plist-get out :working-exists)) + (should (plist-get out :sealed-exists)) + (should (equal "resolved-2026-07-18.org" (plist-get out :sealed-name))) + (should (tc-test--has (plist-get out :report) "sealed task-archive.org → resolved-2026-07-18.org")))) + +(ert-deftest tc-seal-nothing-to-seal-is-a-reported-noop () + "Boundary: no working archive present — reported no-op, nothing created." + (let ((out (tc-test--seal '(:ref (2026 7 18))))) + (should (= 0 (plist-get out :sealed))) + (should-not (plist-get out :sealed-exists)) + (should (tc-test--has (plist-get out :report) "no working archive to seal")))) + +(ert-deftest tc-seal-check-mode-previews-without-renaming () + "Boundary: --check reports the seal but leaves the working archive in place." + (let ((out (tc-test--seal '(:archive-content "* Resolved (archived)\n" + :ref (2026 7 18) :check t)))) + (should (= 1 (plist-get out :sealed))) + (should (plist-get out :working-exists)) + (should-not (plist-get out :sealed-exists)) + (should (tc-test--has (plist-get out :report) "would seal")))) + +(ert-deftest tc-seal-refuses-to-clobber-existing-sealed-file () + "Error: resolved-<today>.org already exists — refuse, leave both files intact." + (let ((out (tc-test--seal '(:archive-content "* Resolved (archived)\n" + :ref (2026 7 18) :presealed t)))) + (should (= 0 (plist-get out :sealed))) + (should (plist-get out :working-exists)) + (should (plist-get out :sealed-exists)) + (should (tc-test--has (plist-get out :report) "already exists")))) + +;;; --------------------------------------------------------------------------- ;;; Sync-child-priority harness + fixtures (defun tc-test--sync (content &optional runs check) @@ -570,5 +866,311 @@ in ISSUES, in document order." (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-sealed 0 tc-seal 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-strips-deadline-sharing-the-planning-line-boundary () + "Boundary: a DEADLINE sharing the CLOSED planning line goes too — a dated-log +entry carries no active planning timestamp (todo-format.md). Body survives." + (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-not (string-match-p "DEADLINE:" res)) + (should (string-match-p "^Body line\\.$" res)))) + +(defconst tc-test--convert-closed-and-scheduled-separate-lines + "* Project Open Work +** TODO [#B] Parent task +*** DONE [#C] Book the venue :feature: +CLOSED: [2026-06-27 Sat 12:50] +SCHEDULED: <2026-06-20 Sat> +Body line. +") + +(ert-deftest tc-convert-strips-scheduled-on-its-own-line () + "Normal (the home bug): a SCHEDULED planning line on its own — the completion +rewrite dropped keyword/priority/tags but left the SCHEDULED, pinning the dated +entry to the agenda as weeks-overdue. Both planning lines go; body survives." + (let* ((out (tc-test--convert tc-test--convert-closed-and-scheduled-separate-lines)) + (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\\} Book the venue$" + res)) + (should-not (string-match-p "CLOSED:" res)) + (should-not (string-match-p "SCHEDULED:" res)) + (should (string-match-p "^Body line\\.$" res)))) + +(defconst tc-test--convert-scheduled-in-body-prose + "* Project Open Work +** TODO [#B] Parent task +*** DONE [#C] Note the mechanism :feature: +CLOSED: [2026-06-27 Sat 12:50] +An active SCHEDULED: <2026-06-20 Sat> in prose must survive. +") + +(ert-deftest tc-convert-leaves-planning-shaped-body-prose-alone () + "Boundary: a planning-shaped token inside body prose (not a canonical planning +line) is left untouched — the strip stops at the first non-planning line." + (let* ((out (tc-test--convert tc-test--convert-scheduled-in-body-prose)) + (res (plist-get out :result))) + (should (= 1 (plist-get out :converted))) + (should-not (string-match-p "CLOSED:" res)) + (should (string-match-p "An active SCHEDULED: <2026-06-20 Sat> in prose must survive\\." res)))) + (provide 'test-todo-cleanup) ;;; test-todo-cleanup.el ends here + +;;; --------------------------------------------------------------------------- +;;; Backup before mutating (parity with lint-org.el / wrap-org-table.el) +;; +;; todo-cleanup rewrites todo.org in place and left no copy behind, while both +;; sibling org-mutators back up to /tmp first. It is also the one that runs most +;; often (every wrap, every sentry fire). Emacs's own backup does not fire under +;; --batch -q, so there was genuinely no undo short of git. + +(ert-deftest tc-backup-written-before-a-real-mutation () + "A real (non-check) run leaves a copy holding the pre-edit content. + +`temporary-file-directory' is rebound to a private dir for the duration: the +backup name derives from the *file's* basename, and the real todo.org shares +that basename, so a live sentry run writing /tmp/todo.org.before-todo-cleanup.* +would otherwise be indistinguishable from this test's own artifact. The first +version of this test globbed the shared /tmp and passed only until a real run +created one (2026-07-24)." + (let* ((dir (make-temp-file "tc-backup-" t)) + (bdir (file-name-as-directory (make-temp-file "tc-bk-" t))) + (file (expand-file-name "todo.org" dir)) + (before "* P Open Work\n** TODO [#B] parent\n*** DONE a subtask\nCLOSED: [2026-07-01 Tue]\n")) + (unwind-protect + (progn + (with-temp-file file (insert before)) + (let ((tc-check-only nil) + (tc-convert-subtasks t) + (temporary-file-directory bdir)) + (tc-process-file file)) + (let ((backups (file-expand-wildcards + (concat bdir "todo.org.before-todo-cleanup.*")))) + (should backups) + (should (string-match-p + "a subtask" + (with-temp-buffer (insert-file-contents (car backups)) + (buffer-string)))))) + (delete-directory dir t) + (delete-directory bdir t)))) + +(ert-deftest tc-no-backup-in-check-mode () + "--check writes nothing, so it must not leave a backup either. +Uses a private `temporary-file-directory' for the same isolation reason." + (let* ((dir (make-temp-file "tc-backup-" t)) + (bdir (file-name-as-directory (make-temp-file "tc-bk-" t))) + (file (expand-file-name "todo.org" dir))) + (unwind-protect + (progn + (with-temp-file file + (insert "* P Open Work\n** TODO [#B] parent\n*** DONE sub\nCLOSED: [2026-07-01 Tue]\n")) + (let ((tc-check-only t) + (tc-convert-subtasks t) + (temporary-file-directory bdir)) + (tc-process-file file)) + (should-not (file-expand-wildcards + (concat bdir "todo.org.before-todo-cleanup.*")))) + (delete-directory dir t) + (delete-directory bdir t)))) + +(ert-deftest tc-backup-never-overwrites-an-earlier-one () + "Two invocations in the same second must not collapse to one backup. + +open-tasks.org runs --convert-subtasks then --archive-done back to back, each +a sub-second batch run. With a second-resolution stamp and copy-file's +OK-IF-ALREADY-EXISTS, the second invocation overwrote the first's backup with +already-mutated content, so the true pre-session original was unrecoverable — +the exact state the backup exists to preserve (found 2026-07-24 in review)." + (let* ((dir (make-temp-file "tc-collide-" t)) + (bdir (file-name-as-directory (make-temp-file "tc-cbk-" t))) + (file (expand-file-name "todo.org" dir)) + (original (concat "* P Open Work\n** TODO [#B] parent\n*** DONE sub\n" + "CLOSED: [2026-07-01 Tue]\n" + "* P Resolved\n** DONE [#C] old\nCLOSED: [2025-01-01 Wed]\n"))) + (unwind-protect + (progn + (with-temp-file file (insert original)) + ;; Two back-to-back invocations, as the shipped workflow does. + (let ((temporary-file-directory bdir)) + (let ((tc-check-only nil) (tc-convert-subtasks t)) + (tc-process-file file)) + (let ((tc-check-only nil) (tc-convert-subtasks nil) (tc-archive-done t) + (tc-archive-retain-days nil)) + (tc-process-file file))) + (let ((backups (file-expand-wildcards + (concat bdir "todo.org.before-todo-cleanup.*")))) + ;; Both invocations kept their own backup. + (should (= (length backups) 2)) + ;; And one of them still holds the true original. + (should (cl-some (lambda (b) + (string= original + (with-temp-buffer (insert-file-contents b) + (buffer-string)))) + backups)))) + (delete-directory dir t) + (delete-directory bdir t)))) |