From ed1e150dc154b3edb08693b8e41c32de8f9088e6 Mon Sep 17 00:00:00 2001 From: Angel Peralta Date: Tue, 19 May 2026 17:58:32 -0400 Subject: [PATCH 1/3] fix: describe-bindings freeze and crash after keymap rewrite Two regressions from PR #2100: - help.lisp: describe-bindings-internal looped forever because the (setf keymap (keymap-parent keymap)) advance was removed but the (loop :while keymap ...) was left in place. Terminate after one iteration with (setf keymap nil). - keymap.lisp: traverse-keymap yielded transient closures (toggle, choice infixes) to callbacks, causing (symbol-name command) to signal a type error in describe-bindings-internal. Guard the callback at the contract boundary by gating on (symbolp suffix). --- src/commands/help.lisp | 1 + src/keymap.lisp | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/commands/help.lisp b/src/commands/help.lisp index 5673f95aa..e67b41cad 100644 --- a/src/commands/help.lisp +++ b/src/commands/help.lisp @@ -38,6 +38,7 @@ column-width (keyseq-to-string kseq) (symbol-name command))))) + (setf keymap nil) (terpri s)))) (define-command describe-bindings () () diff --git a/src/keymap.lisp b/src/keymap.lisp index 261b3f1b3..0e16e2706 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -594,7 +594,7 @@ higher-priority keymap (e.g. vi normal mode remaps self-insert to undefined-key) (cond ((or (typep suffix 'keymap) (typep suffix 'prefix)) (traverse-node suffix (cons key prefix))) - (t + ((symbolp suffix) (funcall fun (reverse (cons key prefix)) suffix))))) (traverse-node (node prefix) (cond ((typep node 'keymap) From 8a171acdbfc5ab8af6a676ae879ea2c025c127d8 Mon Sep 17 00:00:00 2001 From: Angel Peralta Date: Tue, 19 May 2026 18:06:25 -0400 Subject: [PATCH 2/3] test: cover describe-bindings/traverse-keymap regressions - traverse-keymap-skips-non-symbol-suffixes: builds a keymap whose prefix suffix is a closure (the shape produced by transient toggle/choice infixes) and asserts traverse-keymap only yields symbol commands. - describe-bindings-internal-terminates: end-to-end check that the function returns (with a bordeaux-threads timeout guard) on a keymap containing a closure suffix, and that the rendered output includes the symbol binding. --- lem-tests.asd | 1 + tests/keymap.lisp | 49 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 50 insertions(+) create mode 100644 tests/keymap.lisp diff --git a/lem-tests.asd b/lem-tests.asd index b329e39ed..f64087431 100644 --- a/lem-tests.asd +++ b/lem-tests.asd @@ -58,6 +58,7 @@ (:file "syntax-test") (:file "syntax-scanner") (:file "buffer-list-test") + (:file "keymap") (:file "popup-window") (:file "prompt") (:file "cursors") diff --git a/tests/keymap.lisp b/tests/keymap.lisp new file mode 100644 index 000000000..823c90b0d --- /dev/null +++ b/tests/keymap.lisp @@ -0,0 +1,49 @@ +(defpackage :lem-tests/keymap-test + (:use :cl :rove) + (:import-from :lem-core + :make-keymap + :make-prefix + :keymap-add-prefix + :make-key + :traverse-keymap)) +(in-package :lem-tests/keymap-test) + +(defun make-test-keymap-with-closure-suffix () + "A keymap holding one normal symbol binding and one prefix whose +suffix is a closure -- the shape produced by transient toggle/choice +infixes." + (let ((keymap (make-keymap :description 'test-keymap)) + (closure (lambda () 'transient-thunk))) + (keymap-add-prefix keymap (make-prefix :key (make-key :sym "a") + :suffix 'real-command)) + (keymap-add-prefix keymap (make-prefix :key (make-key :sym "b") + :suffix closure)) + (values keymap closure))) + +(deftest traverse-keymap-skips-non-symbol-suffixes + (multiple-value-bind (keymap closure) (make-test-keymap-with-closure-suffix) + (let ((yielded '())) + (traverse-keymap keymap + (lambda (kseq cmd) + (declare (ignore kseq)) + (push cmd yielded))) + (ok (every #'symbolp yielded)) + (ok (member 'real-command yielded)) + (ng (member closure yielded))))) + +#+sbcl +(deftest describe-bindings-internal-terminates + (let ((keymap (make-test-keymap-with-closure-suffix)) + (output nil)) + (let ((result + (handler-case + (bordeaux-threads:with-timeout (5) + (setf output + (with-output-to-string (s) + (lem-core/commands/help::describe-bindings-internal + s "test" keymap t))) + :ok) + (bordeaux-threads:timeout () :timed-out) + (error (e) (cons :error e))))) + (ok (eq result :ok)) + (ok (search "real-command" (or output "")))))) From 137fca607fb610d5b4886f4ab2fba03eea83c80b Mon Sep 17 00:00:00 2001 From: Angel Peralta Date: Tue, 19 May 2026 18:15:14 -0400 Subject: [PATCH 3/3] test: docstring deftests; document internal access Adds rationale docstrings to both deftest forms describing the regressions they guard against, and an inline comment explaining why the test reaches lem-core/commands/help::describe-bindings-internal through the internal symbol path. --- tests/keymap.lisp | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/tests/keymap.lisp b/tests/keymap.lisp index 823c90b0d..4ced77749 100644 --- a/tests/keymap.lisp +++ b/tests/keymap.lisp @@ -21,6 +21,10 @@ infixes." (values keymap closure))) (deftest traverse-keymap-skips-non-symbol-suffixes + "Regression test for #2100: transient closures (toggle/choice infix +suffixes) must not be yielded to traverse-keymap callbacks, since +callers like describe-bindings-internal call symbol-name on the +result and would signal a type-error on function objects." (multiple-value-bind (keymap closure) (make-test-keymap-with-closure-suffix) (let ((yielded '())) (traverse-keymap keymap @@ -33,6 +37,10 @@ infixes." #+sbcl (deftest describe-bindings-internal-terminates + "Regression test for #2100: describe-bindings-internal used to loop +forever because the keymap-walk advance was removed but the +surrounding (loop :while keymap ...) was kept. Wrap the call in a +timeout so a regression fails CI cleanly instead of hanging it." (let ((keymap (make-test-keymap-with-closure-suffix)) (output nil)) (let ((result @@ -40,6 +48,11 @@ infixes." (bordeaux-threads:with-timeout (5) (setf output (with-output-to-string (s) + ;; Internal access: this helper is intentionally + ;; not exported (-internal suffix); the test pins + ;; down the regression at the unit level rather + ;; than committing to its stream-printing shape + ;; as a public contract. (lem-core/commands/help::describe-bindings-internal s "test" keymap t))) :ok)