The section refresh is checked against the file it must not have touched

This commit is contained in:
Joseph Ferano 2026-09-14 11:29:13 +07:00
parent 042ddd73d9
commit 1615e3ed8b
3 changed files with 63 additions and 10 deletions

View File

@ -72,7 +72,7 @@ versions and is none of this file's business.
|---|---|
| `emacs/flan-lower.el` | the whole feature: the four fetches, the narrowing, the renderer, the folding and the memory of it |
| `emacs/flan-mode.el` | `C-c C-l` and the autoload |
| `emacs/test-flan-dev.el` | 26 checks, after the disassembly section |
| `emacs/test-flan-dev.el` | 30 checks, after the disassembly section |
| `emacs/MANUAL.md` | its own section, plus rows in both key tables, the settings table and the file table |
## The keymap
@ -121,16 +121,26 @@ error message -- which is the tool's own stderr -- becomes the body.
## Testing
26 checks in `emacs/test-flan-dev.el`, immediately after the disassembly
30 checks in `emacs/test-flan-dev.el`, immediately after the disassembly
section and needing no daemon, which is itself the distinction between the two
commands.
Twenty-one of them drive the renderer with `flan-lower-fetch-function` rebound
Twenty-two of them drive the renderer with `flan-lower-fetch-function` rebound
to canned text. That is deliberate: folding, and the memory of what was
folded, are renderer properties, and putting four compilers and an `llc -O2`
behind every redraw would have cost seconds per redraw and proved nothing
about folding. The real fetch is exercised once at the end, guarded on `llc`,
`as` and `objdump`, and that one costs about 2.2s.
`as` and `objdump`, and that one costs about 2.2s plus one more `llc -O2` for
the `r` check.
`r` is checked where the real fetch already ran, because the claim it makes is
about files rather than about text: the IR's mtime is unchanged after one
section is refreshed, which is the only evidence available that the cache does
what it says — a re-emitted `out.ll` would have the same contents as the one
it replaced. `g` is checked twice: from inside a listing, where point comes
back to the same line *and the same text on it*, and from the header, where
there is no section to come back to and the answer has to be the top rather
than wherever the redraw finished.
`buffer-string` is useless for any of it, because it returns hidden text too:
"all four are still named when everything is shut" would pass without anything

View File

@ -475,9 +475,14 @@ section instead of doing nothing -- the same bargain `flan-cnr-tab' makes."
(defun flan-lower--restore (pos screen-line)
"Put point back at POS and the window back at SCREEN-LINE."
(when pos
(when (flan-lower--goto-section (car pos))
(forward-line (cdr pos))))
(if pos
(when (flan-lower--goto-section (car pos))
(forward-line (cdr pos)))
;; Point was in the header, above every section. The top is where it was
;; and the top is where it goes back to; leaving it wherever the redraw
;; finished would put it at the end of the buffer, which is a worse jump
;; than the one this whole function exists to avoid.
(goto-char (point-min)))
;; Guarded because under `emacs -batch' there is no window at all, and an
;; unguarded `set-window-start' would be a failure with nothing to do with
;; what was being refreshed.

View File

@ -950,10 +950,25 @@ is written instead — the real `message' call the real command makes."
(flan-lower-expand-all)
(goto-char (funcall body-of 'O2))
(forward-line 1)
(let ((was (flan-lower--position)))
;; The line's *text* as well as its coordinates: point is put back by
;; heading plus a line count, so comparing only the coordinates would
;; check that the two halves are inverses of each other rather than that
;; the reader is looking at what they were looking at.
(let ((was (flan-lower--position))
(line (buffer-substring-no-properties
(line-beginning-position) (line-end-position))))
(flan-lower-refresh)
(test-flan--check "g redraws without moving point off the line it was on"
(equal was (flan-lower--position))))))
(and (equal was (flan-lower--position))
(equal line (buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))))
;; And from the header, where there is no section to come back to: the
;; top, which is where it was, rather than wherever the redraw ended.
(goto-char (point-min))
(flan-lower-refresh)
(test-flan--check "and from the header it comes back to the top, not the end"
(= (point) (point-min)))))
;; And once for real, against the compiler dune just built: four
;; subprocesses, four narrowings, and the one thing canned text cannot
@ -964,7 +979,9 @@ is written instead — the real `message' call the real command makes."
(executable-find "objdump")))
(message " skip lowering: no llc/as/objdump, or no compiler to run")
(let ((flan-lower-program flan)
(flan-lower--state '((ir . t) (O0 . t) (O2 . t) (x86 . t))))
;; A copy, because a toggle `setf's into this and a quoted literal
;; is a constant.
(flan-lower--state (copy-alist '((ir . t) (O0 . t) (O2 . t) (x86 . t)))))
(flan-lowering "step" program)
(with-current-buffer flan-lower-buffer
(let ((text (buffer-string)))
@ -980,6 +997,27 @@ is written instead — the real `message' call the real command makes."
(test-flan--check "the x86 section is the backend's bytes, disassembled"
(and (string-match-p "<flan\\.step>:" text)
(string-match-p "push +%rbp" text))))
;; `r' is the other half of the caching claim: one section redrawn,
;; and the IR every section is downstream of left where it was. The
;; mtime is the only evidence of that, since a re-emitted out.ll would
;; have the same contents as the one it replaced.
(let ((mtime (file-attribute-modification-time
(file-attributes
(expand-file-name "out.ll" flan-lower--dir))))
(before (alist-get 'O2 flan-lower--texts)))
(flan-lower--goto-section 'O2)
(flan-lower-refresh-section)
(test-flan--check "r redraws one section without re-emitting the IR it reads"
(equal mtime (file-attribute-modification-time
(file-attributes
(expand-file-name "out.ll"
flan-lower--dir)))))
(test-flan--check "and the section it redrew says the same thing it did"
(equal before (alist-get 'O2 flan-lower--texts)))
(test-flan--check "and the other three are still there"
(and (alist-get 'ir flan-lower--texts)
(alist-get 'O0 flan-lower--texts)
(alist-get 'x86 flan-lower--texts))))
;; The scratch directory is this buffer's and goes with it; /tmp is
;; not a place to leave four intermediates behind per invocation.
(let ((dir flan-lower--dir))