Joseph Ferano
d9404bb34a
`-dev-` was in every Emacs symbol this client owns and meant nothing to anyone typing one: the daemon is `flan dev` at a shell, but from inside Emacs there is no other kind of connection to distinguish it from. `M-x flan-dev` is now `M-x flan`, `flan-dev-quit` is `flan-quit`, the private prefix `flan-dev--` is `flan--`, and every defcustom follows — ninety-odd symbols, with the two files renamed to emacs/flan.el and emacs/test-flan.el so the file names say the same thing as the symbols in them. No aliases. Renaming a defcustom breaks a config that names it and there is no way around that; the repo has no precedent for softening one, and an alias left behind is what keeps a rename from finishing. MANUAL.md says the old names are gone and how to fix a config, which is the whole of the migration path. Three strings are not symbols and keep their spelling: `.flan-dev.sock`, which bin/main.ml writes and which a renamed variable searching for a renamed file would simply never find; and the two buffer names `*flan-dev*` and ` *flan-dev*`, which name the `flan dev` subcommand's own output rather than anything in elisp. `flan dev` with a space is the CLI and is untouched everywhere. The entry point also stops asking a question it already has the answer to. From a buffer visiting a .flan file it starts that file; from anywhere else it reads one from the minibuffer as before; `C-u` reads one either way, which is how you start a second program without leaving the first. The current buffer is still the only source of the default — the bug where a previous project won over the buffer you were in was fixed by removing `flan--file` from that position, and nothing here puts it back. Four checks on the `interactive' form, evaluated on its own rather than by calling the command, because calling it would build and launch a program and the question is only which file the form arrives at and whether it had to ask. A fifth asserts that nothing answers to the old names. test/test_emacs.ml loads the test file by path and test/test_session.ml names the client file in a comment, so the rename reaches those two lines; nothing else outside emacs/ and the docs moved. Verified by byte-compiling every file clean and by `dune test` and `@page`.
264 lines
12 KiB
EmacsLisp
264 lines
12 KiB
EmacsLisp
;;; test-flan-watch.el --- Ghost text, from a buffer and a fixture table -*- lexical-binding: t; -*-
|
|
|
|
;; Loaded by test-flan-cider.el, which runs under `dune test', for the reason
|
|
;; test-flan-mode.el gives: `emacs/*.el' is already a dependency of that
|
|
;; stanza, so a file here needs no build change to be run.
|
|
;;
|
|
;; Nothing here needs a daemon. Ghost text is a function from *a table of rows*
|
|
;; and *the text in a buffer* to *overlays*, and both halves are fixtures: the
|
|
;; rows are what a watch reply carries, and the buffer is Flan source. The
|
|
;; interesting failures are all on that side — a call site inside a string taken
|
|
;; for code, a name the runtime clipped no longer matching the site that wrote
|
|
;; it, an overlay left behind from the last repaint.
|
|
;;
|
|
;; The one case that is not about text is the subscription: the watch buffer
|
|
;; used to *be* the subscription, and ghost text is the second consumer that
|
|
;; made that wrong. Closing one must leave the other running.
|
|
|
|
;;; Code:
|
|
|
|
(require 'flan-mode)
|
|
(require 'flan-watch)
|
|
|
|
(declare-function test-flan--check "test-flan-cider" (name ok))
|
|
|
|
(defun test-flan-watch--buffer (text)
|
|
"A live `flan-mode' buffer holding TEXT, shown in a window.
|
|
|
|
Shown because `flan-watch--ghost-paint' only scans displayed buffers, which is
|
|
what bounds its cost; a `with-temp-buffer' would be scanned by nothing."
|
|
(let ((buf (get-buffer-create "test-flan-watch.flan")))
|
|
(with-current-buffer buf
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(insert text))
|
|
(flan-mode))
|
|
(set-window-buffer (selected-window) buf)
|
|
buf))
|
|
|
|
(defun test-flan-watch--starts ()
|
|
"Where the overlays sit, in buffer order."
|
|
(sort (mapcar #'overlay-start flan-watch--ghost-overlays) #'<))
|
|
|
|
(defun test-flan-watch--strings ()
|
|
"What the overlays say, in buffer order."
|
|
(mapcar (lambda (ov) (substring-no-properties (overlay-get ov 'after-string)))
|
|
(sort (copy-sequence flan-watch--ghost-overlays)
|
|
(lambda (a b) (< (overlay-start a) (overlay-start b))))))
|
|
|
|
;; --- Finding the call site ------------------------------------------------
|
|
;;
|
|
;; The anchor is searched for rather than reported, because the table carries a
|
|
;; name and no location. A call inside a string is the case that makes the
|
|
;; syntax check earn its place: it is text that looks exactly like code.
|
|
|
|
(let ((buf (test-flan-watch--buffer
|
|
(concat "(defn step [] i64\n"
|
|
" (watch-i64 \"ticks\" ticks)\n"
|
|
" (watch-f64 \"hp\" hp)\n"
|
|
" (println \"(watch-i64 \\\"fake\\\" x)\")\n"
|
|
" (watch \"hp\" hp))\n"))))
|
|
(with-current-buffer buf
|
|
(let ((sites (flan-watch--ghost-sites)))
|
|
(test-flan--check
|
|
"every watch call in the buffer is found, by the name it writes"
|
|
(equal (mapcar #'car sites) '("ticks" "hp" "hp")))
|
|
(test-flan--check
|
|
"and a call written inside a string is not one of them"
|
|
(not (member "fake" (mapcar #'car sites)))))))
|
|
|
|
;; --- Every head the default regexp claims to cover ------------------------
|
|
;;
|
|
;; `flan-watch-ghost-call-regexp' allows *any number* of hyphenated segments,
|
|
;; and the accumulator is why. With one optional segment — the `?\=' this
|
|
;; default used to have — `watch-num-i64' matched as far as `watch-num', then
|
|
;; required whitespace, found `-i64', and backtracked to failure. The failure
|
|
;; is silent and looks like nothing: the row is in the watch buffer as usual
|
|
;; and the call site simply never gets an inline value. So the two-segment
|
|
;; heads are pinned here beside the one-segment ones, or the next widening of
|
|
;; this default has nothing to fail against.
|
|
|
|
(let ((buf (test-flan-watch--buffer
|
|
(concat "(defn step [] i64\n"
|
|
" (watch \"bare\" x)\n"
|
|
" (watch-i64 \"ticks\" ticks)\n"
|
|
" (watch-f64 \"hp\" hp)\n"
|
|
" (watch-str \"label\" label)\n"
|
|
" (watch-num-i64 \"cell\" (at grid i))\n"
|
|
" (watch-num-f64 \"dt\" dt))\n"))))
|
|
(with-current-buffer buf
|
|
(let ((sites (flan-watch--ghost-sites)))
|
|
(test-flan--check
|
|
"a two-segment head is a site: the accumulator gets inline text too"
|
|
(equal (assoc "cell" sites)
|
|
(cons "cell" (save-excursion (goto-char (point-min))
|
|
(line-end-position 6)))))
|
|
(test-flan--check
|
|
"and every head the default documents is found, in buffer order"
|
|
(equal (mapcar #'car sites)
|
|
'("bare" "ticks" "hp" "label" "cell" "dt"))))))
|
|
|
|
;; --- Matching a row to a site ---------------------------------------------
|
|
;;
|
|
;; The runtime holds 31 bytes of a name, so a longer one in the source can
|
|
;; never match a row exactly. The prefix fallback is guarded on the row being
|
|
;; a full 31 bytes, or a short name would claim any site that starts with it.
|
|
|
|
(let ((long (make-string 40 ?a)))
|
|
(test-flan--check
|
|
"a name the runtime clipped at 31 bytes still matches the site that wrote it"
|
|
(equal (flan-watch--ghost-row long (list (cons (make-string 31 ?a) "9")))
|
|
(cons (make-string 31 ?a) "9")))
|
|
(test-flan--check
|
|
"and a row short enough not to have been clipped claims only its own site"
|
|
(null (flan-watch--ghost-row "hpx" '(("hp" . "1"))))))
|
|
|
|
;; --- What an overlay says -------------------------------------------------
|
|
|
|
(test-flan--check "a running value is just the value"
|
|
(equal (substring-no-properties
|
|
(flan-watch--ghost-text "42" 1 nil))
|
|
" => 42"))
|
|
(test-flan--check
|
|
"two sites of one name each say so, because the table has one slot"
|
|
(string-match-p "one slot, 2 sites"
|
|
(flan-watch--ghost-text "42" 2 nil)))
|
|
(test-flan--check
|
|
"and one site says nothing about sites"
|
|
(not (string-match-p "sites" (flan-watch--ghost-text "42" 1 nil))))
|
|
(test-flan--check
|
|
"a stopped program's value says it is the last frame's"
|
|
(string-match-p "last frame" (flan-watch--ghost-text "42" 1 t)))
|
|
(test-flan--check
|
|
"and is drawn in the face that is not the running one"
|
|
(eq (get-text-property 0 'face (flan-watch--ghost-text "42" 1 t))
|
|
'flan-watch-ghost-stale-face))
|
|
|
|
;; --- Painting -------------------------------------------------------------
|
|
|
|
(let ((buf (test-flan-watch--buffer
|
|
(concat "(watch-i64 \"ticks\" ticks)\n"
|
|
"(watch-i64 \"ticks\" ticks)\n"
|
|
"(watch-i64 \"gone\" g)\n")))
|
|
(flan-watch--consumers '(ghost))
|
|
(flan--stopped nil))
|
|
(flan-watch--ghost-paint '(("ticks" . "42")) nil)
|
|
(test-flan--check
|
|
"a site whose name is in the table gets an overlay, and one that is not does not"
|
|
(equal (test-flan-watch--strings)
|
|
'(" => 42 one slot, 2 sites" " => 42 one slot, 2 sites")))
|
|
(test-flan--check
|
|
"each one sits at the end of its own call's line"
|
|
(equal (test-flan-watch--starts)
|
|
(with-current-buffer buf
|
|
(save-excursion (goto-char (point-min))
|
|
(list (line-end-position 1) (line-end-position 2))))))
|
|
|
|
;; The one case worth annotating a site with no row: the value exists and was
|
|
;; dropped. The watch buffer's overflow line says the same thing without
|
|
;; being able to say which name it happened to.
|
|
(flan-watch--ghost-paint '(("ticks" . "42")) t)
|
|
(test-flan--check
|
|
"with the table full, the site that found no slot is told so rather than left blank"
|
|
(equal (nth 2 (test-flan-watch--strings))
|
|
" => no slot: the table is full"))
|
|
|
|
(setq flan--stopped "BoundsError")
|
|
(flan-watch--ghost-paint '(("ticks" . "42")) nil)
|
|
(test-flan--check
|
|
"stopping the program marks every overlay, not the buffer's modeline only"
|
|
(equal (test-flan-watch--strings)
|
|
'(" => 42 one slot, 2 sites last frame"
|
|
" => 42 one slot, 2 sites last frame")))
|
|
(setq flan--stopped nil)
|
|
|
|
;; The whole answer to invalidating an overlay whose line moved: no overlay
|
|
;; outlives a repaint, so there is nothing to invalidate.
|
|
(with-current-buffer buf
|
|
(let ((inhibit-read-only t))
|
|
(save-excursion (goto-char (point-min)) (insert "\n\n"))))
|
|
(flan-watch--ghost-paint '(("ticks" . "42")) nil)
|
|
(test-flan--check
|
|
"editing the buffer strands nothing: a repaint replaces every overlay"
|
|
(equal (test-flan-watch--starts)
|
|
(with-current-buffer buf
|
|
(save-excursion (goto-char (point-min))
|
|
(list (line-end-position 3) (line-end-position 4))))))
|
|
|
|
;; A refusal clears them. Inline there is nowhere to print an error, so a
|
|
;; stale number beside live code would be the whole picture and it would lie.
|
|
(flan-watch--absorb '(:status "error" :message "no"))
|
|
(test-flan--check "a refused reply takes the overlays with it"
|
|
(null flan-watch--ghost-overlays))
|
|
(test-flan--check "and leaves none behind in the buffer"
|
|
(with-current-buffer buf
|
|
(null (overlays-in (point-min) (point-max))))))
|
|
|
|
;; --- The subscription -----------------------------------------------------
|
|
;;
|
|
;; The buffer used to be the subscription, so killing it disarmed the table.
|
|
;; With two consumers that is wrong: closing one must leave the other armed,
|
|
;; and only the last one out turns the lights off.
|
|
|
|
(let ((flan-watch--consumers '(buffer ghost))
|
|
(torn nil))
|
|
(cl-letf (((symbol-function 'flan-watch-stop) (lambda () (setq torn t))))
|
|
(flan-watch--drop 'buffer)
|
|
(test-flan--check "closing the watch buffer leaves ghost text armed"
|
|
(and (equal flan-watch--consumers '(ghost)) (not torn)))
|
|
(flan-watch--drop 'ghost)
|
|
(test-flan--check "and the last consumer out disarms the table"
|
|
(and (null flan-watch--consumers) torn))))
|
|
|
|
;; --- The reset is guarded on the stop ------------------------------------
|
|
;;
|
|
;; `flan-watch--tick' asks for "since you last looked" by sending `:reset t'
|
|
;; beside the read. A stopped program takes no samples, so there is no window
|
|
;; for a reset to close and none for it to open — and the runtime's lazy clear
|
|
;; is what keeps a paused program showing the numbers from the moment you
|
|
;; paused it. So the tick must drop `:reset' while stopped and keep reading.
|
|
;;
|
|
;; Asserted at the level the rest of this file works at: no daemon, no socket.
|
|
;; The tick is a function from `flan--stopped' to the form it puts on the
|
|
;; wire, and that is the whole claim, so `flan--send' and `process-live-p'
|
|
;; are stubs. What this cannot reach is the daemon actually honouring the
|
|
;; absent field; `test/test_dev.ml' drives a real program for that.
|
|
|
|
(defun test-flan-watch--tick-form (stopped)
|
|
"The form `flan-watch--tick' sends with the program STOPPED or not."
|
|
(let ((sent nil)
|
|
(flan--stopped stopped)
|
|
(flan--connection 'a-process)
|
|
(flan--busy nil)
|
|
(flan-watch--pending nil)
|
|
;; Not `buffer': that consumer checks for a live watch buffer first and
|
|
;; would drop the subscription instead of ticking.
|
|
(flan-watch--consumers '(ghost)))
|
|
(cl-letf (((symbol-function 'process-live-p) (lambda (_) t))
|
|
((symbol-function 'flan--take-reply) (lambda (_) nil))
|
|
((symbol-function 'flan--send)
|
|
(lambda (_proc form) (setq sent form))))
|
|
(flan-watch--tick)
|
|
(list sent flan-watch--pending))))
|
|
|
|
(let ((running (test-flan-watch--tick-form nil))
|
|
(stopped (test-flan-watch--tick-form "BoundsError")))
|
|
(test-flan--check
|
|
"a tick while the program runs asks for the window it is closing"
|
|
(equal (nth 0 running) '(:op "watch" :reset t)))
|
|
(test-flan--check
|
|
"a tick while the program is stopped sends no reset"
|
|
(null (plist-get (nth 0 stopped) :reset)))
|
|
;; Skipping the tick outright would be worse than resetting: the watch would
|
|
;; freeze at whatever it held when the program stopped, and a break loop is
|
|
;; exactly when the numbers are being read.
|
|
(test-flan--check
|
|
"but it still reads the table"
|
|
(equal (plist-get (nth 0 stopped) :op) "watch"))
|
|
(test-flan--check
|
|
"and still has a reply in flight, so the cycle survives the pause"
|
|
(and (nth 1 running) (nth 1 stopped))))
|
|
|
|
(provide 'test-flan-watch)
|
|
;;; test-flan-watch.el ends here
|