diff options
| -rw-r--r-- | modules/jumper.el | 45 | ||||
| -rw-r--r-- | tests/test-jumper--register-hygiene.el | 179 |
2 files changed, 214 insertions, 10 deletions
diff --git a/modules/jumper.el b/modules/jumper.el index de270de66..d5d0cf7a7 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -114,7 +114,8 @@ marker's buffer with point at the marker (within `save-current-buffer' and marker." (let* ((reg (aref jumper--registers index)) (marker (get-register reg))) - (when (and marker (markerp marker)) + (when (and marker (markerp marker) + (buffer-live-p (marker-buffer marker))) (save-current-buffer (set-buffer (marker-buffer marker)) (save-excursion @@ -156,6 +157,20 @@ Indices whose marker is no longer valid are skipped (their for fmt = (jumper--format-location i) when fmt collect (cons fmt i))) +(defun jumper--first-free-register () + "Return the lowest register char in 0..N-1 not held by a live slot. +N is `jumper-max-locations'. Only the live slice (indices 0 through +`jumper--next-index' minus 1) is consulted, so a char freed by a removal is +reused on the next store instead of colliding with a surviving slot's +register and silently overwriting its marker." + (let ((used (make-hash-table :test 'eql))) + (dotimes (i jumper--next-index) + (let ((r (aref jumper--registers i))) + (when r (puthash r t used)))) + (cl-loop for c from ?0 below (+ ?0 jumper-max-locations) + unless (gethash c used) + return c))) + (defun jumper--do-store-location () "Store current location in the next free register. Returns: \\='already-exists if location is already stored, @@ -165,7 +180,7 @@ Returns: \\='already-exists if location is already stored, ((jumper--location-exists-p) 'already-exists) ((not (jumper--register-available-p)) 'no-space) (t - (let ((reg (+ ?0 jumper--next-index))) + (let ((reg (jumper--first-free-register))) (point-to-register reg) (aset jumper--registers jumper--next-index reg) (setq jumper--next-index (1+ jumper--next-index)) @@ -190,7 +205,13 @@ Returns: \\='no-locations if no locations stored, ;; Toggle behavior when target-idx is nil and only 1 location ((and (null target-idx) (= jumper--next-index 1)) (if (jumper--location-exists-p) - 'already-there + ;; Already at the only location: toggle back to where we came from + ;; when a last-location is recorded, otherwise report no movement. + (if (get-register jumper--last-location-register) + (progn + (jump-to-register jumper--last-location-register) + 'jumped-back) + 'already-there) (let ((reg (aref jumper--registers 0))) (point-to-register jumper--last-location-register) (jump-to-register reg) @@ -217,6 +238,7 @@ Returns: \\='no-locations if no locations stored, ((= jumper--next-index 1) (pcase (jumper--do-jump-to-location nil) ('already-there (message "You're already at the stored location")) + ('jumped-back (message "Jumped back to previous location")) ('jumped (message "Jumped to location")))) ;; Multiple locations - prompt user (t @@ -233,13 +255,16 @@ Returns: \\='no-locations if no locations stored, (message "Jumped to location"))))) (defun jumper--reorder-registers (removed-idx) - "Reorder registers after removing the one at REMOVED-IDX." - (when (< removed-idx (1- jumper--next-index)) - ;; Shift all higher registers down - (cl-loop for i from removed-idx below (1- jumper--next-index) - do (let ((next-reg (aref jumper--registers (1+ i)))) - (aset jumper--registers i next-reg)))) - (setq jumper--next-index (1- jumper--next-index))) + "Reorder registers after removing the one at REMOVED-IDX. +Shift the higher registers down and clear the freed register so its marker +no longer pins its buffer." + (let ((freed (aref jumper--registers removed-idx))) + (when (< removed-idx (1- jumper--next-index)) + ;; Shift all higher registers down + (cl-loop for i from removed-idx below (1- jumper--next-index) + do (aset jumper--registers i (aref jumper--registers (1+ i))))) + (setq jumper--next-index (1- jumper--next-index)) + (when freed (set-register freed nil)))) (defun jumper--do-remove-location (index) "Remove location at INDEX. 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 |