path: root/tests/test-duet-transfer-exec.el

;;; 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