diff options
| -rw-r--r-- | modules/reconcile-open-repos.el | 200 | ||||
| -rw-r--r-- | tests/test-reconcile--check-for-open-work.el | 14 | ||||
| -rw-r--r-- | tests/test-reconcile--find-git-repos.el | 22 | ||||
| -rw-r--r-- | tests/test-reconcile--git-directory.el | 63 | ||||
| -rw-r--r-- | tests/test-reconcile--pull-clean.el | 32 | ||||
| -rw-r--r-- | tests/test-reconcile--pull-dirty.el | 105 | ||||
| -rw-r--r-- | tests/test-reconcile--should-skip-p.el | 110 | ||||
| -rw-r--r-- | 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.") |