diff --git a/docs/handoffs/HANDOFF-lowering-buffer.md b/docs/handoffs/HANDOFF-lowering-buffer.md index bf3b910..791576a 100644 --- a/docs/handoffs/HANDOFF-lowering-buffer.md +++ b/docs/handoffs/HANDOFF-lowering-buffer.md @@ -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 diff --git a/emacs/flan-lower.el b/emacs/flan-lower.el index 38bcbde..57efde4 100644 --- a/emacs/flan-lower.el +++ b/emacs/flan-lower.el @@ -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. diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index ba54d24..8f7dd7d 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -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 ":" 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))