From 5a46d415df75b8b0168e2cf48b30fe463c01a77c Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Sun, 10 May 2026 02:44:10 -0500 Subject: Make repo reconciliation review-first Stop automatically stashing, pulling, and popping dirty repos during reconciliation. Clean repos still pull, dirty repos open Magit for review, and results now include structured statuses, skip reasons, pruning, and a summary. --- modules/reconcile-open-repos.el | 200 ++++++++++++++++++++------- tests/test-reconcile--check-for-open-work.el | 14 ++ tests/test-reconcile--find-git-repos.el | 22 ++- tests/test-reconcile--git-directory.el | 63 ++++++--- tests/test-reconcile--pull-clean.el | 32 +++-- tests/test-reconcile--pull-dirty.el | 105 +++----------- tests/test-reconcile--should-skip-p.el | 110 +++++++++------ tests/testutil-reconcile-open-repos.el | 32 ++++- 8 files changed, 361 insertions(+), 217 deletions(-) diff --git a/modules/reconcile-open-repos.el b/modules/reconcile-open-repos.el index 87c16a31..20a324b6 100644 --- a/modules/reconcile-open-repos.el +++ b/modules/reconcile-open-repos.el @@ -3,14 +3,12 @@ ;; ;;; Commentary: ;; -;; Git repository reconciliation workflow for multiple projects. Ensures all git -;; repositories in your projects/ and code/ directories are synchronized with -;; remotes and have no uncommitted work at the start and end of work sessions. -;; The workflow iterates through all git repositories in projects-dir and -;; code-dir, skips local-only repos and http/https remotes (reference clones), -;; silently pulls latest changes for clean repos, and for dirty repos stashes -;; changes, pulls, pops stash, and opens Magit for review. Also checks org-dir -;; and user-emacs-directory individually. +;; Git repository reconciliation workflow for multiple projects. The workflow +;; iterates through all git repositories in projects-dir and code-dir, skips +;; local-only repos and remotes matching `cj/reconcile-skipped-remote-regexp', +;; pulls latest changes for clean repos, and opens Magit for dirty repos without +;; stashing, rebasing, or popping work automatically. Also checks org-dir and +;; user-emacs-directory individually. ;; ;; Main function: cj/check-for-open-work (bound to M-P) ;; @@ -20,6 +18,9 @@ ;;; Code: +(require 'cl-lib) +(require 'subr-x) + ;; Forward declarations for variables defined in init.el (eval-when-compile (defvar projects-dir) @@ -29,91 +30,184 @@ ;; Forward declaration for magit (declare-function magit-status "magit" (&optional directory cache)) +(defcustom cj/reconcile-skipped-remote-regexp "^https?://" + "Regexp matching remote URLs that should be skipped by reconciliation. +This defaults to HTTP/HTTPS remotes because this setup treats those as +reference clones rather than active work repositories." + :type 'regexp + :group 'cj) + +(defcustom cj/reconcile-pruned-directory-names + '(".git" ".hg" ".svn" + "node_modules" ".venv" "venv" "__pycache__" + "target" "build" "dist" ".next" ".cache" "vendor") + "Directory basenames not descended while discovering git repositories." + :type '(repeat string) + :group 'cj) + +(defvar cj/reconcile-results nil + "Most recent list of repository reconciliation result plists.") + +;; ------------------------------- Git Process -------------------------------- + +(defun cj/reconcile--git (directory &rest args) + "Run git in DIRECTORY with ARGS. +Return a plist with :exit and :output. Git is invoked through +`process-file' with an argv list, not through a shell." + (let ((default-directory (file-name-as-directory directory))) + (with-temp-buffer + (let ((exit-code (apply #'process-file "git" nil (list t t) nil args))) + (list :exit exit-code + :output (buffer-string) + :args args))))) + +(defun cj/reconcile--git-output (directory &rest args) + "Run git in DIRECTORY with ARGS and return trimmed output on success." + (let ((result (apply #'cj/reconcile--git directory args))) + (when (zerop (plist-get result :exit)) + (string-trim (plist-get result :output))))) + ;; ------------------------------ Skip Predicate ------------------------------- +(defun cj/reconcile--skip-reason (directory) + "Return a skip reason symbol for DIRECTORY, or nil if it should be processed." + (cond + ((not (file-directory-p (expand-file-name ".git" directory))) + 'not-a-git-repo) + (t + (let ((remote-url (cj/reconcile--git-output + directory "config" "--get" "remote.origin.url"))) + (cond + ((or (null remote-url) (string-empty-p remote-url)) 'no-remote) + ((and cj/reconcile-skipped-remote-regexp + (string-match-p cj/reconcile-skipped-remote-regexp remote-url)) + 'skipped-remote) + (t nil)))))) + (defun cj/reconcile--should-skip-p (directory) "Return non-nil if DIRECTORY should be skipped during reconciliation. -Skips directories without .git, without a remote, or with http/https remotes -\(reference clones)." - (let ((default-directory directory)) - (or (not (file-directory-p (expand-file-name ".git" directory))) - (let ((remote-url (string-trim (shell-command-to-string - "git config --get remote.origin.url")))) - (or (string-empty-p remote-url) - (string-match-p "^\\(http\\|https\\)://" remote-url)))))) +Skips directories without .git, without a remote, or with remotes matching +`cj/reconcile-skipped-remote-regexp'." + (and (cj/reconcile--skip-reason directory) t)) ;; -------------------------------- Pull Clean -------------------------------- (defun cj/reconcile--pull-clean (directory) "Pull latest changes for clean git repo at DIRECTORY." - (let* ((default-directory directory) - (pull-result (shell-command "git pull --rebase --quiet"))) - (unless (= pull-result 0) - (message "Warning: git pull failed for %s (exit code: %d)" directory pull-result)))) + (let ((result (cj/reconcile--git directory "pull" "--rebase" "--quiet"))) + (if (zerop (plist-get result :exit)) + (list :directory directory :status 'pulled :output (plist-get result :output)) + (message "Warning: git pull failed for %s (exit code: %d)" + directory + (plist-get result :exit)) + (list :directory directory + :status 'pull-failed + :exit (plist-get result :exit) + :output (plist-get result :output))))) ;; -------------------------------- Pull Dirty -------------------------------- (defun cj/reconcile--pull-dirty (directory) - "Stash, pull, pop stash, and open Magit for dirty repo at DIRECTORY." - (let ((default-directory directory)) - (message "%s contains uncommitted work" directory) - (let ((stash-result (shell-command "git stash --quiet"))) - (if (= stash-result 0) - (let ((pull-result (shell-command "git pull --rebase --quiet"))) - (when (= pull-result 0) - (let ((stash-pop-result (shell-command "git stash pop --quiet"))) - (unless (= stash-pop-result 0) - (message "Warning: git stash pop failed for %s - opening Magit" directory)))) - (unless (= pull-result 0) - (message "Warning: git pull failed for %s - opening Magit" directory))) - (message "Warning: git stash failed for %s - opening Magit" directory))) - (magit-status directory))) + "Open Magit for dirty repo at DIRECTORY without modifying worktree state." + (message "%s contains uncommitted work; opening Magit for review" directory) + (magit-status directory) + (list :directory directory :status 'needs-review)) + +;; ------------------------------- Repo Status -------------------------------- + +(defun cj/reconcile--dirty-p (directory) + "Return non-nil if git repo DIRECTORY has uncommitted work." + (let ((status (cj/reconcile--git directory "status" "--porcelain"))) + (if (zerop (plist-get status :exit)) + (not (string-empty-p (string-trim (plist-get status :output)))) + (message "Warning: git status failed for %s (exit code: %d)" + directory + (plist-get status :exit)) + 'status-failed))) ;; -------------------------- Reconcile Git Directory -------------------------- (defun cj/reconcile-git-directory (directory) "Reconcile unopened work in a git project DIRECTORY. -Skips local-only repos and http/https remotes. For clean repos, silently pulls -latest changes. For dirty repos, stashes changes, pulls, pops stash, and opens -Magit for review." +Skips local-only repos and configured remote policies. For clean repos, pulls +latest changes. For dirty repos, opens Magit for review without mutating the +worktree." (message "checking: %s" directory) - (unless (cj/reconcile--should-skip-p directory) - (let ((default-directory directory)) - (if (string-empty-p (shell-command-to-string "git status --porcelain")) - (cj/reconcile--pull-clean directory) - (cj/reconcile--pull-dirty directory))))) + (let ((skip-reason (cj/reconcile--skip-reason directory))) + (cond + (skip-reason + (message "Skipping %s: %s" directory skip-reason) + (list :directory directory :status 'skipped :reason skip-reason)) + (t + (let ((dirty (cj/reconcile--dirty-p directory))) + (cond + ((eq dirty 'status-failed) + (list :directory directory :status 'status-failed)) + (dirty + (cj/reconcile--pull-dirty directory)) + (t + (cj/reconcile--pull-clean directory)))))))) ;; ---------------------------- Check For Open Work ---------------------------- -(defun cj/find-git-repos (directory) +(defun cj/reconcile--pruned-directory-p (directory) + "Return non-nil if DIRECTORY should be pruned during repo discovery." + (member (file-name-nondirectory (directory-file-name directory)) + cj/reconcile-pruned-directory-names)) + +(defun cj/find-git-repos (directory &optional include-nested) "Recursively find all git repositories under DIRECTORY. -Returns a list of directory paths that contain a .git subdirectory." +Returns a list of directory paths that contain a .git subdirectory. +Prunes generated/heavy directories. Once a repository root is found, do not +descend into it unless INCLUDE-NESTED is non-nil." (let (repos) - (dolist (child (directory-files directory t "^[^.]+$" 'nosort)) - (when (file-directory-p child) - (when (file-directory-p (expand-file-name ".git" child)) - (push child repos)) - (setq repos (nconc repos (cj/find-git-repos child))))) + (when (file-directory-p directory) + (dolist (child (directory-files directory t "^[^.]+$" 'nosort)) + (when (and (file-directory-p child) + (not (cj/reconcile--pruned-directory-p child))) + (if (file-directory-p (expand-file-name ".git" child)) + (progn + (push child repos) + (when include-nested + (setq repos (nconc repos (cj/find-git-repos child include-nested))))) + (setq repos (nconc repos (cj/find-git-repos child include-nested))))))) repos)) +(defun cj/reconcile--summary-message (results) + "Return a concise summary string for reconciliation RESULTS." + (let ((pulled 0) + (review 0) + (skipped 0) + (failed 0)) + (dolist (result results) + (pcase (plist-get result :status) + ('pulled (cl-incf pulled)) + ('needs-review (cl-incf review)) + ('skipped (cl-incf skipped)) + ((or 'pull-failed 'status-failed) (cl-incf failed)))) + (format "Complete. Repositories checked: %d, pulled: %d, needs review: %d, skipped: %d, failed: %d" + (length results) pulled review skipped failed))) + (defun cj/check-for-open-work () "Check all project directories for open work." (interactive) ;; these are constants defined in init.el ;; recursively find and check all git repos under these directories + (setq cj/reconcile-results nil) (dolist (base-dir (list projects-dir code-dir)) (when (and base-dir (file-directory-p base-dir)) (dolist (repo (cj/find-git-repos base-dir)) - (cj/reconcile-git-directory repo)))) + (push (cj/reconcile-git-directory repo) cj/reconcile-results)))) ;; check these directories individually (when (and (boundp 'org-dir) org-dir (file-directory-p org-dir)) - (cj/reconcile-git-directory org-dir)) + (push (cj/reconcile-git-directory org-dir) cj/reconcile-results)) (when (and (boundp 'user-emacs-directory) user-emacs-directory (file-directory-p user-emacs-directory)) - (cj/reconcile-git-directory user-emacs-directory)) + (push (cj/reconcile-git-directory user-emacs-directory) cj/reconcile-results)) ;; communicate when finished. - (message "Complete. All repositories checked and updated")) + (setq cj/reconcile-results (nreverse (delq nil cj/reconcile-results))) + (message "%s" (cj/reconcile--summary-message cj/reconcile-results))) (keymap-global-set "M-P" #'cj/check-for-open-work) diff --git a/tests/test-reconcile--check-for-open-work.el b/tests/test-reconcile--check-for-open-work.el index e4615dab..37a5d0a3 100644 --- a/tests/test-reconcile--check-for-open-work.el +++ b/tests/test-reconcile--check-for-open-work.el @@ -177,5 +177,19 @@ Regression: lexical-binding + `(boundp 'base-dir)' used to silently skip this." (cj/check-for-open-work)) (should (cl-some (lambda (m) (string-match-p "Complete\\." m)) messages))))) +(ert-deftest test-reconcile-check-for-open-work-normal-summary-counts-statuses () + "Summary reports pulled, review, skipped, and failed counts." + (let ((summary (cj/reconcile--summary-message + '((:status pulled) + (:status needs-review) + (:status skipped :reason skipped-remote) + (:status pull-failed) + (:status status-failed))))) + (should (string-match-p "Repositories checked: 5" summary)) + (should (string-match-p "pulled: 1" summary)) + (should (string-match-p "needs review: 1" summary)) + (should (string-match-p "skipped: 1" summary)) + (should (string-match-p "failed: 2" summary)))) + (provide 'test-reconcile--check-for-open-work) ;;; test-reconcile--check-for-open-work.el ends here diff --git a/tests/test-reconcile--find-git-repos.el b/tests/test-reconcile--find-git-repos.el index 25987818..e065fca9 100644 --- a/tests/test-reconcile--find-git-repos.el +++ b/tests/test-reconcile--find-git-repos.el @@ -27,11 +27,19 @@ (should (= (length repos) 1)) (should (string-suffix-p "child" (car repos)))))) -(ert-deftest test-find-git-repos-normal-repo-with-nested-subrepo () - "Finds both a parent repo and a sub-repo inside it." +(ert-deftest test-find-git-repos-normal-stops-at-repo-root-by-default () + "Finds a parent repo and does not descend into nested repos by default." (reconcile-test-with-temp-dirs ("deepsat/.git/" "deepsat/frontend/.git/" "deepsat/backend/.git/") (let ((repos (cj/find-git-repos test-root))) + (should (= (length repos) 1)) + (should (string-suffix-p "deepsat" (car repos)))))) + +(ert-deftest test-find-git-repos-normal-can-include-nested-subrepos () + "Finds nested repos when INCLUDE-NESTED is non-nil." + (reconcile-test-with-temp-dirs + ("deepsat/.git/" "deepsat/frontend/.git/" "deepsat/backend/.git/") + (let ((repos (cj/find-git-repos test-root t))) (should (= (length repos) 3))))) (ert-deftest test-find-git-repos-normal-mixed-repos-and-dirs () @@ -73,5 +81,15 @@ (should (= (length repos) 1)) (should (string-suffix-p "visible-repo" (car repos)))))) +(ert-deftest test-find-git-repos-boundary-prunes-heavy-directories () + "Skips generated/heavy directories while discovering repos." + (reconcile-test-with-temp-dirs + ("project/node_modules/dependency/.git/" + "project/.venv/tool/.git/" + "project/src/repo/.git/") + (let ((repos (cj/find-git-repos test-root))) + (should (= (length repos) 1)) + (should (string-suffix-p "repo" (car repos)))))) + (provide 'test-reconcile--find-git-repos) ;;; test-reconcile--find-git-repos.el ends here diff --git a/tests/test-reconcile--git-directory.el b/tests/test-reconcile--git-directory.el index ab4a6323..1999f706 100644 --- a/tests/test-reconcile--git-directory.el +++ b/tests/test-reconcile--git-directory.el @@ -18,13 +18,15 @@ (let ((dir (expand-file-name "repo" test-root)) (clean-called nil) (dirty-called nil)) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (cond ((string-match-p "remote.origin.url" cmd) "git@host:repo.git") - ((string-match-p "status --porcelain" cmd) "") - (t ""))) - (cl-letf (((symbol-function 'cj/reconcile--pull-clean) + (reconcile-test-with-git-mock + (lambda (args) + (cond + ((equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "git@host:repo.git\n")) + ((equal args '("status" "--porcelain")) + '(:exit 0 :output "")) + (t '(:exit 0 :output "")))) + (cl-letf (((symbol-function 'cj/reconcile--pull-clean) (lambda (_dir) (setq clean-called t))) ((symbol-function 'cj/reconcile--pull-dirty) (lambda (_dir) (setq dirty-called t))) @@ -33,20 +35,22 @@ (should clean-called) (should-not dirty-called)))) -(ert-deftest test-reconcile-git-directory-normal-dirty-repo-stashes () - "Dirty SSH repo calls pull-dirty, not pull-clean." +(ert-deftest test-reconcile-git-directory-normal-dirty-repo-opens-review () + "Dirty SSH repo calls review-first handler, not pull-clean." (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root)) (clean-called nil) (dirty-called nil)) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (cond ((string-match-p "remote.origin.url" cmd) "git@host:repo.git") - ((string-match-p "status --porcelain" cmd) " M file.el\n") - (t ""))) - (cl-letf (((symbol-function 'cj/reconcile--pull-clean) + (reconcile-test-with-git-mock + (lambda (args) + (cond + ((equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "git@host:repo.git\n")) + ((equal args '("status" "--porcelain")) + '(:exit 0 :output " M file.el\n")) + (t '(:exit 0 :output "")))) + (cl-letf (((symbol-function 'cj/reconcile--pull-clean) (lambda (_dir) (setq clean-called t))) ((symbol-function 'cj/reconcile--pull-dirty) (lambda (_dir) (setq dirty-called t))) @@ -62,13 +66,12 @@ (let ((dir (expand-file-name "repo" test-root)) (clean-called nil) (dirty-called nil)) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (if (string-match-p "remote.origin.url" cmd) - "https://github.com/user/repo.git" - "")) - (cl-letf (((symbol-function 'cj/reconcile--pull-clean) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "https://github.com/user/repo.git\n") + '(:exit 0 :output ""))) + (cl-letf (((symbol-function 'cj/reconcile--pull-clean) (lambda (_dir) (setq clean-called t))) ((symbol-function 'cj/reconcile--pull-dirty) (lambda (_dir) (setq dirty-called t))) @@ -77,6 +80,20 @@ (should-not clean-called) (should-not dirty-called)))) +(ert-deftest test-reconcile-git-directory-normal-skipped-result-includes-reason () + "Skipped repos return a structured reason." + (reconcile-test-with-temp-dirs + ("repo/.git/") + (let ((dir (expand-file-name "repo" test-root))) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "https://github.com/user/repo.git\n") + '(:exit 0 :output ""))) + (let ((result (cj/reconcile-git-directory dir))) + (should (eq (plist-get result :status) 'skipped)) + (should (eq (plist-get result :reason) 'skipped-remote))))))) + ;;; Boundary Cases (ert-deftest test-reconcile-git-directory-boundary-emits-checking-message () diff --git a/tests/test-reconcile--pull-clean.el b/tests/test-reconcile--pull-clean.el index a10c6f1e..89739987 100644 --- a/tests/test-reconcile--pull-clean.el +++ b/tests/test-reconcile--pull-clean.el @@ -17,12 +17,14 @@ ("repo/.git/") (let ((dir (expand-file-name "repo" test-root)) (messages nil)) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (_cmd) "") - (cl-letf (((symbol-function 'message) + (reconcile-test-with-git-mock + (lambda (args) + (should (equal args '("pull" "--rebase" "--quiet"))) + '(:exit 0 :output "")) + (cl-letf (((symbol-function 'message) (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) - (cj/reconcile--pull-clean dir))) + (let ((result (cj/reconcile--pull-clean dir))) + (should (eq (plist-get result :status) 'pulled))))) (should-not (cl-some (lambda (m) (string-match-p "Warning" m)) messages))))) (ert-deftest test-pull-clean-normal-failure-warns () @@ -31,12 +33,13 @@ ("repo/.git/") (let ((dir (expand-file-name "repo" test-root)) (messages nil)) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 1) - (lambda (_cmd) "") - (cl-letf (((symbol-function 'message) + (reconcile-test-with-git-mock + (lambda (_args) '(:exit 1 :output "boom\n")) + (cl-letf (((symbol-function 'message) (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) - (cj/reconcile--pull-clean dir))) + (let ((result (cj/reconcile--pull-clean dir))) + (should (eq (plist-get result :status) 'pull-failed)) + (should (equal (plist-get result :output) "boom\n"))))) (should (cl-some (lambda (m) (string-match-p "Warning.*git pull failed" m)) messages)) (should (cl-some (lambda (m) (string-match-p "exit code: 1" m)) messages))))) @@ -48,12 +51,11 @@ ("repo/.git/") (let ((dir (expand-file-name "repo" test-root)) (messages nil)) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 128) - (lambda (_cmd) "") - (cl-letf (((symbol-function 'message) + (reconcile-test-with-git-mock + (lambda (_args) '(:exit 128 :output "fatal\n")) + (cl-letf (((symbol-function 'message) (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) - (cj/reconcile--pull-clean dir))) + (cj/reconcile--pull-clean dir))) (should (cl-some (lambda (m) (string-match-p "exit code: 128" m)) messages))))) (provide 'test-reconcile--pull-clean) diff --git a/tests/test-reconcile--pull-dirty.el b/tests/test-reconcile--pull-dirty.el index 2ba1f5d1..c26c8548 100644 --- a/tests/test-reconcile--pull-dirty.el +++ b/tests/test-reconcile--pull-dirty.el @@ -1,7 +1,7 @@ -;;; test-reconcile--pull-dirty.el --- Tests for cj/reconcile--pull-dirty -*- lexical-binding: t; -*- +;;; test-reconcile--pull-dirty.el --- Tests for dirty repo review handling -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the dirty-repo reconciliation: stash, pull, pop, magit. +;; Dirty repositories should be review-first: no stash, pull, or stash-pop. ;;; Code: @@ -9,104 +9,43 @@ (require 'testutil-reconcile-open-repos) (require 'reconcile-open-repos) -;;; Normal Cases - -(ert-deftest test-pull-dirty-normal-stash-pull-pop-success () - "When stash, pull, and pop all succeed, magit is still opened." +(ert-deftest test-pull-dirty-normal-opens-magit-for-review () + "Dirty repo handling opens Magit and returns a needs-review result." (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root))) (reconcile-test-with-magit-mock - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (_cmd) "") - (cj/reconcile--pull-dirty dir)) - (should (member dir reconcile-test-magit-calls)))))) - -(ert-deftest test-pull-dirty-normal-stash-fails-opens-magit () - "When stash fails, magit is opened and warning emitted." - (reconcile-test-with-temp-dirs - ("repo/.git/") - (let ((dir (expand-file-name "repo" test-root)) - (messages nil)) - (reconcile-test-with-magit-mock - (reconcile-test-with-shell-mocks - (lambda (cmd) - (if (string-match-p "stash --quiet\\'" cmd) 1 0)) - (lambda (_cmd) "") - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) - (cj/reconcile--pull-dirty dir))) - (should (member dir reconcile-test-magit-calls)) - (should (cl-some (lambda (m) (string-match-p "stash failed" m)) messages)))))) + (let ((result (cj/reconcile--pull-dirty dir))) + (should (member dir reconcile-test-magit-calls)) + (should (eq (plist-get result :status) 'needs-review)) + (should (equal (plist-get result :directory) dir))))))) -(ert-deftest test-pull-dirty-normal-pull-fails-warns () - "When stash succeeds but pull fails, warning mentions pull failure." - (reconcile-test-with-temp-dirs - ("repo/.git/") - (let ((dir (expand-file-name "repo" test-root)) - (messages nil)) - (reconcile-test-with-magit-mock - (reconcile-test-with-shell-mocks - (lambda (cmd) - (cond ((string-match-p "stash --quiet\\'" cmd) 0) - ((string-match-p "pull" cmd) 1) - (t 0))) - (lambda (_cmd) "") - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) - (cj/reconcile--pull-dirty dir))) - (should (cl-some (lambda (m) (string-match-p "git pull failed" m)) messages)))))) - -(ert-deftest test-pull-dirty-normal-stash-pop-fails-warns () - "When stash and pull succeed but pop fails, warning mentions stash pop." - (reconcile-test-with-temp-dirs - ("repo/.git/") - (let ((dir (expand-file-name "repo" test-root)) - (messages nil)) - (reconcile-test-with-magit-mock - (reconcile-test-with-shell-mocks - (lambda (cmd) - (cond ((string-match-p "stash pop" cmd) 1) - ((string-match-p "stash" cmd) 0) - (t 0))) - (lambda (_cmd) "") - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) - (cj/reconcile--pull-dirty dir))) - (should (cl-some (lambda (m) (string-match-p "stash pop failed" m)) messages)))))) - -;;; Boundary Cases - -(ert-deftest test-pull-dirty-boundary-always-opens-magit () - "Magit is opened regardless of whether pull succeeds or fails." +(ert-deftest test-pull-dirty-normal-does-not-run-git-commands () + "Dirty repo handling must not mutate the worktree with git commands." (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root))) - ;; Test with pull failure (reconcile-test-with-magit-mock - (reconcile-test-with-shell-mocks - (lambda (cmd) - (if (string-match-p "pull" cmd) 1 0)) - (lambda (_cmd) "") - (cl-letf (((symbol-function 'message) (lambda (_fmt &rest _args)))) - (cj/reconcile--pull-dirty dir))) + (reconcile-test-with-git-mock + (lambda (_args) + (ert-fail "Dirty repo handler should not run git commands")) + (cj/reconcile--pull-dirty dir)) (should (member dir reconcile-test-magit-calls)))))) (ert-deftest test-pull-dirty-boundary-uncommitted-work-message () - "Always emits 'contains uncommitted work' message." + "Dirty repo handling announces review instead of auto-reconciling." (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root)) (messages nil)) (reconcile-test-with-magit-mock - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (_cmd) "") - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (push (apply #'format fmt args) messages)))) - (cj/reconcile--pull-dirty dir))) - (should (cl-some (lambda (m) (string-match-p "uncommitted work" m)) messages)))))) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) + (push (apply #'format fmt args) messages)))) + (cj/reconcile--pull-dirty dir))) + (should (cl-some (lambda (m) + (string-match-p "opening Magit for review" m)) + messages))))) (provide 'test-reconcile--pull-dirty) ;;; test-reconcile--pull-dirty.el ends here diff --git a/tests/test-reconcile--should-skip-p.el b/tests/test-reconcile--should-skip-p.el index 3e9c0177..8964fd3b 100644 --- a/tests/test-reconcile--should-skip-p.el +++ b/tests/test-reconcile--should-skip-p.el @@ -17,50 +17,58 @@ (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root))) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (if (string-match-p "remote.origin.url" cmd) - "git@github.com:user/repo.git" - "")) - (should-not (cj/reconcile--should-skip-p dir)))))) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "git@github.com:user/repo.git\n") + '(:exit 0 :output ""))) + (should-not (cj/reconcile--should-skip-p dir)))))) (ert-deftest test-should-skip-p-normal-http-remote-skipped () "HTTP remote repo should be skipped (reference clone)." (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root))) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (if (string-match-p "remote.origin.url" cmd) - "http://github.com/user/repo.git" - "")) - (should (cj/reconcile--should-skip-p dir)))))) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "http://github.com/user/repo.git\n") + '(:exit 0 :output ""))) + (should (cj/reconcile--should-skip-p dir)))))) (ert-deftest test-should-skip-p-normal-https-remote-skipped () "HTTPS remote repo should be skipped (reference clone)." (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root))) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (if (string-match-p "remote.origin.url" cmd) - "https://github.com/user/repo.git" - "")) - (should (cj/reconcile--should-skip-p dir)))))) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "https://github.com/user/repo.git\n") + '(:exit 0 :output ""))) + (should (cj/reconcile--should-skip-p dir)))))) + +(ert-deftest test-should-skip-p-normal-https-remote-not-skipped-when-policy-disabled () + "HTTPS remote repos can be included by disabling the skip regexp." + (reconcile-test-with-temp-dirs + ("repo/.git/") + (let ((dir (expand-file-name "repo" test-root)) + (cj/reconcile-skipped-remote-regexp nil)) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "https://github.com/user/repo.git\n") + '(:exit 0 :output ""))) + (should-not (cj/reconcile--should-skip-p dir)))))) (ert-deftest test-should-skip-p-normal-no-remote-skipped () "Local-only repo (no remote) should be skipped." (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root))) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (if (string-match-p "remote.origin.url" cmd) "" "")) - (should (cj/reconcile--should-skip-p dir)))))) + (reconcile-test-with-git-mock + (lambda (_args) '(:exit 1 :output "")) + (should (cj/reconcile--should-skip-p dir)))))) ;;; Boundary Cases @@ -76,26 +84,48 @@ (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root))) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (if (string-match-p "remote.origin.url" cmd) - "user@myserver.com:repos/project.git" - "")) - (should-not (cj/reconcile--should-skip-p dir)))))) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "user@myserver.com:repos/project.git\n") + '(:exit 0 :output ""))) + (should-not (cj/reconcile--should-skip-p dir)))))) (ert-deftest test-should-skip-p-boundary-ssh-protocol-url-not-skipped () "ssh:// protocol URL should NOT be skipped." (reconcile-test-with-temp-dirs ("repo/.git/") (let ((dir (expand-file-name "repo" test-root))) - (reconcile-test-with-shell-mocks - (lambda (_cmd) 0) - (lambda (cmd) - (if (string-match-p "remote.origin.url" cmd) - "ssh://git@github.com/user/repo.git" - "")) - (should-not (cj/reconcile--should-skip-p dir)))))) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "ssh://git@github.com/user/repo.git\n") + '(:exit 0 :output ""))) + (should-not (cj/reconcile--should-skip-p dir)))))) + +(ert-deftest test-should-skip-p-boundary-file-protocol-remote-not-skipped () + "file:// remote repo should NOT be skipped by the default policy." + (reconcile-test-with-temp-dirs + ("repo/.git/") + (let ((dir (expand-file-name "repo" test-root))) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "file:///srv/git/repo.git\n") + '(:exit 0 :output ""))) + (should-not (cj/reconcile--should-skip-p dir)))))) + +(ert-deftest test-should-skip-p-boundary-local-path-remote-not-skipped () + "Plain local path remote should NOT be skipped by the default policy." + (reconcile-test-with-temp-dirs + ("repo/.git/") + (let ((dir (expand-file-name "repo" test-root))) + (reconcile-test-with-git-mock + (lambda (args) + (if (equal args '("config" "--get" "remote.origin.url")) + '(:exit 0 :output "/srv/git/repo.git\n") + '(:exit 0 :output ""))) + (should-not (cj/reconcile--should-skip-p dir)))))) (provide 'test-reconcile--should-skip-p) ;;; test-reconcile--should-skip-p.el ends here diff --git a/tests/testutil-reconcile-open-repos.el b/tests/testutil-reconcile-open-repos.el index 2d8614eb..b81e1b48 100644 --- a/tests/testutil-reconcile-open-repos.el +++ b/tests/testutil-reconcile-open-repos.el @@ -2,7 +2,7 @@ ;;; Commentary: ;; Provides helper macros and functions for testing reconcile-open-repos. -;; Creates temporary directory trees with fake .git dirs and mocks shell commands. +;; Creates temporary directory trees with fake .git dirs and mocks git commands. ;;; Code: @@ -42,6 +42,36 @@ SHELL-CMD-TO-STR-FN receives (command) and returns a string." (lambda (cmd) (funcall ,shell-cmd-to-str-fn cmd)))) ,@body)) +(defvar reconcile-test-git-calls nil + "List of git argv lists observed during reconcile tests.") + +(defmacro reconcile-test-with-git-mock (handler &rest body) + "Run BODY with `process-file' mocked for git. +HANDLER receives the argv list and returns either an exit code integer or a +plist with :exit and :output." + (declare (indent 1)) + `(let ((reconcile-test-git-calls nil)) + (cl-letf (((symbol-function 'process-file) + (lambda (program _infile destination _display &rest args) + (unless (string= program "git") + (error "Unexpected program: %s" program)) + (push args reconcile-test-git-calls) + (let* ((result (funcall ,handler args)) + (plist-result (and (consp result) (keywordp (car result)))) + (exit (if plist-result (plist-get result :exit) result)) + (output (if plist-result (plist-get result :output) ""))) + (when (and destination output) + (let ((stdout-dest (if (consp destination) + (car destination) + destination))) + (cond + ((bufferp stdout-dest) + (with-current-buffer stdout-dest (insert output))) + ((eq stdout-dest t) + (insert output))))) + exit)))) + ,@body))) + (defvar reconcile-test-magit-calls nil "List of directories passed to magit-status during tests.") -- cgit v1.2.3