diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/test-coverage-core--relativize-keys.el | 123 | ||||
| -rw-r--r-- | tests/test-dirvish-config-popup.el | 248 | ||||
| -rw-r--r-- | tests/test-jumper--register-hygiene.el | 179 |
3 files changed, 550 insertions, 0 deletions
diff --git a/tests/test-coverage-core--relativize-keys.el b/tests/test-coverage-core--relativize-keys.el new file mode 100644 index 000000000..82031cd15 --- /dev/null +++ b/tests/test-coverage-core--relativize-keys.el @@ -0,0 +1,123 @@ +;;; test-coverage-core--relativize-keys.el --- Tests for path-key normalization -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit + integration tests for `cj/--coverage-relativize-keys', the helper +;; that normalizes a file-path-keyed coverage table to repo-relative paths. +;; +;; The bug it fixes: `cj/--coverage-parse-simplecov' returns ABSOLUTE path +;; keys (simplecov/undercover emit absolute source paths), while +;; `cj/--coverage-parse-diff-output' returns repo-RELATIVE keys (git's +;; "+++ b/<path>"). `cj/--coverage-intersect' joins the two by exact string +;; key, so for the diff-aware scopes every changed file was classified +;; ":tracked nil" — zero matches ever. Normalizing both tables to +;; repo-relative before the intersect makes the join work. +;; +;; The integration test drives the real parsers (a simplecov JSON fixture +;; with an absolute key + a git-diff string with the relative key) through +;; relativize + intersect, and asserts the file is tracked with the right +;; covered/uncovered split — the end-to-end reproduction of the bug. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'coverage-core) + +(defun test-coverage-relativize--hash-of-lines (pairs) + "Build a file → line-set hash table from PAIRS. +Each pair is (FILE . (LINES...)); LINES becomes a hash-table of line → t." + (let ((result (make-hash-table :test 'equal))) + (dolist (pair pairs) + (let ((lines (make-hash-table :test 'eql))) + (dolist (line (cdr pair)) + (puthash line t lines)) + (puthash (car pair) lines result))) + result)) + +;;; Normal cases + +(ert-deftest test-coverage-relativize-absolute-key-made-relative () + "Normal: an absolute key is relativized against ROOT." + (let* ((table (test-coverage-relativize--hash-of-lines + '(("/home/u/.emacs.d/modules/foo.el" 10 11)))) + (out (cj/--coverage-relativize-keys table "/home/u/.emacs.d"))) + (should (gethash "modules/foo.el" out)) + (should (null (gethash "/home/u/.emacs.d/modules/foo.el" out))))) + +(ert-deftest test-coverage-relativize-preserves-line-set () + "Normal: the line-set value travels unchanged to the new key." + (let* ((table (test-coverage-relativize--hash-of-lines + '(("/r/modules/foo.el" 4 8 15)))) + (out (cj/--coverage-relativize-keys table "/r")) + (lines (gethash "modules/foo.el" out))) + (should (hash-table-p lines)) + (should (gethash 4 lines)) + (should (gethash 8 lines)) + (should (gethash 15 lines)))) + +;;; Boundary cases + +(ert-deftest test-coverage-relativize-already-relative-unchanged () + "Boundary: an already-relative key is left as-is, not re-relativized." + (let* ((table (test-coverage-relativize--hash-of-lines + '(("modules/foo.el" 1 2)))) + (out (cj/--coverage-relativize-keys table "/home/u/.emacs.d"))) + (should (gethash "modules/foo.el" out)) + (should (= 1 (hash-table-count out))))) + +(ert-deftest test-coverage-relativize-empty-table () + "Boundary: an empty table yields an empty table." + (let ((out (cj/--coverage-relativize-keys (make-hash-table :test 'equal) "/r"))) + (should (hash-table-p out)) + (should (= 0 (hash-table-count out))))) + +;;; Error cases + +(ert-deftest test-coverage-relativize-nil-table-returns-empty () + "Error: a nil table returns an empty table rather than erroring." + (let ((out (cj/--coverage-relativize-keys nil "/r"))) + (should (hash-table-p out)) + (should (= 0 (hash-table-count out))))) + +;;; Integration — the real bug reproduction + +(ert-deftest test-coverage-integration-absolute-report-relative-diff-tracks () + "Integration: a simplecov report (absolute keys) and a git diff (relative +keys) for the same file intersect as TRACKED once both are relativized. +This is the diff-aware-scope bug: without normalization the file reads +\":tracked nil\"." + (let* ((root "/tmp/cov-root") + (abs-path (concat root "/modules/foo.el")) + (report (make-temp-file "cov-report-" nil ".json")) + (diff (concat + "diff --git a/modules/foo.el b/modules/foo.el\n" + "index 1111111..2222222 100644\n" + "--- a/modules/foo.el\n" + "+++ b/modules/foo.el\n" + "@@ -2,0 +2,3 @@\n" + "+line two\n" + "+line three\n" + "+line four\n"))) + (unwind-protect + (progn + ;; simplecov array: index1=null, 2=hit, 3=0-hits, 4=hit + ;; → covered lines {2, 4} + (with-temp-file report + (insert (format "{\"t\":{\"coverage\":{%S:[null,1,0,2]}}}" abs-path))) + (let* ((covered (cj/--coverage-relativize-keys + (cj/--coverage-parse-simplecov report) root)) + (changed (cj/--coverage-relativize-keys + (cj/--coverage-parse-diff-output diff) root)) + (records (cj/--coverage-intersect covered changed)) + (record (car records))) + (should (= 1 (length records))) + (should (equal "modules/foo.el" (plist-get record :path))) + (should (eq t (plist-get record :tracked))) + (should (equal '(2 3 4) (plist-get record :changed-lines))) + (should (equal '(2 4) (plist-get record :covered-lines))) + (should (equal '(3) (plist-get record :uncovered-lines))))) + (delete-file report)))) + +(provide 'test-coverage-core--relativize-keys) +;;; test-coverage-core--relativize-keys.el ends here diff --git a/tests/test-dirvish-config-popup.el b/tests/test-dirvish-config-popup.el new file mode 100644 index 000000000..2bd3a192c --- /dev/null +++ b/tests/test-dirvish-config-popup.el @@ -0,0 +1,248 @@ +;;; test-dirvish-config-popup.el --- Dirvish Hyprland popup tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the Hyprland Super+F dirvish popup. The launcher opens an +;; emacsclient frame named "dirvish" (window rules float/size/center it by that +;; name) and runs `cj/dirvish-popup', which opens Dirvish rooted at home. `q' +;; runs `cj/dirvish-popup-quit': in the popup frame it quits Dirvish and deletes +;; the frame; in any other frame it quits Dirvish normally. Covered here: frame +;; discovery by name, the emacsclient focus race on open, and the quit dispatch +;; on every frame condition. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'dirvish-config) + +;;; cj/--dirvish-popup-frame (find the popup frame by name) + +(ert-deftest test-dirvish-config-popup-frame-found () + "Normal: returns the live frame whose name is \"dirvish\"." + (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fb fc))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'frame-parameter) + (lambda (f _p) (if (eq f 'fb) "dirvish" "other")))) + (should (eq (cj/--dirvish-popup-frame) 'fb)))) + +(ert-deftest test-dirvish-config-popup-frame-none () + "Boundary: no popup frame present yields nil." + (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fc))) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'frame-parameter) (lambda (_f _p) "other"))) + (should-not (cj/--dirvish-popup-frame)))) + +(ert-deftest test-dirvish-config-popup-frame-skips-dead () + "Boundary: a dead frame named \"dirvish\" is skipped." + (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fb))) + ((symbol-function 'frame-live-p) (lambda (f) (not (eq f 'fb)))) + ((symbol-function 'frame-parameter) (lambda (_f _p) "dirvish"))) + (should (eq (cj/--dirvish-popup-frame) 'fa)))) + +;;; cj/dirvish-popup (open dirvish in the named frame) + +(ert-deftest test-dirvish-config-popup-selects-named-frame () + "Integration: cj/dirvish-popup focuses the \"dirvish\" frame found by name, +not whatever frame happens to be selected (the emacsclient -c focus race). + +Components integrated: +- cj/dirvish-popup (real) +- cj/--dirvish-popup-frame (MOCKED — returns a sentinel frame) +- select-frame-set-input-focus (MOCKED — records the focused frame) +- dirvish (MOCKED — records the path opened)" + (let ((focused nil) (opened nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup-frame)) + ((symbol-function 'select-frame-set-input-focus) + (lambda (f &rest _) (setq focused f))) + ((symbol-function 'dirvish) (lambda (&optional p) (setq opened (or p t))))) + (cj/dirvish-popup)) + (should (eq focused 'popup-frame)) + (should opened))) + +(ert-deftest test-dirvish-config-popup-no-frame-still-opens () + "Integration: with no popup frame found, cj/dirvish-popup skips the focus call +and still opens Dirvish (no error)." + (let ((focused 'unset) (opened nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () nil)) + ((symbol-function 'select-frame-set-input-focus) + (lambda (f &rest _) (setq focused f))) + ((symbol-function 'dirvish) (lambda (&optional _p) (setq opened t)))) + (cj/dirvish-popup)) + (should (eq focused 'unset)) + (should opened))) + +;;; cj/dirvish-popup-quit (quit; delete the popup frame only when in it) + +(ert-deftest test-dirvish-config-popup-quit-in-popup-deletes-frame () + "Normal: in the popup frame, q quits Dirvish and deletes the popup frame." + (let ((quit 0) (deleted nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'selected-frame) (lambda () 'popup)) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'dirvish-quit) (lambda () (cl-incf quit))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/dirvish-popup-quit)) + (should (= quit 1)) + (should (eq deleted 'popup)))) + +(ert-deftest test-dirvish-config-popup-quit-normal-frame-keeps-frame () + "Boundary: with no popup frame, q quits Dirvish and deletes nothing." + (let ((quit 0) (deleted 'unset)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () nil)) + ((symbol-function 'selected-frame) (lambda () 'main)) + ((symbol-function 'dirvish-quit) (lambda () (cl-incf quit))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/dirvish-popup-quit)) + (should (= quit 1)) + (should (eq deleted 'unset)))) + +(ert-deftest test-dirvish-config-popup-quit-popup-not-selected-keeps-frame () + "Boundary: the popup exists but a different frame is selected — q quits Dirvish +in that frame and does not delete the popup." + (let ((quit 0) (deleted 'unset)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'selected-frame) (lambda () 'main)) + ((symbol-function 'dirvish-quit) (lambda () (cl-incf quit))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/dirvish-popup-quit)) + (should (= quit 1)) + (should (eq deleted 'unset)))) + +(ert-deftest test-dirvish-config-popup-quit-survives-dirvish-quit-error () + "Error: a signal from dirvish-quit in the popup still deletes the frame." + (let ((deleted nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'selected-frame) (lambda () 'popup)) + ((symbol-function 'frame-live-p) (lambda (_f) t)) + ((symbol-function 'dirvish-quit) (lambda () (error "boom"))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/dirvish-popup-quit)) + (should (eq deleted 'popup)))) + +;;; cj/dirvish-popup-focus-existing (second-launch re-use guard) + +(ert-deftest test-dirvish-config-popup-focus-existing-found () + "Normal: an existing popup is focused and t is returned." + (let ((focused nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'select-frame-set-input-focus) + (lambda (f &rest _) (setq focused f)))) + (should (eq (cj/dirvish-popup-focus-existing) t)) + (should (eq focused 'popup))))) + +(ert-deftest test-dirvish-config-popup-focus-existing-none () + "Boundary: no popup present — returns nil and focuses nothing." + (let ((focused 'unset)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () nil)) + ((symbol-function 'select-frame-set-input-focus) + (lambda (f &rest _) (setq focused f)))) + (should-not (cj/dirvish-popup-focus-existing)) + (should (eq focused 'unset))))) + +;;; cj/--dirvish-popup-selected-p + +(ert-deftest test-dirvish-config-popup-selected-p-true () + "Normal: true when the selected frame is the popup frame." + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'selected-frame) (lambda () 'popup))) + (should (cj/--dirvish-popup-selected-p)))) + +(ert-deftest test-dirvish-config-popup-selected-p-false-other-frame () + "Boundary: false when a different frame is selected." + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'selected-frame) (lambda () 'main))) + (should-not (cj/--dirvish-popup-selected-p)))) + +(ert-deftest test-dirvish-config-popup-selected-p-false-no-popup () + "Boundary: false when no popup frame exists." + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () nil)) + ((symbol-function 'selected-frame) (lambda () 'main))) + (should-not (cj/--dirvish-popup-selected-p)))) + +;;; cj/dirvish-popup-find-file (popup = launcher; outside = plain find-file) + +(ert-deftest test-dirvish-config-popup-find-file-in-popup-file-launches-external () + "Normal: in the popup, a file at point opens via cj/xdg-open, not in-frame." + (let ((opened nil) (visited nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-selected-p) (lambda () t)) + ((symbol-function 'dired-get-file-for-visit) (lambda () "/tmp/a.mp4")) + ((symbol-function 'file-directory-p) (lambda (_f) nil)) + ((symbol-function 'cj/xdg-open) (lambda (f) (setq opened f))) + ((symbol-function 'dired-find-file) (lambda () (setq visited t)))) + (cj/dirvish-popup-find-file)) + (should (equal opened "/tmp/a.mp4")) + (should-not visited))) + +(ert-deftest test-dirvish-config-popup-find-file-in-popup-dir-navigates () + "Boundary: in the popup, a directory at point is entered normally." + (let ((opened nil) (visited nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-selected-p) (lambda () t)) + ((symbol-function 'dired-get-file-for-visit) (lambda () "/tmp/dir/")) + ((symbol-function 'file-directory-p) (lambda (_f) t)) + ((symbol-function 'cj/xdg-open) (lambda (f) (setq opened f))) + ((symbol-function 'dired-find-file) (lambda () (setq visited t)))) + (cj/dirvish-popup-find-file)) + (should visited) + (should-not opened))) + +(ert-deftest test-dirvish-config-popup-find-file-outside-popup-is-plain-find-file () + "Boundary: outside the popup, behaves exactly like dired-find-file." + (let ((opened nil) (visited nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-selected-p) (lambda () nil)) + ((symbol-function 'cj/xdg-open) (lambda (f) (setq opened f))) + ((symbol-function 'dired-find-file) (lambda () (setq visited t)))) + (cj/dirvish-popup-find-file)) + (should visited) + (should-not opened))) + +;;; cj/--dirvish-popup-focus-watch (dismiss on focus loss, armed after focus) + +(ert-deftest test-dirvish-config-popup-focus-watch-focused-arms-flag () + "Normal: while the popup is focused, the watch sets the had-focus flag and +deletes nothing." + (let ((params '()) (deleted nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'frame-focus-state) (lambda (_f) t)) + ((symbol-function 'frame-parameter) (lambda (_f p) (plist-get params p))) + ((symbol-function 'set-frame-parameter) + (lambda (_f p v) (setq params (plist-put params p v)))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/--dirvish-popup-focus-watch)) + (should (plist-get params 'cj-dirvish-popup-had-focus)) + (should-not deleted))) + +(ert-deftest test-dirvish-config-popup-focus-watch-unfocused-after-arming-deletes () + "Normal: lost focus after having held it — the popup is deleted." + (let ((params (list 'cj-dirvish-popup-had-focus t)) (deleted nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'frame-focus-state) (lambda (_f) nil)) + ((symbol-function 'frame-parameter) (lambda (_f p) (plist-get params p))) + ((symbol-function 'set-frame-parameter) + (lambda (_f p v) (setq params (plist-put params p v)))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/--dirvish-popup-focus-watch)) + (should (eq deleted 'popup)))) + +(ert-deftest test-dirvish-config-popup-focus-watch-unfocused-before-arming-keeps () + "Boundary: not focused and never armed (the creation race) — NOT deleted." + (let ((params '()) (deleted nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () 'popup)) + ((symbol-function 'frame-focus-state) (lambda (_f) nil)) + ((symbol-function 'frame-parameter) (lambda (_f p) (plist-get params p))) + ((symbol-function 'set-frame-parameter) + (lambda (_f p v) (setq params (plist-put params p v)))) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/--dirvish-popup-focus-watch)) + (should-not deleted))) + +(ert-deftest test-dirvish-config-popup-focus-watch-no-popup-is-noop () + "Error: with no popup frame, the watch does nothing and doesn't raise." + (let ((deleted nil)) + (cl-letf (((symbol-function 'cj/--dirvish-popup-frame) (lambda () nil)) + ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) + (cj/--dirvish-popup-focus-watch)) + (should-not deleted))) + +(provide 'test-dirvish-config-popup) +;;; test-dirvish-config-popup.el ends here diff --git a/tests/test-jumper--register-hygiene.el b/tests/test-jumper--register-hygiene.el new file mode 100644 index 000000000..8fc430ac5 --- /dev/null +++ b/tests/test-jumper--register-hygiene.el @@ -0,0 +1,179 @@ +;;; test-jumper--register-hygiene.el --- Tests for jumper register hygiene -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for three related jumper.el defects from the 2026-06 config audit: +;; +;; 1. Register collisions on removal — removal shifted the vector but never +;; freed the dropped register char, and a later store allocated by +;; `jumper--next-index' (a char a surviving slot might still hold), +;; silently overwriting that slot's marker. Store now allocates the first +;; free char in the live slice; removal clears the freed register. +;; 2. Dead-marker errors — `jumper--with-marker-at' guarded `markerp' but not +;; buffer liveness, so after the buffer holding a location was killed, +;; store/jump signaled wrong-type errors. Dead entries are now skipped. +;; 3. Single-location toggle never toggled back — the `already-there' branch +;; did nothing; it now jumps to the last-location register when set. + +;;; Code: + +(require 'ert) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'jumper) + +(defvar test-jumper-hyg--orig-registers nil) +(defvar test-jumper-hyg--orig-index nil) + +(defun test-jumper-hyg-setup () + "Reset jumper state and the registers it uses to a clean slate." + (setq test-jumper-hyg--orig-registers jumper--registers) + (setq test-jumper-hyg--orig-index jumper--next-index) + (setq jumper--registers (make-vector jumper-max-locations nil)) + (setq jumper--next-index 0) + (dotimes (i jumper-max-locations) + (set-register (+ ?0 i) nil)) + (set-register jumper--last-location-register nil)) + +(defun test-jumper-hyg-teardown () + "Restore jumper state." + (setq jumper--registers test-jumper-hyg--orig-registers) + (setq jumper--next-index test-jumper-hyg--orig-index)) + +;;; Defect 1 — register collisions on removal + +(ert-deftest test-jumper-hyg-store-after-remove-reuses-freed-register () + "Normal: storing after a removal reuses the freed char, not next-index. +Removing index 0 of [0 1 2] leaves the live slice holding chars 1 and 2; +the next store must take the freed char 0, never 2 (which slot 1 still holds)." + (test-jumper-hyg-setup) + (unwind-protect + (with-temp-buffer + (insert "line 1\nline 2\nline 3\nline 4") + (goto-char (point-min)) + (jumper--do-store-location) ; ?0 @ line 1 + (forward-line 1) (jumper--do-store-location) ; ?1 @ line 2 + (forward-line 1) (jumper--do-store-location) ; ?2 @ line 3 + (jumper--do-remove-location 0) ; live slice now [?1 ?2] + (forward-line 1) ; line 4 + (let ((reg (jumper--do-store-location))) + (should (= reg ?0)) ; freed char reused + (should (= (aref jumper--registers 2) ?0)) + (should (= jumper--next-index 3)))) + (test-jumper-hyg-teardown))) + +(ert-deftest test-jumper-hyg-store-after-remove-preserves-survivor () + "Normal: the surviving slot's marker is not clobbered by the reused store. +After removing index 0 and storing a new location, jumping to the slot that +holds the old top register must still land on its original line." + (test-jumper-hyg-setup) + (unwind-protect + (with-temp-buffer + (insert "line 1\nline 2\nline 3\nline 4") + (goto-char (point-min)) + (jumper--do-store-location) ; ?0 @ line 1 + (forward-line 1) (jumper--do-store-location) ; ?1 @ line 2 + (let ((line3 (progn (forward-line 1) (point)))) + (jumper--do-store-location) ; ?2 @ line 3 + (jumper--do-remove-location 0) ; slot1 now holds ?2 @ line3 + (goto-char (point-max)) (jumper--do-store-location) ; reuse ?0 + (goto-char (point-min)) + (jumper--do-jump-to-location 1) ; slot1 = old line-3 marker + (should (= (point) line3)))) + (test-jumper-hyg-teardown))) + +(ert-deftest test-jumper-hyg-remove-clears-freed-register () + "Boundary: removing a location clears its register so the marker is freed." + (test-jumper-hyg-setup) + (unwind-protect + (with-temp-buffer + (insert "test") + (goto-char (point-min)) + (jumper--do-store-location) ; ?0 + (should (get-register ?0)) + (jumper--do-remove-location 0) + (should (null (get-register ?0)))) + (test-jumper-hyg-teardown))) + +;;; Defect 2 — dead-marker entries are skipped, not errored + +(ert-deftest test-jumper-hyg-with-marker-at-dead-buffer-returns-nil () + "Error: a marker whose buffer was killed yields nil, not a wrong-type error." + (test-jumper-hyg-setup) + (let ((buf (generate-new-buffer "jumper-dead-test"))) + (unwind-protect + (progn + (with-current-buffer buf + (insert "content") + (goto-char (point-min)) + (jumper--do-store-location)) ; ?0 points into buf + (kill-buffer buf) ; marker now detached + (should (null (jumper--with-marker-at 0 (lambda () 'ran))))) + (when (buffer-live-p buf) (kill-buffer buf)) + (test-jumper-hyg-teardown)))) + +(ert-deftest test-jumper-hyg-location-exists-p-survives-dead-buffer () + "Boundary: location-exists-p does not error when a stored buffer is dead." + (test-jumper-hyg-setup) + (let ((buf (generate-new-buffer "jumper-dead-test-2"))) + (unwind-protect + (progn + (with-current-buffer buf + (insert "content") + (goto-char (point-min)) + (jumper--do-store-location)) + (kill-buffer buf) + (should (null (jumper--location-exists-p)))) + (when (buffer-live-p buf) (kill-buffer buf)) + (test-jumper-hyg-teardown)))) + +(ert-deftest test-jumper-hyg-candidates-skip-dead-buffer () + "Boundary: the candidate list omits a location whose buffer was killed." + (test-jumper-hyg-setup) + (let ((buf (generate-new-buffer "jumper-dead-test-3"))) + (unwind-protect + (progn + (with-current-buffer buf + (insert "content") + (goto-char (point-min)) + (jumper--do-store-location)) + (kill-buffer buf) + (should (null (jumper--location-candidates)))) + (when (buffer-live-p buf) (kill-buffer buf)) + (test-jumper-hyg-teardown)))) + +;;; Defect 3 — single-location toggle returns to the previous spot + +(ert-deftest test-jumper-hyg-toggle-back-when-last-set () + "Normal: toggling at the only location jumps back to the last-location register. +Jump to the location (which records the prior spot in 'z); toggling again while +sitting on the location returns to that prior spot." + (test-jumper-hyg-setup) + (unwind-protect + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) ; store @ line 1 + (let ((away (point-max))) + (goto-char away) + (jumper--do-jump-to-location nil) ; jump to line 1, 'z := away + (should (= (point) (point-min))) + (let ((result (jumper--do-jump-to-location nil))) ; toggle back + (should (eq result 'jumped-back)) + (should (= (point) away))))) + (test-jumper-hyg-teardown))) + +(ert-deftest test-jumper-hyg-toggle-at-location-no-last-stays () + "Boundary: toggling at the location with no last-location set returns +'already-there and does not move point." + (test-jumper-hyg-setup) + (unwind-protect + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((result (jumper--do-jump-to-location nil))) + (should (eq result 'already-there)) + (should (= (point) (point-min))))) + (test-jumper-hyg-teardown))) + +(provide 'test-jumper--register-hygiene) +;;; test-jumper--register-hygiene.el ends here |
