;;; test-pearl-comment-deletion.el --- Tests for deleting a comment -*- lexical-binding: t; -*- ;; Copyright (C) 2026 Craig Jennings ;; Author: Craig Jennings ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Tests for `pearl-delete-current-comment' and `pearl--delete-comment-async' ;; (see docs/comment-deletion-spec.org). The command is own-only (reusing the ;; viewer / `pearl--comment-editable-p' gate), confirms before the destructive ;; `commentDelete' mutation, removes only the comment's subtree on success, and ;; ignores tag/save concerns. HTTP is stubbed at the request boundary. ;;; Code: (require 'test-bootstrap (expand-file-name "test-bootstrap.el")) (require 'testutil-request (expand-file-name "testutil-request.el")) (require 'cl-lib) (defmacro test-pearl-del--in-org (content &rest body) "Run BODY in an org-mode temp buffer holding CONTENT at point-min." (declare (indent 1)) `(let ((org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE"))) (org-element-use-cache nil)) (with-temp-buffer (insert ,content) (org-mode) (goto-char (point-min)) ,@body))) (defun test-pearl-del--doc (&optional c1-stored-body) "An issue with a body and two comments: own c1 (author u-me) + other c2. C1's =LINEAR-COMMENT-SHA256= is the hash of C1-STORED-BODY's markdown, defaulting to its visible body \"my comment\" (so the comment reads clean). Pass a different string to make C1 read dirty, or the symbol `none' to omit the hash." (let* ((shown "my comment") (sha (cond ((eq c1-stored-body 'none) nil) (t (secure-hash 'sha256 (pearl--org-to-md (or c1-stored-body shown))))))) (concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nIssue body.\n" "**** Comments\n" "***** Craig --- 2026-05-24T09:00:00.000Z\n" ":PROPERTIES:\n" ":LINEAR-COMMENT-ID: c1\n" ":LINEAR-COMMENT-AUTHOR-ID: u-me\n" (if sha (format ":LINEAR-COMMENT-SHA256: %s\n" sha) "") ":END:\n" shown "\n" "***** Someone --- 2026-05-24T10:00:00.000Z\n" ":PROPERTIES:\n" ":LINEAR-COMMENT-ID: c2\n" ":LINEAR-COMMENT-AUTHOR-ID: u-other\n" ":LINEAR-COMMENT-SHA256: " (secure-hash 'sha256 "their comment") "\n" ":END:\ntheir comment\n"))) (defun test-pearl-del--goto (needle) "Move point onto the line matching NEEDLE." (goto-char (point-min)) (re-search-forward needle) (beginning-of-line)) ;;; --delete-comment-async (HTTP stubbed) (ert-deftest test-pearl-delete-comment-async-success () "A successful commentDelete reports success." (testutil-linear-with-response '((data (commentDelete (success . t)))) (let (result) (pearl--delete-comment-async "c1" (lambda (r) (setq result r))) (should (eq t (plist-get result :success)))))) (ert-deftest test-pearl-delete-comment-async-soft-fail () "A non-success / error commentDelete reports failure rather than erroring." (testutil-linear-with-response '((data (commentDelete (success . :json-false)))) (let (result) (pearl--delete-comment-async "c1" (lambda (r) (setq result r))) (should-not (plist-get result :success))))) ;;; pearl-delete-current-comment (defmacro test-pearl-del--with-stubs (deleted confirm &rest body) "Run BODY with delete/viewer/confirm stubbed. DELETED is a symbol bound to a list collecting comment-ids passed to the delete mutation (which reports success). CONFIRM is the `yes-or-no-p' return value. Binds `prompt' to the last confirmation prompt string. Viewer is warm as u-me." (declare (indent 2)) `(let ((pearl--cache-viewer '(:id "u-me" :name "Me")) (prompt nil)) (cl-letf (((symbol-function 'pearl--delete-comment-async) (lambda (id cb) (push id ,deleted) (funcall cb '(:success t)))) ((symbol-function 'yes-or-no-p) (lambda (p) (setq prompt p) ,confirm))) (ignore prompt) ,@body))) (ert-deftest test-pearl-delete-comment-not-on-comment-errors () "Run on a non-comment heading: user-error, no delete mutation." (test-pearl-del--in-org (test-pearl-del--doc) (let ((deleted nil)) (test-pearl-del--with-stubs deleted t (test-pearl-del--goto "^\\*\\*\\* TODO") (should-error (pearl-delete-current-comment) :type 'user-error) (should-not deleted))))) (ert-deftest test-pearl-delete-comment-own-confirmed-removes-only-that-subtree () "Own comment + confirm + success removes c1 only; c2 and the issue body stay." (test-pearl-del--in-org (test-pearl-del--doc) (let ((deleted nil)) (test-pearl-del--with-stubs deleted t (test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig") (pearl-delete-current-comment) (should (equal '("c1") deleted)) (let ((s (buffer-string))) (should-not (string-match-p "LINEAR-COMMENT-ID: c1" s)) (should (string-match-p "LINEAR-COMMENT-ID: c2" s)) (should (string-match-p "their comment" s)) (should (string-match-p "Issue body\\." s))))))) (ert-deftest test-pearl-delete-comment-declined-no-mutation () "Declining the confirmation deletes nothing and leaves the subtree intact." (test-pearl-del--in-org (test-pearl-del--doc) (let ((deleted nil)) (test-pearl-del--with-stubs deleted nil (test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig") (pearl-delete-current-comment) (should-not deleted) (should (string-match-p "LINEAR-COMMENT-ID: c1" (buffer-string))))))) (ert-deftest test-pearl-delete-comment-non-own-refused () "Another user's comment is refused with no delete mutation." (test-pearl-del--in-org (test-pearl-del--doc) (let ((deleted nil)) (test-pearl-del--with-stubs deleted t (test-pearl-del--goto "^\\*\\*\\*\\*\\* Someone") (pearl-delete-current-comment) (should-not deleted) (should (string-match-p "LINEAR-COMMENT-ID: c2" (buffer-string))))))) (ert-deftest test-pearl-delete-comment-viewer-failure-refused () "A failed viewer lookup refuses with the identity message and no mutation." (test-pearl-del--in-org (test-pearl-del--doc) (let ((deleted nil) (msg nil) (pearl--cache-viewer nil)) (cl-letf (((symbol-function 'pearl--viewer-async) (lambda (cb) (funcall cb nil))) ((symbol-function 'pearl--delete-comment-async) (lambda (id cb) (push id deleted) (funcall cb '(:success t)))) ((symbol-function 'message) (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) (test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig") (pearl-delete-current-comment) (should-not deleted) (should (string-match-p "Linear identity" msg)))))) (ert-deftest test-pearl-delete-comment-failure-keeps-subtree () "A failed commentDelete leaves the comment subtree in place." (test-pearl-del--in-org (test-pearl-del--doc) (let ((pearl--cache-viewer '(:id "u-me" :name "Me"))) (cl-letf (((symbol-function 'pearl--delete-comment-async) (lambda (_id cb) (funcall cb '(:success nil)))) ((symbol-function 'yes-or-no-p) (lambda (_p) t))) (test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig") (pearl-delete-current-comment) (should (string-match-p "LINEAR-COMMENT-ID: c1" (buffer-string))))))) (ert-deftest test-pearl-delete-comment-clean-prompt-wording () "A clean own comment uses the plain remove-it-here prompt." (test-pearl-del--in-org (test-pearl-del--doc) (let ((deleted nil) (captured nil)) (cl-letf (((symbol-function 'pearl--delete-comment-async) (lambda (id cb) (push id deleted) (funcall cb '(:success t)))) ((symbol-function 'yes-or-no-p) (lambda (p) (setq captured p) t))) (let ((pearl--cache-viewer '(:id "u-me" :name "Me"))) (test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig") (pearl-delete-current-comment) (should (string-match-p "from Linear and remove it here" captured))))))) (ert-deftest test-pearl-delete-comment-dirty-prompt-names-both () "A locally edited own comment uses the discard-local-edits prompt naming both." (test-pearl-del--in-org (test-pearl-del--doc "a different stored body") (let ((captured nil)) (cl-letf (((symbol-function 'pearl--delete-comment-async) (lambda (_id cb) (funcall cb '(:success t)))) ((symbol-function 'yes-or-no-p) (lambda (p) (setq captured p) t))) (let ((pearl--cache-viewer '(:id "u-me" :name "Me"))) (test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig") (pearl-delete-current-comment) (should (string-match-p "Linear" captured)) (should (string-match-p "discard" captured))))))) (ert-deftest test-pearl-delete-comment-missing-sha-takes-stronger-prompt () "A comment with no stored hash (unknown provenance) takes the discard prompt." (test-pearl-del--in-org (test-pearl-del--doc 'none) (let ((captured nil)) (cl-letf (((symbol-function 'pearl--delete-comment-async) (lambda (_id cb) (funcall cb '(:success t)))) ((symbol-function 'yes-or-no-p) (lambda (p) (setq captured p) t))) (let ((pearl--cache-viewer '(:id "u-me" :name "Me"))) (test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig") (pearl-delete-current-comment) (should (string-match-p "discard" captured))))))) (ert-deftest test-pearl-delete-comment-killed-buffer-no-signal () "If the buffer is killed before the delete callback fires, nothing signals." (let ((buf (generate-new-buffer "pearl-del-killtest")) (pearl--cache-viewer '(:id "u-me" :name "Me"))) (unwind-protect (progn (with-current-buffer buf (let ((org-element-use-cache nil)) (insert (test-pearl-del--doc)) (org-mode) (test-pearl-del--goto "^\\*\\*\\*\\*\\* Craig"))) ;; The delete stub kills the buffer, then reports success -- the ;; success callback must not signal against the dead buffer. (cl-letf (((symbol-function 'pearl--delete-comment-async) (lambda (_id cb) (kill-buffer buf) (funcall cb '(:success t)))) ((symbol-function 'yes-or-no-p) (lambda (_p) t))) (with-current-buffer buf ;; should complete without error (should-not (pearl-delete-current-comment))))) (when (buffer-live-p buf) (kill-buffer buf))))) (provide 'test-pearl-comment-deletion) ;;; test-pearl-comment-deletion.el ends here