diff options
| author | Craig Jennings <c@cjennings.net> | 2026-05-10 02:44:10 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-05-10 02:44:10 -0500 |
| commit | 5a46d415df75b8b0168e2cf48b30fe463c01a77c (patch) | |
| tree | 72c1f8d75b2fb4a020a46f4d3b97778ca65fb331 /tests | |
| parent | 2afb005af6272b1b4229b377db0423dca045732f (diff) | |
| download | dotemacs-5a46d415df75b8b0168e2cf48b30fe463c01a77c.tar.gz dotemacs-5a46d415df75b8b0168e2cf48b30fe463c01a77c.zip | |
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.
Diffstat (limited to 'tests')
| -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 |
7 files changed, 214 insertions, 164 deletions
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.") |
