diff options
Diffstat (limited to 'tests/test-pearl-conflict.el')
| -rw-r--r-- | tests/test-pearl-conflict.el | 282 |
1 files changed, 282 insertions, 0 deletions
diff --git a/tests/test-pearl-conflict.el b/tests/test-pearl-conflict.el new file mode 100644 index 0000000..03d8f31 --- /dev/null +++ b/tests/test-pearl-conflict.el @@ -0,0 +1,282 @@ +;;; test-pearl-conflict.el --- Tests for interactive conflict resolution -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for the conflict-resolution foundation: the no-data-loss stash +;; (`pearl--stash-conflict-text'), the smerge conflict-string builder +;; (`pearl--conflict-smerge-string'), and the resolution prompt +;; (`pearl--read-conflict-resolution', cancel-by-default). + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) +(require 'cl-lib) + +(defmacro test-pearl-conflict--in-org (content &rest body) + "Run BODY in an org-mode temp buffer holding CONTENT, default mapping bound." + (declare (indent 1)) + `(let ((pearl-state-to-todo-mapping + '(("Todo" . "TODO") ("In Progress" . "IN-PROGRESS") ("Done" . "DONE"))) + (org-todo-keywords '((sequence "TODO" "IN-PROGRESS" "|" "DONE")))) + (with-temp-buffer + (insert ,content) + (org-mode) + (goto-char (point-min)) + ,@body))) + +(defun test-pearl-conflict--marker () + "Return a marker at the first issue heading in the current buffer." + (goto-char (point-min)) + (re-search-forward "^\\*\\*\\* ") + (beginning-of-line) + (point-marker)) + +;;; --stash-conflict-text + +(ert-deftest test-pearl-stash-conflict-text-to-kill-ring-and-buffer () + "Stashing puts the text on the kill ring and into the backup buffer." + (let ((kill-ring nil)) + (when (get-buffer "*pearl-conflict-backup*") + (kill-buffer "*pearl-conflict-backup*")) + (pearl--stash-conflict-text "ENG-1 description" "My local edit.") + (should (string= "My local edit." (current-kill 0))) + (with-current-buffer "*pearl-conflict-backup*" + (let ((s (buffer-string))) + (should (string-match-p "ENG-1 description" s)) + (should (string-match-p "My local edit\\." s)))))) + +(ert-deftest test-pearl-stash-conflict-text-appends-not-overwrites () + "A second stash appends below the first, preserving earlier backups." + (let ((kill-ring nil)) + (when (get-buffer "*pearl-conflict-backup*") + (kill-buffer "*pearl-conflict-backup*")) + (pearl--stash-conflict-text "ENG-1 description" "First edit.") + (pearl--stash-conflict-text "ENG-2 title" "Second edit.") + (with-current-buffer "*pearl-conflict-backup*" + (let ((s (buffer-string))) + (should (string-match-p "First edit\\." s)) + (should (string-match-p "Second edit\\." s)))))) + +(ert-deftest test-pearl-stash-conflict-text-empty-is-noop () + "Stashing empty text touches neither the kill ring nor the backup buffer." + (let ((kill-ring nil)) + (when (get-buffer "*pearl-conflict-backup*") + (kill-buffer "*pearl-conflict-backup*")) + (pearl--stash-conflict-text "ENG-1 description" "") + (should (null kill-ring)) + (should-not (get-buffer "*pearl-conflict-backup*")))) + +;;; --conflict-smerge-string + +(ert-deftest test-pearl-conflict-smerge-string-has-markers-in-order () + "The smerge string carries the three markers with local before remote." + (let ((s (pearl--conflict-smerge-string "LOCAL TEXT" "REMOTE TEXT"))) + (should (string-match-p "^<<<<<<<" s)) + (should (string-match-p "^=======" s)) + (should (string-match-p "^>>>>>>>" s)) + (let ((lt (string-match "LOCAL TEXT" s)) + (sep (string-match "^=======" s)) + (rt (string-match "REMOTE TEXT" s))) + (should (< lt sep)) + (should (< sep rt))))) + +(ert-deftest test-pearl-conflict-smerge-string-newline-terminates-sections () + "Sections whose text lacks a trailing newline still get one before a marker." + (let ((s (pearl--conflict-smerge-string "no-newline-local" "no-newline-remote"))) + ;; The separator and closing markers must each start their own line. + (should (string-match-p "no-newline-local\n=======" s)) + (should (string-match-p "no-newline-remote\n>>>>>>>" s)))) + +;;; --read-conflict-resolution + +(ert-deftest test-pearl-read-conflict-resolution-maps-choices () + "Each prompt label maps to its resolution symbol." + (dolist (case '(("use local" . use-local) + ("use remote" . use-remote) + ("rewrite" . rewrite) + ("cancel" . cancel))) + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt collection &rest _) + ;; Return the first offered label containing the case keyword. + (seq-find (lambda (c) (string-match-p (car case) c)) collection)))) + (should (eq (cdr case) (pearl--read-conflict-resolution "ENG-1 description")))))) + +(ert-deftest test-pearl-read-conflict-resolution-defaults-to-cancel () + "Selecting the default (a bare RET) resolves to `cancel'." + (cl-letf (((symbol-function 'completing-read) + (lambda (_prompt _collection &rest args) + ;; Emulate RET-on-default: completing-read returns the DEF arg. + ;; args = (predicate require-match initial-input hist def ...), + ;; so DEF is the 5th element, index 4. + (nth 4 args)))) + (should (eq 'cancel (pearl--read-conflict-resolution "ENG-1 description"))))) + +;;; --set-entry-body-at-point + +(ert-deftest test-pearl-set-entry-body-replaces-body-keeps-drawer () + "Setting the body replaces the text after the drawer and preserves the drawer." + (test-pearl-conflict--in-org + "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: x\n:END:\nOld body.\n" + (re-search-forward "Title") + (pearl--set-entry-body-at-point "New body line.") + (goto-char (point-min)) + (should (re-search-forward "New body line\\." nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "Old body\\." nil t)) + (should (string= "a" (org-entry-get nil "LINEAR-ID"))))) + +(ert-deftest test-pearl-set-entry-body-stops-before-child-heading () + "Setting the body does not disturb a child Comments subtree." + (test-pearl-conflict--in-org + (concat "*** TODO [#B] Title\n:PROPERTIES:\n:LINEAR-ID: a\n:END:\nOld body.\n" + "**** Comments\n***** Me — t\nmine\n") + (re-search-forward "Title") + (pearl--set-entry-body-at-point "New body.") + (goto-char (point-min)) + (should (re-search-forward "New body\\." nil t)) + (should (re-search-forward "Comments" nil t)) + (should (re-search-forward "mine" nil t)))) + +;;; --resolve-conflict + +(ert-deftest test-pearl-resolve-conflict-cancel-does-nothing () + "Cancel applies nothing, pushes nothing, and leaves the provenance hash." + (test-pearl-conflict--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: H0\n:END:\nbody\n" + (let ((applied nil) (pushed nil) (marker (test-pearl-conflict--marker))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'cancel))) + (pearl--resolve-conflict + "ENG-1 description" "local" "remote" marker "LINEAR-DESC-SHA256" + (lambda (_md) (setq applied t)) + (lambda (_md cb) (setq pushed t) (funcall cb t))) + (should-not applied) + (should-not pushed) + (should (string= "H0" (org-entry-get marker "LINEAR-DESC-SHA256"))))))) + +(ert-deftest test-pearl-resolve-conflict-use-local-pushes-and-advances () + "Use-local pushes the local text and advances the hash to it on success." + (test-pearl-conflict--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: H0\n:END:\nbody\n" + (let ((pushed-md nil) (applied nil) (marker (test-pearl-conflict--marker))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'use-local))) + (pearl--resolve-conflict + "ENG-1 description" "local text" "remote text" marker "LINEAR-DESC-SHA256" + (lambda (_md) (setq applied t)) + (lambda (md cb) (setq pushed-md md) (funcall cb t))) + (should (string= "local text" pushed-md)) + (should-not applied) + (should (string= (secure-hash 'sha256 "local text") + (org-entry-get marker "LINEAR-DESC-SHA256"))))))) + +(ert-deftest test-pearl-resolve-conflict-use-remote-stashes-applies-no-push () + "Use-remote stashes local, writes remote, advances the hash, and never pushes." + (let ((kill-ring nil)) + (test-pearl-conflict--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: H0\n:END:\nbody\n" + (let ((applied-md nil) (pushed nil) (marker (test-pearl-conflict--marker))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'use-remote))) + (pearl--resolve-conflict + "ENG-1 description" "local text" "remote text" marker "LINEAR-DESC-SHA256" + (lambda (md) (setq applied-md md)) + (lambda (_md cb) (setq pushed t) (funcall cb t))) + (should (string= "remote text" applied-md)) + (should-not pushed) + (should (string= (secure-hash 'sha256 "remote text") + (org-entry-get marker "LINEAR-DESC-SHA256"))) + ;; the local edit was stashed, not lost + (should (string= "local text" (current-kill 0)))))))) + +(ert-deftest test-pearl-resolve-conflict-rewrite-applies-and-pushes () + "Rewrite stashes local, then on the smerge finish applies and pushes the merge." + (let ((kill-ring nil)) + (test-pearl-conflict--in-org + "*** TODO Title\n:PROPERTIES:\n:LINEAR-ID: a\n:LINEAR-DESC-SHA256: H0\n:END:\nbody\n" + (let ((applied nil) (pushed nil) (marker (test-pearl-conflict--marker))) + (cl-letf (((symbol-function 'pearl--read-conflict-resolution) (lambda (_) 'rewrite)) + ;; Emulate the user resolving the buffer and committing. + ((symbol-function 'pearl--resolve-conflict-in-smerge) + (lambda (_label _local _remote on-finish) + (funcall on-finish "merged text")))) + (pearl--resolve-conflict + "ENG-1 description" "local text" "remote text" marker "LINEAR-DESC-SHA256" + (lambda (md) (setq applied md)) + (lambda (md cb) (setq pushed md) (funcall cb t))) + (should (string= "local text" (current-kill 0))) + (should (string= "merged text" applied)) + (should (string= "merged text" pushed)) + (should (string= (secure-hash 'sha256 "merged text") + (org-entry-get marker "LINEAR-DESC-SHA256")))))))) + +;;; --conflict-has-markers-p + +(ert-deftest test-pearl-conflict-has-markers-p () + "Unresolved marker text reports markers; resolved text does not." + (should (pearl--conflict-has-markers-p + (pearl--conflict-smerge-string "mine" "theirs"))) + (should-not (pearl--conflict-has-markers-p "just the merged line\n"))) + +;;; --resolve-conflict-in-smerge (buffer setup) + +(ert-deftest test-pearl-resolve-conflict-in-smerge-sets-up-buffer () + "Opening the smerge buffer fills it with both sides and arms the callback." + (let ((buf-name "*pearl-merge: ENG-1 description*")) + (when (get-buffer buf-name) (kill-buffer buf-name)) + (cl-letf (((symbol-function 'pop-to-buffer) #'ignore)) + (pearl--resolve-conflict-in-smerge + "ENG-1 description" "my local" "the remote" (lambda (_) nil))) + (let ((buf (get-buffer buf-name))) + (should buf) + (with-current-buffer buf + (should (string-match-p "my local" (buffer-string))) + (should (string-match-p "the remote" (buffer-string))) + (should (bound-and-true-p smerge-mode)) + (should (functionp pearl--conflict-on-finish))) + (kill-buffer buf)))) + +;;; --conflict-commit / --conflict-abort + +(ert-deftest test-pearl-conflict-commit-refuses-with-markers () + "Committing with markers still present errors and never calls the callback." + (let ((called nil) (buf-name "*pearl-merge: ENG-1 description*")) + (when (get-buffer buf-name) (kill-buffer buf-name)) + (cl-letf (((symbol-function 'pop-to-buffer) #'ignore)) + (pearl--resolve-conflict-in-smerge + "ENG-1 description" "mine" "theirs" (lambda (_) (setq called t)))) + (with-current-buffer buf-name + (should-error (pearl--conflict-commit) :type 'user-error)) + (should-not called) + (when (get-buffer buf-name) (kill-buffer buf-name)))) + +(ert-deftest test-pearl-conflict-commit-resolved-calls-callback-and-kills () + "With markers resolved, commit hands the text to the callback and kills the buffer." + (let ((got nil) (buf-name "*pearl-merge: ENG-1 description*")) + (when (get-buffer buf-name) (kill-buffer buf-name)) + (cl-letf (((symbol-function 'pop-to-buffer) #'ignore)) + (pearl--resolve-conflict-in-smerge + "ENG-1 description" "mine" "theirs" (lambda (txt) (setq got txt)))) + (with-current-buffer buf-name + (erase-buffer) + (insert "the reconciled text\n") + (pearl--conflict-commit)) + (should (string= "the reconciled text\n" got)) + (should-not (get-buffer buf-name)))) + +(provide 'test-pearl-conflict) +;;; test-pearl-conflict.el ends here |