diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-duet-safety.el | 141 |
1 files changed, 141 insertions, 0 deletions
diff --git a/tests/test-duet-safety.el b/tests/test-duet-safety.el new file mode 100644 index 0000000..450a8ea --- /dev/null +++ b/tests/test-duet-safety.el @@ -0,0 +1,141 @@ +;;; 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-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 |