Drive both new things through the real client

The overlay half is checked as far as --batch allows and no further:
execute-kbd-macro runs no pre-command-hook there, so the hook is proved
installed in the right buffer and in nobody else's, and proved to clear and
uninstall when run — which is what the command loop does with it. That Emacs
runs it is Emacs' contract, and a test pretending to check it would be
checking nothing.
This commit is contained in:
Joseph Ferano 2026-09-12 04:03:19 +07:00
parent 91185beb7b
commit 38004eec3e
2 changed files with 90 additions and 0 deletions

View File

@ -763,6 +763,12 @@ Compared with `file-equal-p', so a symlinked or relative path still matches."
"Face for the message shown beside a rejected form."
:group 'flan-dev)
(defun flan-dev--error-overlays (&optional buffer)
"The Flan error overlays in BUFFER, or in the current buffer."
(with-current-buffer (or buffer (current-buffer))
(seq-filter (lambda (o) (overlay-get o 'flan-dev-error))
(overlays-in (point-min) (point-max)))))
(defun flan-dev-clear-errors (&optional buffer)
"Remove Flan error overlays from BUFFER, or from the current buffer."
(interactive)

View File

@ -628,6 +628,90 @@ is written instead — the real `message' call the real command makes."
(test-flan--check "and says nothing above the first one"
(null (flan-current-defun-name))))
;; ── A rejection lasts as long as the action it was about ──────────────
;;
;; The overlay is feedback on the evaluation that just failed, so the next
;; command in that buffer takes it down. What is checked here is the
;; mechanism and not Emacs' command loop: `execute-kbd-macro' under --batch
;; runs no `pre-command-hook' at all (and does not even move point), so there
;; is no way from here to make the real loop run one. `run-hooks' is what
;; the loop calls, and calling it is the closest honest thing — it proves the
;; hook is installed, in the right buffer and nowhere else, and that running
;; it clears the overlay and uninstalls itself. It does not prove Emacs runs
;; it, which is Emacs' own contract.
(let ((buf (flan-dev--buffer-visiting file)))
(with-current-buffer buf
(flan-dev-clear-errors)
(let ((marked (flan-dev--show-error (format "%s:2:1" file) "no such name")))
(test-flan--check "a rejection is marked in the buffer it came from"
(and marked (flan-dev--error-overlays)))
(test-flan--check "and the buffer is armed to take it down again"
(memq #'flan-dev--clear-errors-on-command
pre-command-hook))
;; Buffer-local, or every buffer in the session runs this on every
;; keystroke for the sake of a buffer that had one bad evaluation.
(test-flan--check "and nobody else is"
(not (memq #'flan-dev--clear-errors-on-command
(default-value 'pre-command-hook))))
(run-hooks 'pre-command-hook)
(test-flan--check "the next command in that buffer clears it"
(null (flan-dev--error-overlays)))
(test-flan--check "and the hook goes with the last overlay"
(not (memq #'flan-dev--clear-errors-on-command
pre-command-hook))))))
;; ── Disassembly ───────────────────────────────────────────────────────
;;
;; Its own daemon, because the first one was disconnected above and a
;; disassembly is a question only a live session can answer: the daemon is
;; the thing that built the module and still has the .ll and the .so.
(let ((socket3 (concat socket "-disasm")))
(ignore-errors (delete-file socket3))
(flan-dev program socket3)
(test-flan--check "a daemon to disassemble against"
(process-live-p flan-dev--connection))
(when (executable-find "objdump")
(flan-disassemble "step")
(with-current-buffer flan-disassembly-buffer
(let ((text (buffer-string)))
(test-flan--check "C-c C-a writes a disassembly of the name"
(string-match-p "\\`; disassembly for step" text))
;; The header is the half a listing cannot carry: what the answer
;; claims, which for generated code is never "this is running".
(test-flan--check "with the daemon's own account of what it shows"
(string-match-p "showing" text))
(test-flan--check "and instructions under it, numbered from zero"
(string-match-p "^ 0000 " text)))))
;; The other half of the same question, on the same body.
(flan-disassemble "step" t)
(with-current-buffer flan-disassembly-buffer
(let ((text (buffer-string)))
(test-flan--check "C-u C-c C-a writes the IR it was built from"
(and (string-match-p "\\`; LLVM IR for step" text)
(string-match-p "^define .*flan\\.step" text)))
;; Nothing has been evaluated into this daemon, so the body in the
;; cell is still the one the process was launched with — the one case
;; where what is installed *now* is knowable, and it says so.
(test-flan--check "and says the program is still running the host's copy"
(string-match-p "host executable" text))))
;; Refused by name rather than shown as an empty buffer.
(test-flan--check "a name the program does not define is refused by name"
(let ((raised nil))
(condition-case err (flan-disassemble "no-such-thing")
(user-error (setq raised (error-message-string err))))
(and raised (string-match-p "no function named" raised))))
(test-flan--check "and so is a global, which has no code to show"
(let ((raised nil))
(condition-case err (flan-disassemble "ticks")
(user-error (setq raised (error-message-string err))))
(and raised (string-match-p "not a function" raised))))
(flan-dev-quit)
(ignore-errors (delete-file socket3)))
(if (zerop test-flan--failures)
(message "flan-dev.el: all tests passed")
(message "\n%d failure(s)" test-flan--failures)