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:
parent
91185beb7b
commit
38004eec3e
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user