Joseph Ferano
635f4d30a6
The watch accumulator clears a slot lazily, on its next sample, and the reader never compares epochs. A previous lane read that as a defect and left watch_render_num's n=0 arm behind as dead code against the day the reader became epoch-aware. It should not. A stopped program takes no samples, so an epoch-aware reader would report every slot as empty for as long as the program sat in a break loop — and reading the numbers from the moment you stopped is the whole point of stopping. The lazy clear is the right answer there. What was wrong was narrower and lives in the editor: flan-watch--tick sent `:reset t` five times a second at a program that could not answer it. The read still goes out every tick; only the reset field drops, guarded on flan-dev--stopped, which flan-dev.el's background poll already keeps current. The n=0 arm is deleted rather than commented, since the only way to reach it is the epoch check just rejected and dead code is an invitation to add one. n is at least 1 whenever watch_render_num runs, so sum/n cannot divide by zero. test-flan-watch.el asserts both halves with no daemon: a running tick carries :reset, a stopped one does not, both still read the table and both leave a reply in flight. Verified by mutation. What it cannot reach is the daemon honouring the absent field; test_dev.ml drives a real program for that.
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-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))))
|
|
|
|
;; --- 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-dev--stopped' to the form it puts on the
|
|
;; wire, and that is the whole claim, so `flan-dev--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-dev--stopped stopped)
|
|
(flan-dev--connection 'a-process)
|
|
(flan-dev--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-dev--take-reply) (lambda (_) nil))
|
|
((symbol-function 'flan-dev--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
|