1 files changed, 141 insertions, 0 deletions
diff --git a/tests/test-system-lib-confirm-destructive.el b/tests/test-system-lib-confirm-destructive.el
new file mode 100644
index 00000000..4fc96e21
--- /dev/null
+++ b/tests/test-system-lib-confirm-destructive.el
@@ -0,0 +1,141 @@
+;;; test-system-lib-confirm-destructive.el --- Tests for cj/confirm-destructive -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; ERT tests for `cj/confirm-destructive', the confirmation used for
+;; irreversible actions: file destruction, overwrites, power-off.
+;;
+;; The contract has two halves, and they pull against each other:
+;;
+;; 1. One keystroke.  This replaced a typed-"yes" prompt on 2026-07-31, after
+;;    one became unanswerable -- a second agent session held the selected
+;;    window while the prompt waited in another frame, so keystrokes went to a
+;;    terminal and the Emacs session had to be killed with buffers unsaved.  A
+;;    long-form prompt is only as safe as it is answerable.
+;;
+;; 2. No default.  Only y and n answer.  A stray RET or space re-prompts
+;;    instead of confirming, which is the accidental-confirm protection the
+;;    long form existed for, and it survives the change.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+(require 'system-lib)
+
+;;; Normal Cases
+
+(ert-deftest test-system-lib-confirm-destructive-returns-t-on-y ()
+  "Normal: a y answer confirms."
+  (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y)))
+    (should (eq (cj/confirm-destructive "Really? ") t))))
+
+(ert-deftest test-system-lib-confirm-destructive-returns-nil-on-n ()
+  "Normal: an n answer declines."
+  (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?n)))
+    (should (eq (cj/confirm-destructive "Really? ") nil))))
+
+;;; Boundary Cases
+
+(ert-deftest test-system-lib-confirm-destructive-accepts-uppercase ()
+  "Boundary: a capital Y confirms and a capital N declines, so the answer
+does not depend on the shift key or caps lock."
+  (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?Y)))
+    (should (eq (cj/confirm-destructive "Really? ") t)))
+  (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?N)))
+    (should (eq (cj/confirm-destructive "Really? ") nil))))
+
+(ert-deftest test-system-lib-confirm-destructive-offers-only-y-and-n ()
+  "Boundary: RET, space and every other key are refused.
+
+This is the protection that justified the old typed-\"yes\" form, kept now
+that the answer is a single keystroke.  Asserted on the character set handed
+to `read-char-choice', which is what actually decides, rather than on the
+prompt text, which only describes."
+  (let (chars)
+    (cl-letf (((symbol-function 'read-char-choice)
+               (lambda (_prompt cs &rest _) (setq chars cs) ?n)))
+      (cj/confirm-destructive "Really? "))
+    (should (equal (sort (copy-sequence chars) #'<) '(?N ?Y ?n ?y)))
+    (should-not (memq ?\r chars))
+    (should-not (memq ?\n chars))
+    (should-not (memq ?\s chars))))
+
+(ert-deftest test-system-lib-confirm-destructive-is-single-keystroke ()
+  "Boundary: it never routes through `yes-or-no-p'.
+
+The regression this file guards.  Binding `use-short-answers' to nil for the
+call, which is what the old implementation did, is exactly the shape that
+produced an unanswerable prompt."
+  (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y))
+            ((symbol-function 'yes-or-no-p)
+             (lambda (&rest _) (error "must not demand a typed yes"))))
+    (should (eq (cj/confirm-destructive "Really? ") t))))
+
+(ert-deftest test-system-lib-confirm-destructive-ignores-short-answer-setting ()
+  "Boundary: the answer is one key whether or not `use-short-answers' is set.
+The global default is t, but nothing about this prompt should depend on it."
+  (dolist (setting '(t nil))
+    (let ((use-short-answers setting))
+      (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ?y))
+                ((symbol-function 'yes-or-no-p)
+                 (lambda (&rest _) (error "must not demand a typed yes"))))
+        (should (eq (cj/confirm-destructive "Really? ") t))))))
+
+(ert-deftest test-system-lib-confirm-destructive-discards-type-ahead ()
+  "Boundary: pending input is discarded before the key is read.
+
+The regression that made this necessary.  `read-char-choice' reads the input
+queue, so a key typed before the prompt appeared would answer it: a queued y
+would confirm a shutdown or a file deletion instantly.  The typed-\"yes\"
+form absorbed such a key harmlessly, so dropping it without this guard would
+have traded a rare annoyance for a rare catastrophe.
+
+Asserted on ordering, since that is the whole property: the discard has to
+happen before the read, not merely somewhere in the function."
+  (let ((events '()))
+    (cl-letf (((symbol-function 'discard-input)
+               (lambda (&rest _) (push 'discard events) nil))
+              ((symbol-function 'read-char-choice)
+               (lambda (&rest _) (push 'read events) ?y)))
+      (should (eq (cj/confirm-destructive "Really? ") t)))
+    (should (equal (nreverse events) '(discard read)))))
+
+;;; Error Cases
+
+(ert-deftest test-system-lib-confirm-destructive-declines-on-other-char ()
+  "Error: anything that is not y or n declines rather than confirming.
+
+`read-char-choice' normally loops until it gets a listed character, but it
+can return outside the set -- `read-char-from-minibuffer' yields RET when the
+minibuffer result is empty.  On an irreversible action the safe reading of an
+unexpected answer is no."
+  (dolist (ch (list ?\r ?\n ?\s ?q ?\C-m))
+    (cl-letf (((symbol-function 'read-char-choice) (lambda (&rest _) ch)))
+      (should-not (cj/confirm-destructive "Really? ")))))
+
+(ert-deftest test-system-lib-confirm-destructive-propagates-quit ()
+  "Error: C-g aborts the caller rather than reading as a confirmation.
+Swallowing the quit here would turn an abort into a yes on an irreversible
+action."
+  (cl-letf (((symbol-function 'read-char-choice)
+             (lambda (&rest _) (signal 'quit nil))))
+    ;; `should-error' cannot express this: quit is not an error, so ERT lets
+    ;; it through and reports the test as QUIT rather than passed.  Catching
+    ;; it here is what makes the assertion a real pass or fail.
+    (should (eq 'quit (condition-case nil
+                          (progn (cj/confirm-destructive "Really? ")
+                                 'returned-normally)
+                        (quit 'quit))))))
+
+(ert-deftest test-system-lib-confirm-destructive-prompt-shows-choices ()
+  "Error: the prompt names the keys that answer, so an unfamiliar prompt is
+not a guessing game."
+  (let (prompt)
+    (cl-letf (((symbol-function 'read-char-choice)
+               (lambda (p &rest _) (setq prompt p) ?n)))
+      (cj/confirm-destructive "Delete everything? "))
+    (should (string-match-p "Delete everything\\?" prompt))
+    (should (string-match-p "y or n" prompt))))
+
+(provide 'test-system-lib-confirm-destructive)
+;;; test-system-lib-confirm-destructive.el ends here