diff options
Diffstat (limited to 'tests/test-duet-transfer-exec.el')
| -rw-r--r-- | tests/test-duet-transfer-exec.el | 510 |
1 files changed, 510 insertions, 0 deletions
diff --git a/tests/test-duet-transfer-exec.el b/tests/test-duet-transfer-exec.el new file mode 100644 index 0000000..f93a4fa --- /dev/null +++ b/tests/test-duet-transfer-exec.el @@ -0,0 +1,510 @@ +;;; test-duet-transfer-exec.el --- Tests for the transfer execution engine -*- 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: + +;; Process-boundary tests for the Phase 5 transfer engine: the serial queue +;; and its concurrency limit, the bounded output filter, throttled log +;; rendering, terminal-result classification, coalesced pane refresh, +;; cancellation with cleanup verification, the failure explainer, and the +;; log-record schema. The process boundary is stubbed (a no-op launcher and +;; injected result plists), so no real subprocess runs here; real-rsync +;; coverage lives in test-integration-duet-transfer.el. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +;; A clean engine per test: fresh counters, empty queue/history, no live +;; timers, stall detection off (mark-stalled is exercised directly), a no-op +;; launcher so `duet--start-transfer' spawns nothing. Real render/refresh +;; timers created during a test are cancelled on exit so they never fire into +;; the next one. +(defmacro duet-test--with-clean-engine (&rest body) + (declare (indent 0)) + `(let ((duet--transfer-id-counter 0) + (duet--transfers nil) + (duet--transfer-queue nil) + (duet--log-render-timer nil) + (duet--refresh-pending nil) + (duet--refresh-timer nil) + (duet-transfer-stall-timeout nil) + (duet-max-concurrent-transfers 1) + (duet--transfer-launcher (lambda (_tr) nil))) + (unwind-protect (progn ,@body) + (when (timerp duet--log-render-timer) (cancel-timer duet--log-render-timer)) + (when (timerp duet--refresh-timer) (cancel-timer duet--refresh-timer))))) + +(defun duet-test--argv-spec (&rest overrides) + "A minimal runnable local rsync transfer-spec, with plist OVERRIDES applied." + (append overrides + (list :backend 'rsync :route :local + :sources '("/src/a.txt") + :destination-directory "/dst" + :argv '("rsync" "-a" "/src/a.txt" "/dst")))) + +;;; Transfer records and ids + +(ert-deftest test-duet-exec-make-transfer-assigns-monotonic-id () + (duet-test--with-clean-engine + (let ((a (duet--make-transfer (duet-test--argv-spec))) + (b (duet--make-transfer (duet-test--argv-spec)))) + (should (= 1 (duet-transfer-id a))) + (should (= 2 (duet-transfer-id b))) + (should (eq 'queued (duet-transfer-status a))) + (should (eq 'rsync (duet-transfer-backend a))) + (should (eq :local (duet-transfer-route a))) + (should (equal '("/src/") (duet-transfer-source-directories a)))))) + +;;; Queue + concurrency limit + +(ert-deftest test-duet-exec-queue-runs-one-at-a-time () + (duet-test--with-clean-engine + (let* ((duet-max-concurrent-transfers 1) + (a (duet--run-transfer (duet-test--argv-spec))) + (b (duet--run-transfer (duet-test--argv-spec)))) + (should (eq 'running (duet-transfer-status a))) + (should (eq 'queued (duet-transfer-status b))) + (duet--transfer-handle-result a '(:exit 0)) + (should (eq 'done (duet-transfer-status a))) + (should (eq 'running (duet-transfer-status b))) + (should (not (memq a duet--transfer-queue))) + (should (memq a duet--transfers))))) + +(ert-deftest test-duet-exec-queue-honors-max-concurrent () + (duet-test--with-clean-engine + (let ((duet-max-concurrent-transfers 2)) + (let ((a (duet--run-transfer (duet-test--argv-spec))) + (b (duet--run-transfer (duet-test--argv-spec))) + (c (duet--run-transfer (duet-test--argv-spec)))) + (should (eq 'running (duet-transfer-status a))) + (should (eq 'running (duet-transfer-status b))) + (should (eq 'queued (duet-transfer-status c))))))) + +(ert-deftest test-duet-exec-run-transfer-refuses-deferred-specs () + (duet-test--with-clean-engine + (should-error + (duet--run-transfer '(:backend tramp :route :local-remote :tramp t + :destination-directory "/dst")) + :type 'user-error) + (should-error + (duet--run-transfer '(:backend rsync :route :remote-roundtrip + :exec-mode rsync-remote-to-remote + :destination-directory "/dst")) + :type 'user-error))) + +;;; Bounded output filter + +(ert-deftest test-duet-exec-filter-bounds-retained-output () + (duet-test--with-clean-engine + (let ((duet-transfer-stderr-limit 10) + (tr (duet--make-transfer (duet-test--argv-spec)))) + (duet--transfer-filter tr "abcdefgh") + (duet--transfer-filter tr "ijklmnop") + (should (= 10 (length (duet-transfer-stderr tr)))) + (should (string= "ghijklmnop" (duet-transfer-stderr tr))) + (should (= 2 (duet-transfer-output-count tr))) + (should (= 16 (duet-transfer-stderr-bytes tr)))))) + +;;; Throttled log render + +(ert-deftest test-duet-exec-render-throttled-to-one-timer () + (duet-test--with-clean-engine + (let ((timer-calls 0)) + (cl-letf (((symbol-function 'run-with-timer) + (lambda (&rest _) (cl-incf timer-calls) 'fake-timer))) + (let ((tr (duet--make-transfer (duet-test--argv-spec)))) + (duet--transfer-filter tr "x") + (duet--transfer-filter tr "y") + (duet--transfer-filter tr "z") + (should (= 1 timer-calls)) + (should (eq 'fake-timer duet--log-render-timer))))))) + +(ert-deftest test-duet-exec-render-rearms-after-flush () + (duet-test--with-clean-engine + (let ((timer-calls 0)) + (cl-letf (((symbol-function 'run-with-timer) + (lambda (&rest _) (cl-incf timer-calls) 'fake-timer))) + (duet--schedule-log-render) + (should (= 1 timer-calls)) + (duet--render-transfer-log) + (should (null duet--log-render-timer)) + (duet--schedule-log-render) + (should (= 2 timer-calls)))))) + +;;; Stall flagging + +(ert-deftest test-duet-exec-stall-marks-and-recovers () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (should (eq 'running (duet-transfer-status tr))) + (duet--mark-stalled tr) + (should (eq 'stalled (duet-transfer-status tr))) + ;; a stalled transfer still occupies a slot + (should (memq tr (duet--running-transfers))) + (duet--transfer-filter tr "more output") + (should (eq 'running (duet-transfer-status tr)))))) + +(ert-deftest test-duet-exec-mark-stalled-only-when-running () + (duet-test--with-clean-engine + (let ((tr (duet--make-transfer (duet-test--argv-spec)))) + (setf (duet-transfer-status tr) 'done) + (duet--mark-stalled tr) + (should (eq 'done (duet-transfer-status tr)))))) + +;;; Terminal-result classification + +(ert-deftest test-duet-exec-handle-result-success () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--transfer-handle-result tr '(:exit 0)) + (should (eq 'done (duet-transfer-status tr))) + (should (null (duet-transfer-failure tr))) + (should (= 0 (duet-transfer-exit tr))) + (should (duet-transfer-cleanup-verified tr))))) + +(ert-deftest test-duet-exec-handle-result-nonzero-exit-normalizes () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (setf (duet-transfer-stderr tr) "rsync: mkstemp failed: Permission denied (13)") + (duet--transfer-handle-result tr '(:exit 23)) + (should (eq 'failed (duet-transfer-status tr))) + (should (eq 'permission-denied (plist-get (duet-transfer-failure tr) :class))) + (should (= 23 (duet-transfer-exit tr)))))) + +(ert-deftest test-duet-exec-handle-result-signal-fails () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--transfer-handle-result tr '(:signal 15)) + (should (eq 'failed (duet-transfer-status tr))) + (should (eq 'cancelled (plist-get (duet-transfer-failure tr) :class))) + (should (= 15 (duet-transfer-signal tr)))))) + +(ert-deftest test-duet-exec-handle-result-launch-error-fails () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--transfer-handle-result tr '(:launch-error "No such file or directory")) + (should (eq 'failed (duet-transfer-status tr))) + (should (eq 'launch-failure (plist-get (duet-transfer-failure tr) :class)))))) + +(ert-deftest test-duet-exec-start-transfer-launch-error-is-caught () + (duet-test--with-clean-engine + (let ((duet--transfer-launcher + (lambda (_tr) (error "boom: cannot spawn")))) + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (should (eq 'failed (duet-transfer-status tr))) + (should (eq 'launch-failure (plist-get (duet-transfer-failure tr) :class))))))) + +;;; Coalesced pane refresh + +(ert-deftest test-duet-exec-refresh-coalesced-to-one-timer () + (duet-test--with-clean-engine + (let ((timer-calls 0)) + (cl-letf (((symbol-function 'run-with-timer) + (lambda (&rest _) (cl-incf timer-calls) 'fake-timer))) + (duet--schedule-pane-refresh "/a") + (duet--schedule-pane-refresh "/a") + (duet--schedule-pane-refresh "/b") + (should (= 1 timer-calls)) + (should (= 2 (length duet--refresh-pending))) + (should (member "/a/" duet--refresh-pending)) + (should (member "/b/" duet--refresh-pending)))))) + +(ert-deftest test-duet-exec-success-schedules-dest-refresh () + (duet-test--with-clean-engine + (cl-letf (((symbol-function 'run-with-timer) (lambda (&rest _) 'fake-timer))) + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--transfer-handle-result tr '(:exit 0)) + (should (member "/dst/" duet--refresh-pending)))))) + +(ert-deftest test-duet-exec-move-success-schedules-source-and-dest () + (duet-test--with-clean-engine + (cl-letf (((symbol-function 'run-with-timer) (lambda (&rest _) 'fake-timer))) + (let ((tr (duet--run-transfer + (duet-test--argv-spec :sources '("/src/a.txt")) + t))) + (duet--transfer-handle-result tr '(:exit 0)) + (should (member "/dst/" duet--refresh-pending)) + (should (member "/src/" duet--refresh-pending)))))) + +;;; Cancellation + cleanup verification + +(ert-deftest test-duet-exec-cancel-transitions-to-cancelling () + (duet-test--with-clean-engine + (let ((killed nil)) + (cl-letf (((symbol-function 'duet--kill-process) + (lambda (_tr) (setq killed t)))) + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--cancel-transfer tr) + (should (eq 'cancelling (duet-transfer-status tr))) + (should killed)))))) + +(ert-deftest test-duet-exec-cancel-clean-temp-finishes-failed () + (duet-test--with-clean-engine + (let ((duet--temp-file-lister (lambda (_tr) nil))) + (cl-letf (((symbol-function 'duet--kill-process) #'ignore)) + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--cancel-transfer tr) + (duet--transfer-handle-result tr '(:signal 15)) + (should (eq 'failed (duet-transfer-status tr))) + (should (duet-transfer-cleanup-verified tr))))))) + +(ert-deftest test-duet-exec-cancel-stray-temp-flags-cleanup-unverified () + (duet-test--with-clean-engine + (let ((duet--temp-file-lister (lambda (_tr) '("/dst/.a.txt.AbCdEf")))) + (cl-letf (((symbol-function 'duet--kill-process) #'ignore)) + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--cancel-transfer tr) + (duet--transfer-handle-result tr '(:signal 15)) + (should (eq 'cleanup-unverified (duet-transfer-status tr))) + (should-not (duet-transfer-cleanup-verified tr))))))) + +(ert-deftest test-duet-exec-cancel-terminal-transfer-is-noop () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--transfer-handle-result tr '(:exit 0)) + (duet--cancel-transfer tr) + (should (eq 'done (duet-transfer-status tr)))))) + +;;; Failure explanation + +(ert-deftest test-duet-exec-format-failure-explanation () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (setf (duet-transfer-stderr tr) "rsync: Permission denied (13)") + (duet--transfer-handle-result tr '(:exit 23)) + (let ((s (duet--format-failure-explanation tr))) + (should (string-match-p "permission denied" s)) + (should (string-match-p "fix-permissions" s)) + (should (string-match-p "Source unchanged" s)))))) + +(ert-deftest test-duet-exec-format-explanation-success () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--transfer-handle-result tr '(:exit 0)) + (should (string-match-p "completed successfully" + (duet--format-failure-explanation tr)))))) + +;;; Log-record schema + +(ert-deftest test-duet-exec-log-record-schema () + (duet-test--with-clean-engine + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet--transfer-handle-result tr '(:exit 0)) + (let ((rec (duet--transfer-log-record tr))) + (should (= (duet-transfer-id tr) (plist-get rec :id))) + (should (eq 'rsync (plist-get rec :backend))) + (should (eq :local (plist-get rec :route))) + (should (stringp (plist-get rec :argv))) + (should (eq 'done (plist-get rec :status))))))) + +(ert-deftest test-duet-exec-log-record-redacts-argv () + (duet-test--with-clean-engine + (duet-register-backend + (duet-backend-create + :name 'secret-tool + :handles (lambda (_s _d) nil) + :command (lambda (_s _d _o) '(:argv ("x"))) + :redaction '("\\(--password=\\)\\S-+") + :cleanup :none)) + (let ((tr (duet--make-transfer + '(:backend secret-tool :route :local :destination-directory "/dst" + :argv ("tool" "--password=hunter2" "/dst"))))) + (let ((argv (plist-get (duet--transfer-log-record tr) :argv))) + (should (string-match-p "--password=<redacted>" argv)) + (should-not (string-match-p "hunter2" argv)))))) + +;;; Default stray-temp lister (real tmp dir, no subprocess) + +(ert-deftest test-duet-exec-list-stray-temp-files-matches-pattern () + (duet-test--with-clean-engine + (let ((dir (make-temp-file "duet-temp-" t))) + (unwind-protect + (progn + (write-region "" nil (expand-file-name ".a.txt.AbCdEf" dir)) + (write-region "" nil (expand-file-name "a.txt" dir)) + (let* ((tr (duet--make-transfer + (duet-test--argv-spec :destination-directory dir))) + (strays (duet--list-stray-temp-files tr))) + (should (= 1 (length strays))) + (should (string-match-p "\\.a\\.txt\\.AbCdEf\\'" (car strays))))) + (delete-directory dir t))))) + +;;; Thin interactive glue + +(ert-deftest test-duet-exec-submit-builds-and-runs () + (duet-test--with-clean-engine + (let ((tr (duet--submit-transfer '("/src/a.txt") "/dst" nil))) + (should (duet-transfer-p tr)) + (should (eq 'rsync (duet-transfer-backend tr))) + (should (member "/src/a.txt" (plist-get (duet-transfer-spec tr) :sources)))))) + +(ert-deftest test-duet-exec-submit-no-sources-errors () + (duet-test--with-clean-engine + (should-error (duet--submit-transfer nil "/dst" nil) :type 'user-error))) + +(ert-deftest test-duet-copy-and-move-submit-via-engine () + (duet-test--with-clean-engine + (cl-letf (((symbol-function 'dired-get-marked-files) (lambda (&rest _) '("/src/a.txt"))) + ((symbol-function 'duet--other-pane) (lambda (&rest _) 'win)) + ((symbol-function 'duet--pane-directory) (lambda (_w) "/dst")) + ((symbol-function 'display-buffer) (lambda (&rest _) nil))) + (duet-copy) + (should (= 1 (length duet--transfers))) + (should-not (duet-transfer-move-p (car duet--transfers))) + (duet-move) + (should (= 2 (length duet--transfers))) + (should (duet-transfer-move-p (car duet--transfers)))))) + +(ert-deftest test-duet-mkdir-creates-and-refreshes () + (duet-test--with-clean-engine + (let ((made nil)) + (cl-letf (((symbol-function 'make-directory) (lambda (d &rest _) (setq made d))) + ((symbol-function 'run-with-timer) (lambda (&rest _) 'fake-timer))) + (let ((default-directory "/work/")) + (duet-mkdir "newdir") + (should (string-match-p "newdir" made)) + (should (member "/work/" duet--refresh-pending))))))) + +(ert-deftest test-duet-delete-trashes-files-and-directories () + "Marked files go through `delete-file' and directories through +`delete-directory', both to trash, then the active pane refreshes." + (duet-test--with-clean-engine + (let ((trashed-files nil) (removed-dirs nil)) + (cl-letf (((symbol-function 'dired-get-marked-files) + (lambda (&rest _) '("/work/a.txt" "/work/sub"))) + ((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'file-directory-p) (lambda (f) (string= f "/work/sub"))) + ((symbol-function 'delete-file) (lambda (f &optional _trash) (push f trashed-files))) + ((symbol-function 'delete-directory) (lambda (d &rest _) (push d removed-dirs))) + ((symbol-function 'run-with-timer) (lambda (&rest _) 'fake-timer))) + (let ((default-directory "/work/")) + (duet-delete) + (should (member "/work/a.txt" trashed-files)) + (should (member "/work/sub" removed-dirs)) + (should (member "/work/" duet--refresh-pending))))))) + +(ert-deftest test-duet-cancel-transfer-command-no-active-errors () + (duet-test--with-clean-engine + (should-error (duet-cancel-transfer) :type 'user-error))) + +(ert-deftest test-duet-cancel-transfer-command-cancels-latest () + (duet-test--with-clean-engine + (cl-letf (((symbol-function 'duet--kill-process) #'ignore) + ((symbol-function 'message) (lambda (&rest _) nil))) + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (duet-cancel-transfer) + (should (eq 'cancelling (duet-transfer-status tr))))))) + +(ert-deftest test-duet-explain-transfer-failure-no-transfers-errors () + (duet-test--with-clean-engine + (should-error (duet-explain-transfer-failure) :type 'user-error))) + +(ert-deftest test-duet-explain-transfer-failure-shows-buffer () + (duet-test--with-clean-engine + (cl-letf (((symbol-function 'display-buffer) (lambda (b &rest _) b))) + (let ((tr (duet--run-transfer (duet-test--argv-spec)))) + (setf (duet-transfer-stderr tr) "rsync: Permission denied (13)") + (duet--transfer-handle-result tr '(:exit 23)) + (duet-explain-transfer-failure) + (with-current-buffer "*DUET Transfer Failure*" + (should (string-match-p "fix-permissions" (buffer-string)))))))) + +;;; Timer-arming and cancellation branches + +(ert-deftest test-duet-exec-arm-stall-timer-when-enabled () + (duet-test--with-clean-engine + (let ((duet-transfer-stall-timeout 60)) + (cl-letf (((symbol-function 'run-with-timer) (lambda (&rest _) 'armed))) + (let ((tr (duet--make-transfer (duet-test--argv-spec)))) + (duet--arm-stall-timer tr) + (should (eq 'armed (duet-transfer-stall-timer tr)))))))) + +(ert-deftest test-duet-exec-cancel-stall-timer-cancels-real-timer () + (duet-test--with-clean-engine + (let ((tr (duet--make-transfer (duet-test--argv-spec)))) + (setf (duet-transfer-stall-timer tr) (run-with-timer 100 nil #'ignore)) + (duet--cancel-stall-timer tr) + (should (null (duet-transfer-stall-timer tr)))))) + +(ert-deftest test-duet-exec-render-cancels-real-timer () + (duet-test--with-clean-engine + (setq duet--log-render-timer (run-with-timer 100 nil #'ignore)) + (duet--render-transfer-log) + (should (null duet--log-render-timer)))) + +;;; Pane-refresh execution + +(ert-deftest test-duet-exec-do-pane-refresh-clears-pending () + (duet-test--with-clean-engine + (let ((refreshed nil)) + (cl-letf (((symbol-function 'duet--refresh-dir) (lambda (d) (push d refreshed)))) + (setq duet--refresh-pending '("/x/" "/y/") + duet--refresh-timer (run-with-timer 100 nil #'ignore)) + (duet--do-pane-refresh) + (should (null duet--refresh-pending)) + (should (null duet--refresh-timer)) + (should (= 2 (length refreshed))))))) + +(ert-deftest test-duet-exec-refresh-dir-reverts-dired-buffer () + (duet-test--with-clean-engine + (let ((dir (make-temp-file "duet-refresh-" t))) + (unwind-protect + (let ((buf (dired-noselect dir))) + (unwind-protect + (progn + (duet--refresh-dir dir) + (should (buffer-live-p buf))) + (kill-buffer buf))) + (delete-directory dir t))))) + +;;; delete-source on a directory + +(ert-deftest test-duet-exec-delete-source-removes-directory () + (duet-test--with-clean-engine + (let ((dir (make-temp-file "duet-del-" t))) + (should (file-directory-p dir)) + (duet--delete-source dir) + (should-not (file-exists-p dir))))) + +;;; Safety-text variants + +(ert-deftest test-duet-exec-safety-text-variants () + (should (string= "ok" (duet--safety-text "ok"))) + (should (string-match-p "Outcome unverified" (duet--safety-text :generic))) + (should (string-match-p "Unknown" (duet--safety-text 'something-else)))) + +;;; submit with an empty backend registry + +(ert-deftest test-duet-exec-submit-no-backend-errors () + (duet-test--with-clean-engine + (let ((duet--backend-registry nil)) + (should-error (duet--submit-transfer '("/src/a.txt") "/dst" nil) + :type 'user-error)))) + +;;; delete edge cases + +(ert-deftest test-duet-delete-no-files-errors () + (duet-test--with-clean-engine + (cl-letf (((symbol-function 'dired-get-marked-files) (lambda (&rest _) nil))) + (let ((default-directory "/work/")) + (should-error (duet-delete) :type 'user-error))))) + +(provide 'test-duet-transfer-exec) +;;; test-duet-transfer-exec.el ends here |