diff options
| -rw-r--r-- | .ai/scripts/tests/test-todo-cleanup.el | 24 | ||||
| -rw-r--r-- | .ai/scripts/todo-cleanup.el | 12 |
2 files changed, 31 insertions, 5 deletions
diff --git a/.ai/scripts/tests/test-todo-cleanup.el b/.ai/scripts/tests/test-todo-cleanup.el index 2a9184d..5d43f97 100644 --- a/.ai/scripts/tests/test-todo-cleanup.el +++ b/.ai/scripts/tests/test-todo-cleanup.el @@ -417,6 +417,16 @@ in ISSUES, in document order." *** 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 @@ -466,13 +476,25 @@ in ISSUES, in document order." (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-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))))) diff --git a/.ai/scripts/todo-cleanup.el b/.ai/scripts/todo-cleanup.el index 97be96e..11851b2 100644 --- a/.ai/scripts/todo-cleanup.el +++ b/.ai/scripts/todo-cleanup.el @@ -254,12 +254,16 @@ are reported but not performed." (defun tc--heading-priority-letter () "Return the priority letter (a character) on the heading at point, or nil -if the heading has no priority cookie." +if the heading has no priority cookie in canonical position. + +Uses `org-heading-components' rather than regexing the whole line, because +the cookie must sit right after the stars or the optional TODO keyword — +otherwise `[#X]'-shaped text inside the title (a dated log entry like +\"... reprioritized =[#D]= → =[#B]= to match parent\") gets misread as a +real cookie." (save-excursion (org-back-to-heading t) - (let ((eol (line-end-position))) - (when (re-search-forward tc--priority-cookie-regexp eol t) - (string-to-char (match-string 1)))))) + (nth 3 (org-heading-components)))) (defun tc--priority-lower-p (child parent) "Non-nil when CHILD priority letter ranks lower than PARENT — i.e. later in |