Joseph Ferano
6e7b53b988
`flan-watch-ghost-call-regexp' allowed one hyphenated segment until this lane's sibling widened it, so `watch-num-i64' matched as far as `watch-num', required whitespace, found `-i64' and backtracked to failure: the row appeared in the watch buffer as usual and the call site got no inline value at all. Nothing automated covered the widening. It does now — a block pinning both accumulator heads beside the four one-segment ones, verified by putting the `?' back and watching exactly those two checks fail. The other half of that handoff asked for a test of `watch_render_num''s `n=0' branch. It cannot be written: `s->num' is set in one place, `watch_record', which always falls through to `s->n += 1', and the clear and the increment sit inside one odd-generation window. The reader never compares the slot's epoch to the global one, so a reset does not make a slot read as empty either. The branch is dead, and the live consequence is that a read taken after `:reset t' and before the program's next sample reports the previous window — which is why the existing test waits for the count to drop rather than reading once. Recorded in HANDOFF-f3.md with the two ways out, both of which belong to whoever owns runtime/flan_dev.c.
215 lines
9.7 KiB
EmacsLisp
215 lines
9.7 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-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
|