Joseph Ferano
c586eed138
flan-watch-ghost-mode paints each watched value inline, after the line holding the call that wrote it. An addition to the watch buffer and not a replacement: both can be on at once, and turning either off leaves the other running. The earlier note said ghost text was gated on a (watch ...) form in check.ml, because nothing in the table carries a source location. That is true of the table and the conclusion did not follow. The call site is in the buffer, and the name in the table is the string literal in it, so the anchor is searched for rather than reported. Nothing new is asked of the daemon. The head of the call is a defcustom regexp, because watch-i64 is a name the program's author chose in their own declare-c and only the C symbol behind it is fixed. Both pictures are painted from one reply in flan-watch--absorb, so they cannot disagree and there is no second watch request in flight. That meant the watch buffer could no longer be the subscription: arming and the timer now hang off flan-watch--consumers, and only the last consumer out disarms the table. Overlays are replaced wholesale on every repaint rather than followed through edits, which is the whole answer to invalidating one whose line moved. Only buffers shown in a window are scanned. Settled and written down: two sites of one name both show it and say so, because the table has one slot and the last writer wins; a watch in a loop shows the last value written, as the buffer does, because every better answer is the query UI this design exists to avoid; a stopped program's values say "last frame" and change face, since inline they sit in code that looks live; a site with no row is annotated only when the table reports overflow. syntax-ppss moves point and clobbers the match data, so calling it inside a re-search-forward loop and then reading match-string restarts the scan and the loop never ends. Everything is read out before the check now. emacs/test-flan-watch.el covers it, loaded from test-flan-cider.el the way test-flan-mode.el is, so no build change is needed. 203 checks, 0 failures.
184 lines
8.1 KiB
EmacsLisp
184 lines
8.1 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)))))))
|
|
|
|
;; --- 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-dev--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-dev--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-dev--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))))
|
|
|
|
(provide 'test-flan-watch)
|
|
;;; test-flan-watch.el ends here
|