1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
;;; 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
|
