;;; test-duet-safety.el --- Tests for the data-safety planner -*- 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:

;; Tests for the pure data-safety planner: same-file and dir-into-itself
;; rejection, trailing-slash destination resolution, symlink/special-file
;; surfacing, case-insensitive collision detection, path-length and
;; reserved-name checks, and the safety-composed move planner.  Every
;; filesystem fact is injected, so no test touches a real file.

;;; Code:

(require 'test-bootstrap (expand-file-name "test-bootstrap.el"))

;;; same-file

(ert-deftest test-duet-safety-same-file-rejected ()
  (should (eq 'same-file (plist-get (duet--check-same-file "/a/b" "/a/b") :class)))
  (should (eq 'same-file (plist-get (duet--check-same-file "/a/b/" "/a/b") :class)))
  (should (null (duet--check-same-file "/a/b" "/a/c"))))

;;; dir-into-itself

(ert-deftest test-duet-safety-dir-into-itself-rejected ()
  (should (eq 'destination-within-source
             (plist-get (duet--check-dir-into-itself "/a/b" "/a/b/sub") :class)))
  (should (null (duet--check-dir-into-itself "/a/b" "/a/c")))
  ;; a sibling whose name merely shares a prefix is not "inside"
  (should (null (duet--check-dir-into-itself "/a/b" "/a/bc"))))

;;; trailing-slash resolution

(ert-deftest test-duet-safety-resolved-destination ()
  (should (equal "/c/b" (duet--resolved-destination "/a/b" "/c")))
  (should (equal "/c/b" (duet--resolved-destination "/a/b" "/c/")))
  ;; a trailing slash on the source means "copy contents", landing in /c itself
  (should (equal "/c" (duet--resolved-destination "/a/b/" "/c"))))

;;; special files and symlinks

(ert-deftest test-duet-safety-special-file-rejected ()
  (should (eq 'unsupported-special-file
             (plist-get (duet--check-special-file "/dev/fifo" 'fifo) :class)))
  (should (null (duet--check-special-file "/a/f" 'file)))
  (should (null (duet--check-special-file "/a/d" 'directory)))
  (should (null (duet--check-special-file "/a/l" 'symlink)))
  (should (null (duet--check-special-file "/a/x" nil))))

(ert-deftest test-duet-safety-symlink-surfaced-as-warning ()
  (let ((p (duet--check-symlink "/a/link" 'symlink)))
    (should (eq 'symlink (plist-get p :class)))
    (should (eq 'warning (plist-get p :severity))))
  (should (null (duet--check-symlink "/a/f" 'file))))

;;; case-insensitive collisions

(ert-deftest test-duet-safety-case-collision ()
  (should (eq 'case-collision
             (plist-get (duet--check-case-collision "/b/Foo.txt" '("foo.txt") t) :class)))
  ;; case-sensitive filesystem: no collision
  (should (null (duet--check-case-collision "/b/Foo.txt" '("foo.txt") nil)))
  ;; no name differing only by case
  (should (null (duet--check-case-collision "/b/Foo.txt" '("bar.txt") t)))
  ;; an exact match is a normal conflict, not a case collision
  (should (null (duet--check-case-collision "/b/foo.txt" '("foo.txt") t))))

;;; path length and reserved names

(ert-deftest test-duet-safety-path-length ()
  (should (eq 'path-too-long (plist-get (duet--check-path-length "/very/long/path" 5) :class)))
  (should (null (duet--check-path-length "/short" 255)))
  (should (null (duet--check-path-length "/anything" nil))))

(ert-deftest test-duet-safety-reserved-name ()
  (let ((reserved-p (lambda (b) (member (upcase b) '("CON" "NUL")))))
    (should (eq 'reserved-name
               (plist-get (duet--check-reserved-name "/b/con" reserved-p) :class)))
    (should (null (duet--check-reserved-name "/b/notes.txt" reserved-p)))
    (should (null (duet--check-reserved-name "/b/con" nil)))))

;;; composite

(ert-deftest test-duet-safety-plan-clean-pair-has-no-problems ()
  (should (null (duet--plan-safety "/a/f" "/b/f"
                                   (list :file-type (lambda (_) 'file))))))

(ert-deftest test-duet-safety-plan-detects-case-collision-via-caps ()
  "The composite invokes the injected existing-names and case-fold predicates."
  (let ((caps (list :file-type (lambda (_) 'file)
                    :existing-names (lambda (_) '("foo.txt"))
                    :case-insensitive (lambda (_) t))))
    (should (cl-some (lambda (p) (eq 'case-collision (plist-get p :class)))
                     (duet--plan-safety "/a/Foo.txt" "/b/Foo.txt" caps)))))

(ert-deftest test-duet-safety-plan-collects-multiple-problems ()
  "A pair tripping several checks reports each problem."
  (let* ((caps (list :file-type (lambda (_) 'fifo)
                     :max-path-length 3))
         (problems (duet--plan-safety "/a/b" "/a/b" caps))
         (classes (mapcar (lambda (p) (plist-get p :class)) problems)))
    (should (memq 'same-file classes))
    (should (memq 'unsupported-special-file classes))
    (should (memq 'path-too-long classes))))

;;; safety-composed move planner

(ert-deftest test-duet-safety-move-skips-unsafe-source ()
  "A source with a blocking safety error is skipped: no copy, no delete."
  (let* ((caps (list :file-type (lambda (_) 'fifo)))
         (plan (duet--plan-move-safe '("/a/pipe") "/b" caps)))
    (should (= 1 (length plan)))
    (should (eq 'skip (plist-get (car plan) :op)))
    (should-not (cl-some (lambda (s) (eq 'delete (plist-get s :op))) plan))))

(ert-deftest test-duet-safety-move-clean-source-copies-then-gated-delete ()
  "A safe source gets a copy plus a delete gated on copy success."
  (let* ((caps (list :file-type (lambda (_) 'file)))
         (plan (duet--plan-move-safe '("/a/f") "/b" caps)))
    (should (eq 'copy (plist-get (nth 0 plan) :op)))
    (should (eq 'delete (plist-get (nth 1 plan) :op)))
    (should (eq 'copy-success (plist-get (nth 1 plan) :gate)))))

(ert-deftest test-duet-safety-move-never-emits-ungated-delete ()
  "Across safe and unsafe sources, no delete step lacks the copy-success gate."
  (let* ((caps (list :file-type (lambda (p) (if (string-match-p "pipe" p) 'fifo 'file))))
         (plan (duet--plan-move-safe '("/a/f" "/a/pipe" "/a/g") "/b" caps)))
    (should-not (cl-some (lambda (s) (and (eq 'delete (plist-get s :op))
                                          (not (plist-get s :gate))))
                         plan))))

(provide 'test-duet-safety)
;;; test-duet-safety.el ends here