;;; test-flan-dev.el --- Drive the client against a running program  -*- lexical-binding: t; -*-

;; Run as:  emacs -Q --batch -L emacs -l emacs/test-flan-dev.el -- <socket> <flan-file>
;;
;; This is the client half of test_dev.ml.  The OCaml test proves the daemon
;; answers correctly; this proves the elisp actually talks to it — the framing,
;; the reply reader, and C-c C-c picking the right form out of a buffer.  A
;; protocol bug that only shows up under Emacs' coding systems would pass the
;; OCaml test and fail here, which is the whole reason it exists.

;;; Code:

(require 'flan-mode)
(require 'flan-dev)
(require 'flan-repl)
(require 'flan-watch)

(defvar test-flan--failures 0)

(defmacro test-flan--said (&rest body)
  "Run BODY and return the last thing it put in the echo area.
`current-message' is nil under --batch, so the echo area is watched where it
is written instead — the real `message' call the real command makes."
  `(let* ((said nil)
          (probe (lambda (fmt &rest args)
                   (when fmt (setq said (apply #'format fmt args))))))
     (advice-add 'message :before probe)
     (unwind-protect (progn ,@body)
       (advice-remove 'message probe))
     said))

(defun test-flan--check (name ok)
  (if ok (message "  ok   %s" name)
    (setq test-flan--failures (1+ test-flan--failures))
    (message "  FAIL %s" name)))

(let* ((args (cdr (member "--" command-line-args)))
       (socket (nth 0 args))
       (file   (nth 1 args))
       (flan   (nth 2 args))
       ;; The buffer above is a copy in a temporary directory; this is the
       ;; program where it actually lives, which is the one a second daemon
       ;; can be started on — an `import' is resolved from the importing
       ;; file's own directory, and a copy in /tmp has no packages above it.
       (program (nth 3 args)))
  (find-file file)
  ;; The copy comes out of a build directory, so it may arrive read-only.
  ;; Set the flag directly: `read-only-mode' asks about the file on disk, and
  ;; a question in a batch run is a hang waiting to happen.
  (setq buffer-read-only nil)
  (test-flan--check "flan-mode is on for a .flan file" (eq major-mode 'flan-mode))

  (test-flan--check "the modeline says so before connecting"
                    (and (eq (flan-dev-state) 'off)
                         (string-match-p "off" (flan-dev-mode-line))))

  (flan-connect socket)
  (test-flan--check "connected" (process-live-p flan-dev--connection))
  (test-flan--check "the modeline says a program is there"
                    (and (eq (flan-dev-state) 'live)
                         (string-match-p "live" (flan-dev-mode-line))))
  (test-flan--check "and says nothing in a buffer that is not Flan's"
                    (with-temp-buffer (null (flan-dev-mode-line))))
  ;; Buffer-locally, so that someone who loads this and never opens a .flan
  ;; file is not evaluating it on every redisplay of every buffer they have.
  (test-flan--check "the indicator is in this buffer's modeline"
                    (member '(:eval (flan-dev-mode-line)) mode-line-misc-info))
  (test-flan--check "and not in everyone else's"
                    (with-temp-buffer
                      (not (member '(:eval (flan-dev-mode-line))
                                   mode-line-misc-info))))

  ;; A daemon restarted while Emacs was not looking is the ordinary case.  The
  ;; socket outlives this connection, so dropping the process and asking again
  ;; is the same situation the client meets after a restart, and it must come
  ;; back rather than fail.
  (delete-process flan-dev--connection)
  (test-flan--check "a dead connection reads as lost, not as never-connected"
                    (and (eq (flan-dev-state) 'lost)
                         (string-match-p "lost" (flan-dev-mode-line))))
  (let ((r (flan-dev--request '(:op "describe"))))
    (test-flan--check "the next request reconnects on its own"
                      (and (process-live-p flan-dev--connection)
                           (member "step" (plist-get r :fns)))))
  ;; ...and knows the program's names again.  An empty cache after a reconnect
  ;; is honest but silent: eldoc goes quiet and M-. falls through to another
  ;; backend, with nothing said about why.
  (test-flan--check "and knows the program's names again"
                    (assoc "step" flan-dev--defs))

  ;; But a socket nobody is listening on is refused by name, rather than
  ;; retried forever or reported as some other failure.
  (let ((flan-dev--connection nil)
        (flan-dev--socket "/nonexistent/flan-dev-not-here.sock")
        (raised nil))
    (condition-case err (flan-dev--request '(:op "describe"))
      (error (setq raised (error-message-string err))))
    (test-flan--check "a socket that is gone is refused by name"
                      (and raised
                           (string-match-p "flan-dev-not-here.sock" raised)
                           (string-match-p "nothing is listening" raised))))

  (let ((r (flan-dev--request '(:op "describe"))))
    (test-flan--check "describe lists the program's functions"
                      (member "step" (plist-get r :fns)))
    (test-flan--check "describe lists the program's globals"
                      (member "ticks" (plist-get r :globals))))

  ;; `layout' against the real daemon, through `flan-cnr-layout', which is how
  ;; the conditions buffer gets it.  The reply is the first one with a list of
  ;; lists in it, so `read' on this side is doing something it does nowhere
  ;; else — and the daemon answers it without asking the program anything.
  (require 'flan-cnr)
  (let ((flan-cnr-request-function #'flan-dev--request))
    (test-flan--check "a struct's fields come back named and typed"
                      (equal (flan-cnr-layout "Missing") '(("id" "i32" nil))))
    (test-flan--check "and a type the daemon cannot place is nil, not an error"
                      (null (flan-cnr-layout "Nonesuch"))))

  ;; C-c C-c on the form at point: put point inside `step' and send it.  The
  ;; text comes from the buffer, so this exercises `beginning-of-defun' against
  ;; Flan's own syntax table as much as it does the wire.
  (goto-char (point-min))
  (search-forward "(defn step")
  (goto-char (match-beginning 0))
  (save-excursion
    (search-forward "(+ ticks 1)")
    (replace-match "(+ ticks 41)"))
  (let ((form (flan-dev--defun-at-point)))
    (test-flan--check "the form at point is the defn"
                      (and (string-prefix-p "(defn step" (string-trim form))
                           (string-match-p "41" form))))
  (flan-eval-defun)

  ;; And an error: the daemon answers with a location, the client raises.
  (let ((raised nil))
    (condition-case err
        (flan-dev--eval "(defn step [] i64 nonsense)" "form")
      (user-error (setq raised (error-message-string err))))
    (test-flan--check "a form that does not check is reported"
                      (and raised (string-match-p "unknown name" raised))))

  ;; The :loc column is a *byte* offset — lib/reader.ml walks the source a byte
  ;; at a time — and Emacs counts characters.  Same rule as the framing, a
  ;; different place to get it wrong, and it shows up only for someone whose
  ;; comments or identifiers are not ASCII.
  (with-temp-buffer
    (insert ";; héllo\n(defn wörld [] i64 nonsense)\n")
    (let ((want (save-excursion
                  (goto-char (point-min))
                  (search-forward "nonsense")
                  (match-beginning 0)))
          (eol (save-excursion (goto-char (point-min)) (line-end-position))))
      (test-flan--check "a byte column lands on the right character"
                        (= (flan-dev--position
                            2 (1+ (string-bytes "(defn wörld [] i64 ")))
                           want))
      (test-flan--check "a column past the end of a line is clamped to it"
                        (= (flan-dev--position 1 500) eol))))

  ;; A rejected form is marked where it is, not only in the echo area.  The
  ;; daemon numbers lines from the start of what it was sent, so a form taken
  ;; from the middle of a buffer only lands on the right line because the
  ;; client pads it back into place before sending.
  (goto-char (point-min))
  (search-forward "(defn step")
  (goto-char (match-beginning 0))
  (let ((defn-line (line-number-at-pos)))
    (save-excursion
      (search-forward "(+ ticks 41)")
      (replace-match "(+ ticks nonsense)"))
    (ignore-errors (flan-eval-defun))
    (let ((ovs (seq-filter (lambda (o) (overlay-get o 'flan-dev-error))
                           (overlays-in (point-min) (point-max)))))
      (test-flan--check "a rejected form gets exactly one error overlay"
                        (= 1 (length ovs)))
      (test-flan--check "the overlay is at the form, not at line 1"
                        (and ovs (>= (line-number-at-pos (overlay-start (car ovs)))
                                     defn-line)))
      (test-flan--check "the overlay carries the daemon's reason"
                        (and ovs
                             (string-match-p
                              "unknown name"
                              (or (overlay-get (car ovs) 'help-echo) ""))))
      (test-flan--check "and shows it beside the code"
                        (and ovs
                             (string-match-p
                              "unknown name"
                              (or (overlay-get (car ovs) 'after-string) "")))))
    ;; ...and it goes away when the next evaluation is accepted.  A marker left
    ;; behind after a fix is a lie about the running program.  Point moved to
    ;; the error, which is the point of all this, so start the search over.
    (goto-char (point-min))
    (search-forward "(+ ticks nonsense)")
    (replace-match "(+ ticks 41)")
    (search-backward "(defn step")
    ;; A silent success is indistinguishable from a silent failure, so an
    ;; accepted evaluation says what landed in the running program and what it
    ;; cost.  The name comes from the *reply*: the daemon is the one that knows
    ;; which names it installed.
    (let ((said (test-flan--said (flan-eval-defun))))
      (test-flan--check "an accepted evaluation clears it"
                        (null (seq-filter (lambda (o) (overlay-get o 'flan-dev-error))
                                          (overlays-in (point-min) (point-max)))))
      (test-flan--check "and says which name landed"
                        (and said (string-match-p "\\_<step\\_>" said)))
      (test-flan--check "and how long it took"
                        (and said (string-match-p "[0-9]+ ms" said)))))

  ;; A declaration the program already has installs nothing, and must say so
  ;; rather than reporting a time for a build that did not happen.
  (let ((said (test-flan--said
               (flan-dev--eval "(defvar ticks i64)" "form"))))
    (test-flan--check "an evaluation with nothing to install says so"
                      (and said (string-match-p "nothing to install" said)
                           (not (string-match-p "installed" said)))))

  ;; Many names are counted and sampled.  An echo area truncated in the middle
  ;; of the tenth name says neither how many there were nor which.
  (test-flan--check "a long list of names is counted, not cut off"
                    (equal (flan-dev--names-phrase
                            '("a" "b" "c" "d" "e" "f") "fallback")
                           "6 names (a, b, c, d, …)"))
  (test-flan--check "a short one is just named"
                    (equal (flan-dev--names-phrase '("a" "b") "fallback") "a, b"))

  ;; `defs' is what eldoc, completion and M-. all read.  One op answering all
  ;; three, cached, because eldoc fires on an idle timer and completion inside
  ;; redisplay, and neither may block on a socket.
  (test-flan--check "the program's names are known"
                    (assoc "step" flan-dev--defs))
  (test-flan--check "with a signature"
                    (equal (nth 2 (assoc "step" flan-dev--defs)) "step [] i64"))
  (test-flan--check "a global is known, and says it is one"
                    (equal (nth 1 (assoc "ticks" flan-dev--defs)) "var"))
  (test-flan--check "so is an imported package's extern"
                    (let ((d (assoc "agent/wait-raw" flan-dev--defs)))
                      (and d (equal (nth 1 d) "extern"))))
  ;; `step' was last installed from this buffer, so that is where the daemon
  ;; says it is — which is also the check that the client's line padding put it
  ;; on the line it is really on rather than on line 1.
  (test-flan--check "a fn carries where it is written"
                    (equal (nth 3 (assoc "step" flan-dev--defs))
                           (format "%s:%d:7" buffer-file-name
                                   (save-excursion
                                     (goto-char (point-min))
                                     (search-forward "(defn step")
                                     (line-number-at-pos)))))

  ;; eldoc: the signature of the name at point, and of the form point is
  ;; inside, which is what you want while typing arguments.
  (goto-char (point-min))
  (search-forward "(set ticks (step")
  (let ((said nil))
    (test-flan--check "eldoc answers for the name at point"
                      (and (flan-dev-eldoc-function
                            (lambda (s &rest _) (setq said s)))
                           said (string-match-p "step \\[\\] i64" said))))
  (let ((said nil))
    (save-excursion
      (goto-char (point-min))
      (search-forward "(set ticks (step)")
      (backward-char 1)            ; inside (step ...), not on the name
      (flan-dev-eldoc-function (lambda (s &rest _) (setq said s))))
    (test-flan--check "and for the form point is inside"
                      (and said (string-match-p "step" said))))
  (let ((said nil))
    (with-temp-buffer
      (insert "not-a-flan-name")
      (flan-dev-eldoc-function (lambda (s &rest _) (setq said s))))
    (test-flan--check "and says nothing about a name the program has not got"
                      (null said)))

  ;; Completion: the running program's names, through `completion-at-point'.
  (goto-char (point-min))
  (search-forward "(defn step")
  (let* ((capf (flan-dev-completion-at-point))
         (table (nth 2 capf)))
    (test-flan--check "completion offers the program's own names"
                      (member "step" (all-completions "ste" table)))
    (test-flan--check "and the names an import brought in"
                      (member "agent/wait" (all-completions "agent/" table)))
    (test-flan--check "and annotates each with what it is"
                      (equal (funcall (plist-get (nthcdr 3 capf)
                                                 :annotation-function)
                                      "ticks")
                             "  var")))

  ;; M-. through xref, so it is the key it always is.
  (let ((xs (xref-backend-definitions 'flan "step"))
        (line (save-excursion (goto-char (point-min))
                              (search-forward "(defn step")
                              (line-number-at-pos))))
    (test-flan--check "M-. finds where a function is written"
                      (and (= 1 (length xs))
                           (let ((l (xref-item-location (car xs))))
                             (and (file-equal-p (xref-location-group l)
                                                buffer-file-name)
                                  (= (xref-location-line l) line))))))

  ;; And the two things it cannot do, refused by name with the reason rather
  ;; than by opening an empty buffer.
  (let ((raised nil))
    (condition-case err (xref-backend-definitions 'flan "ticks")
      (user-error (setq raised (error-message-string err))))
    (test-flan--check "M-. on a global refuses, saying why"
                      (and raised (string-match-p "ticks" raised)
                           (string-match-p "no location" raised))))
  (let ((raised nil))
    (condition-case err (xref-backend-definitions 'flan "rand-seed")
      (user-error (setq raised (error-message-string err))))
    (test-flan--check "M-. into the prelude refuses, saying why"
                      (and raised (string-match-p "prelude" raised)
                           (string-match-p "not a file on disk" raised))))
  (let ((raised nil))
    (condition-case err (xref-backend-definitions 'flan "no-such-name")
      (user-error (setq raised (error-message-string err))))
    (test-flan--check "and so does a name the program does not have"
                      (and raised (string-match-p "no no-such-name" raised))))

  ;; A name installed now must complete now, not after the next connect.
  (flan-dev--eval "(defn freshly-added [] i64 7)" "form")
  (test-flan--check "a name just installed is known immediately"
                    (equal (nth 2 (assoc "freshly-added" flan-dev--defs))
                           "freshly-added [] i64"))

  ;; The session is not poisoned by that: a good form still lands.
  (flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 100)) ticks)" "form")

  ;; The program's own output arrives on replies and lands in its buffer, so
  ;; a long-running program is not writing into a terminal nobody is watching.
  (flan-dev--eval "(defn step [] i64 (do (println \"HELLO\") ticks))" "form")
  (let ((seen nil) (deadline (+ (float-time) 10)))
    (while (and (not seen) (< (float-time) deadline))
      (ignore-errors (flan-dev--request '(:op "describe")))
      (setq seen (with-current-buffer (get-buffer-create flan-dev-output-buffer)
                   (string-match-p "HELLO" (buffer-string)))))
    (test-flan--check "the program's output reaches its buffer" seen))

  ;; The REPL buffer: typed input goes through the same eval-expr request, and
  ;; the value lands at the prompt while the program's own output goes to
  ;; *flan-output*. Conflating those two is the bug worth testing for.
  (test-flan--check "an incomplete form is not sent"
                    (not (flan-repl--complete-p "(+ 1")))
  (test-flan--check "a whole form is sent" (flan-repl--complete-p "(+ 1 2)"))
  (test-flan--check "a paren in a string does not count"
                    (not (flan-repl--complete-p "(f \"(\"")))
  (flan-repl)
  (with-current-buffer flan-repl-buffer
    (goto-char (point-max))
    (insert "(+ 20 3)")
    (flan-repl-return)
    (let ((deadline (+ (float-time) 15)))
      (while (and (not (string-match-p "23" (buffer-string)))
                  (< (float-time) deadline))
        (accept-process-output nil 0.05)))
    (test-flan--check "the REPL shows a value"
                      (string-match-p "23" (buffer-string)))
    (goto-char (point-max))
    (insert "no-such-thing")
    (flan-repl-return)
    (let ((deadline (+ (float-time) 15)))
      (while (and (not (string-match-p "unknown name" (buffer-string)))
                  (< (float-time) deadline))
        (accept-process-output nil 0.05)))
    (test-flan--check "the REPL shows an error"
                      (string-match-p "unknown name" (buffer-string)))
    ;; A value and the program's output travel by different routes: the value
    ;; is the result of the request, the output rides along with the reply.
    ;; Showing them in one place would be convenient and wrong.
    (goto-char (point-max))
    (insert "(println \"PRINTED\")")
    (flan-repl-return)
    (let ((deadline (+ (float-time) 15)))
      (while (and (not (with-current-buffer flan-dev-output-buffer
                         (string-match-p "PRINTED" (buffer-string))))
                  (< (float-time) deadline))
        (ignore-errors (flan-dev--request '(:op "describe")))
        (accept-process-output nil 0.05)))
    (test-flan--check "printed text goes to the output buffer"
                      (with-current-buffer flan-dev-output-buffer
                        (string-match-p "PRINTED" (buffer-string))))
    ;; ...and the prompt got the *value*, which for a call made for its effect
    ;; is Unit. The text it printed is not the value and does not belong here.
    (test-flan--check "and the prompt got the value, not the text"
                      (string-match-p "()" (buffer-string))))

  ;; ── The break loop ────────────────────────────────────────────────────
  ;;
  ;; An unhandled `error' stops the program on the frame that erred instead of
  ;; killing it, and this is the half of that an editor sees: it has to notice
  ;; without being told, say what stopped it, offer the restarts, and keep
  ;; working while the program sits there.  Last in this file because the
  ;; program is left running afterwards but its `step' has been through a
  ;; break, and nothing above should have to reason about that.

  ;; Refused while it is running, by name.  There is no restart stack to walk
  ;; from a running program, and an empty prompt would be worse than a refusal.
  (let ((raised nil))
    (condition-case err (flan-break)
      (user-error (setq raised (error-message-string err))))
    (test-flan--check "the prompt refuses while the program is running"
                      (and raised (string-match-p "running" raised))))

  ;; The poll is a real timer, registered on connect.  What it *does* is
  ;; checked below by calling it; that it is scheduled at all is checked here,
  ;; because a background discovery that nothing ever runs discovers nothing.
  (test-flan--check "a poll timer is running"
                    (and (timerp flan-dev--timer)
                         (eq (timer--function flan-dev--timer) #'flan-dev--poll)))

  ;; Break it: `step' is called every time round the program's loop, so a body
  ;; that errors stops it on its own game thread, in a frame of its own — not
  ;; inside anything this client asked for.  Nothing tells Emacs.
  (flan-dev--eval
   "(defn step [] i64 (restart-case (do (error (Missing {.id 7})) 0) (use-placeholder [] -1)))"
   "form")
  (let ((deadline (+ (float-time) 20)))
    (while (and (not flan-dev--stopped) (< (float-time) deadline))
      (flan-dev--poll)
      (accept-process-output nil 0.05)))
  (test-flan--check "the client notices a stop nobody asked about"
                    (equal flan-dev--stopped "Missing"))
  (test-flan--check "and the modeline says so, with the condition"
                    (and (eq (flan-dev-state) 'stopped)
                         (string-match-p "stopped" (flan-dev-mode-line))
                         (string-match-p "Missing" (flan-dev-mode-line))))

  ;; What the prompt would offer.  `completing-read' is not driven here — a
  ;; minibuffer in a batch run is a hang waiting to happen — so the list it
  ;; reads and the two commands it dispatches to are exercised instead.
  (test-flan--check "the restarts on offer are the ones the frame declared"
                    (equal (flan-dev-restarts) '("use-placeholder")))

  ;; And what it would put in front of someone.  The labels carry the position,
  ;; because the position is what gets chosen: two frames may offer the same
  ;; name and only a number can say which one.  A pure function over a reply,
  ;; so it is checked against the shapes a real daemon cannot easily be made to
  ;; produce as well as against the one it just did.
  (test-flan--check "the prompt numbers what it offers"
                    (equal (flan-dev--restart-candidates '("use-placeholder") nil)
                           '(("0. use-placeholder" . 0))))
  (test-flan--check "a shadowed name is two distinguishable choices"
                    (equal (mapcar #'cdr
                                   (flan-dev--restart-candidates
                                    '("retry" "use-placeholder" "retry") nil))
                           '(0 1 2)))
  (test-flan--check "a restart below the break is shown, and shown as such"
                    (let ((table (flan-dev--restart-candidates
                                  '("retry" "use-placeholder") '(1))))
                      (and (not (string-match-p "cannot be taken" (caar table)))
                           (string-match-p "cannot be taken" (car (nth 1 table)))
                           (equal (cdr (nth 1 table)) 1))))

  ;; The payoff.  The break loop *is* the poll loop, so an expression sent now
  ;; runs on the stopped thread and comes back — which is the one moment
  ;; anybody actually wants C-x C-e to work.
  (goto-char (point-max))
  (let ((beg (point)))
    (insert "\n(+ 20 3)")
    (let ((said (test-flan--said (flan-eval-last-sexp))))
      (test-flan--check "C-x C-e works while the program is stopped"
                        (and said (string-match-p "23" said))))
    (delete-region beg (point-max)))

  ;; And installing, which the break loop allows on purpose: there is no frame
  ;; in progress, so the rule against swapping a body that is on the stack does
  ;; not apply.  This is the fix-it-and-retry loop — the broken `step' is
  ;; replaced here, and the resume below returns into the old one for the last
  ;; time before every later call reaches the new body through its cell.
  (let ((said (test-flan--said
               (flan-dev--eval "(defn step [] i64 (set ticks (+ ticks 1)) ticks)"
                               "form"))))
    (test-flan--check "a fix installs while the program is stopped"
                      (and said (string-match-p "\\_<step\\_>" said))))

  ;; Choosing one.  "ok" from the daemon means accepted — the stopped thread
  ;; takes it on its next pass — so the client stops claiming a break and lets
  ;; the next poll settle it.
  ;; By position, which is the path `C-c C-b' takes: the name goes with it as
  ;; the receipt the program checks, not as the lookup.
  (flan-dev-restart-at 0 "use-placeholder")
  (let ((deadline (+ (float-time) 20)))
    (while (and (not (eq (flan-dev-state) 'live)) (< (float-time) deadline))
      (flan-dev--poll)
      (accept-process-output nil 0.05)))
  (test-flan--check "choosing a restart resumes the program"
                    (and (null flan-dev--stopped)
                         (eq (flan-dev-state) 'live)))

  ;; ...and the client is an ordinary client again on the far side of it.
  (goto-char (point-max))
  (let ((beg (point)))
    (insert "\n(+ 1 1)")
    (let ((said (test-flan--said (flan-eval-last-sexp))))
      (test-flan--check "and everything works again afterwards"
                        (and said (string-match-p "2" said))))
    (delete-region beg (point-max)))

  ;; ── The documentation buffer ──────────────────────────────────────────
  ;;
  ;; The same four facts `defs' carries, in a buffer: eldoc answers while you
  ;; are typing, and a signature in the echo area is gone the moment you do
  ;; anything else.  Run before the disconnect below, because it reads the
  ;; running program.
  (flan-doc "step")
  (with-current-buffer flan-doc-buffer
    (let ((text (buffer-string)))
      (test-flan--check "the doc buffer names the thing and its signature"
                        (and (string-match-p "\\`step" text)
                             (string-match-p "step \\[\\] i64" text)))
      (test-flan--check "and says what kind of thing it is"
                        (string-match-p "Kind +fn" text))
      ))
  ;; Where it is written, for a name that has not been re-installed from a
  ;; buffer since the daemon built it: `main' is still at the location the
  ;; daemon read it from, which is the ordinary case and the one with a
  ;; button on it.
  (flan-doc "main")
  (with-current-buffer flan-doc-buffer
    (test-flan--check "and where a definition is written"
                      (string-match-p
                       (regexp-quote (file-name-nondirectory program))
                       (buffer-string))))
  ;; A global has no Loc in the Tast, so the buffer says that in the same words
  ;; M-. refuses in — rather than leaving the line out, which reads as though
  ;; the name had no home at all.
  (flan-doc "ticks")
  (with-current-buffer flan-doc-buffer
    (test-flan--check "a global says why there is no location"
                      (string-match-p "no location for a var" (buffer-string))))
  (let ((raised nil))
    (condition-case err (flan-doc "no-such-name")
      (user-error (setq raised (error-message-string err))))
    (test-flan--check "and a name the program has not got is refused"
                      (and raised (string-match-p "no no-such-name" raised))))

  ;; ── The watch buffer ──────────────────────────────────────────────────
  ;;
  ;; test_dev.ml proves the table itself: a program pushes and the daemon reads
  ;; it back without compiling anything.  What is left to prove here is the
  ;; part that is only true in Emacs, and it is not the painting — it is that
  ;; an *asynchronous* sender and the ordinary synchronous request can share one
  ;; connection.
  ;;
  ;; The protocol is one reply per request on one socket.  The watch timer
  ;; sends and does not wait, deliberately, because waiting on a 0.2s timer
  ;; stalls the UI.  That leaves a reply in flight that the next C-c C-c would
  ;; read as its own — an evaluation reporting the watch table's answer, which
  ;; is the exact bug `flan-dev-settle-hook' exists to make impossible.  This
  ;; program writes nothing into the table, which does not matter: the
  ;; interleaving is the claim.
  (flan-watch)
  (test-flan--check "the watch buffer opens" (get-buffer flan-watch-buffer))
  (test-flan--check "and the timer is running" flan-watch--timer)
  (test-flan--check "a program that watches nothing says so, rather than looking broken"
                    (with-current-buffer flan-watch-buffer
                      (string-match-p "nothing is being watched" (buffer-string))))
  ;; The tick by hand, so this does not depend on a timer firing inside a batch
  ;; run.  Two of them: the first sends, the second collects and sends again.
  (flan-watch--tick)
  (test-flan--check "a tick leaves a request in flight rather than waiting for it"
                    flan-watch--pending)
  ;; And now the interleaving, with a reply outstanding on purpose.  If the
  ;; settle hook were not there this would return the watch table's plist and
  ;; `flan-dev--report' would take its missing :status for a rejection.
  ;;
  ;; Back in the source buffer first: `flan-doc' and `flan-watch' above both
  ;; display buffers of their own, and C-c C-c reads the buffer it is run in.
  (pop-to-buffer (flan-dev--buffer-visiting file))
  (goto-char (point-min))
  (search-forward "(defn step")
  (goto-char (match-beginning 0))
  (let ((said (test-flan--said (flan-eval-defun))))
    (test-flan--check "an eval with a watch reply in flight still gets its own answer"
                      (and said (string-match-p "step" said)))
    (test-flan--check "and the watch request was settled, not abandoned"
                      (null flan-watch--pending)))
  (flan-watch--tick)
  (flan-watch--tick)
  (test-flan--check "and the buffer keeps painting afterwards"
                    (with-current-buffer flan-watch-buffer
                      (> (buffer-size) 0)))
  ;; Point survives a repaint.  This is why `replace-buffer-contents' is used
  ;; rather than erase-and-insert: the latter would put the cursor back at the
  ;; top of the buffer on every tick, which makes the one thing you want to do
  ;; in a watch buffer — look at a line while the program runs — impossible.
  (with-current-buffer flan-watch-buffer
    (goto-char (point-max))
    (let ((where (point)))
      (flan-watch--tick)
      (flan-watch--tick)
      (test-flan--check "and point does not jump to the top on a repaint"
                        (= (point) where))))
  (flan-watch-stop)
  (test-flan--check "stopping cancels the timer" (null flan-watch--timer))
  (test-flan--check "and takes the settle hook off with it"
                    (not (memq #'flan-watch--settle flan-dev-settle-hook)))
  (kill-buffer flan-watch-buffer)

  (flan-disconnect)
  (test-flan--check "disconnected" (not (process-live-p flan-dev--connection)))
  (test-flan--check "and the poll timer is cancelled with it"
                    (null flan-dev--timer))

  ;; ── Starting the daemon from Emacs ────────────────────────────────────
  ;;
  ;; Last, and after the disconnect above, because it runs a *second* daemon:
  ;; nothing before this should have to reason about which of two programs a
  ;; request went to.  Its own socket for the same reason — and because
  ;; `flan dev' with no -s puts one beside the program, which for a test
  ;; program in /tmp is a path shared with every other thing running there.
  (setq flan-dev-command flan)
  (let ((socket2 (concat socket "-started-from-emacs")))
    (ignore-errors (delete-file socket2))
    (test-flan--check "nothing to quit before anything was started"
                      (let ((raised nil))
                        (condition-case err (flan-dev-quit)
                          (user-error (setq raised (error-message-string err))))
                        (and raised (string-match-p "no daemon started" raised))))
    (flan-dev program socket2)
    (test-flan--check "M-x flan-dev builds, launches and connects"
                      (and (process-live-p flan-dev--daemon)
                           (eq (flan-dev-state) 'live)))
    (test-flan--check "and it is the program that was asked for"
                      (member "step" (plist-get (flan-dev--request '(:op "describe"))
                                                :fns)))
    ;; Refused rather than silently restarted: a second daemon would take the
    ;; first one's program and everything in its memory with it.
    (test-flan--check "a second one is refused while the first is alive"
                      (let ((raised nil))
                        (condition-case err (flan-dev program socket2)
                          (user-error (setq raised (error-message-string err))))
                        (and raised (string-match-p "already running" raised))))
    ;; The daemon owns the program's lifetime, so quitting has to actually end
    ;; the process — not just drop the socket and leave it running.
    ;; Restarting the program: for a change the running one cannot take — a
    ;; struct whose layout moved — where the answer is a new build, a new
    ;; process and the session that compiled it.  Proved by what it throws
    ;; away: a name installed into the old program is not in the new one.
    (flan-dev--eval "(defn only-in-the-old-program [] i64 1)" "form")
    (test-flan--check "a name installed into the running program is there"
                      (assoc "only-in-the-old-program" flan-dev--defs))
    (let ((old flan-dev--daemon))
      (flan-dev-restart-program)
      (test-flan--check "restarting gives a different daemon, connected"
                        (and (not (process-live-p old))
                             (process-live-p flan-dev--daemon)
                             (not (eq old flan-dev--daemon))
                             (eq (flan-dev-state) 'live))))
    (test-flan--check "and a program built from source, without the addition"
                      (and (assoc "step" flan-dev--defs)
                           (null (assoc "only-in-the-old-program"
                                        flan-dev--defs))))

    (let ((proc flan-dev--daemon))
      (flan-dev-quit)
      ;; The process, not the variable: forgetting a daemon is not stopping
      ;; one, and a program left running with nothing attached to it is
      ;; exactly what the terminal loop used to leave behind.
      (test-flan--check "quitting ends the daemon"
                        (and (not (process-live-p proc))
                             (null flan-dev--daemon)
                             (not (process-live-p flan-dev--connection))
                             (eq (flan-dev-state) 'off)))
      ;; The daemon unlinks its socket on the way out, so this is the same
      ;; claim seen from the other side.
      (test-flan--check "and takes its socket with it"
                        (not (file-exists-p socket2))))
    (ignore-errors (delete-file socket2)))

  ;; A program that does not exist is refused here rather than by a daemon
  ;; that starts, fails to build and exits — which looks the same from a
  ;; distance and takes a compile to find out.
  (test-flan--check "a file that is not there is refused before anything starts"
                    (let ((raised nil))
                      (condition-case err (flan-dev "/nonexistent/nope.flan")
                        (user-error (setq raised (error-message-string err))))
                      (and raised (string-match-p "no such file" raised))))

  ;; ── Navigating a file ─────────────────────────────────────────────────
  ;;
  ;; No daemon in any of this: imenu and which-function read the buffer, which
  ;; is the point — they work on a file nobody has run yet, and they keep
  ;; working when the program is stopped or gone.
  (with-temp-buffer
    (insert ";;;; A file with one of everything.\n"
            "(defstruct Missing [id i32])\n"
            "(defvar ticks i64)\n"
            "(defconst limit i64 10)\n"
            "(declare later [] i64)\n"
            "(defn step [] i64\n"
            "  (let [x 1]\n"
            "    (defn not-top-level [] i64 2)\n"
            "    (+ ticks x)))\n")
    (flan-mode)
    (let* ((index (imenu--make-index-alist))
           (group (lambda (name) (cdr (assoc name index)))))
      (test-flan--check "imenu finds a function, where it is written"
                        (equal (marker-position
                                (cdr (assoc "step" (funcall group "Functions"))))
                               (save-excursion (goto-char (point-min))
                                               (search-forward "(defn step")
                                               (match-beginning 0))))
      (test-flan--check "and a struct, under its own heading"
                        (assoc "Missing" (funcall group "Types")))
      (test-flan--check "and both kinds of global"
                        (and (assoc "ticks" (funcall group "Variables"))
                             (assoc "limit" (funcall group "Variables"))))
      ;; A forward declaration is not a definition; listing it beside one
      ;; would show the same name twice with nothing to tell them apart.
      (test-flan--check "and a declaration, said to be one"
                        (and (assoc "later" (funcall group "Declared"))
                             (null (assoc "later" (funcall group "Functions")))))
      ;; A `defn' inside a `let' defines nothing at the top level, and the
      ;; index is anchored at column 0 so that it cannot offer one.
      (test-flan--check "and nothing that is not a top-level form"
                        (null (assoc "not-top-level" (funcall group "Functions")))))
    ;; which-function: the case is a long body scrolled past its own header.
    (goto-char (point-min))
    (search-forward "(+ ticks x)")
    (test-flan--check "which-function names the definition point is in"
                      (equal (flan-current-defun-name) "step"))
    (goto-char (point-min))
    (test-flan--check "and says nothing above the first one"
                      (null (flan-current-defun-name))))

  ;; ── A rejection lasts as long as the action it was about ──────────────
  ;;
  ;; The overlay is feedback on the evaluation that just failed, so the next
  ;; command in that buffer takes it down.  What is checked here is the
  ;; mechanism and not Emacs' command loop: `execute-kbd-macro' under --batch
  ;; runs no `pre-command-hook' at all (and does not even move point), so there
  ;; is no way from here to make the real loop run one.  `run-hooks' is what
  ;; the loop calls, and calling it is the closest honest thing — it proves the
  ;; hook is installed, in the right buffer and nowhere else, and that running
  ;; it clears the overlay and uninstalls itself.  It does not prove Emacs runs
  ;; it, which is Emacs' own contract.
  (let ((buf (flan-dev--buffer-visiting file)))
    (with-current-buffer buf
      (flan-dev-clear-errors)
      (let ((marked (flan-dev--show-error (format "%s:2:1" file) "no such name")))
        (test-flan--check "a rejection is marked in the buffer it came from"
                          (and marked (flan-dev--error-overlays)))
        (test-flan--check "and the buffer is armed to take it down again"
                          (memq #'flan-dev--clear-errors-on-command
                                pre-command-hook))
        ;; Buffer-local, or every buffer in the session runs this on every
        ;; keystroke for the sake of a buffer that had one bad evaluation.
        (test-flan--check "and nobody else is"
                          (not (memq #'flan-dev--clear-errors-on-command
                                     (default-value 'pre-command-hook))))
        (run-hooks 'pre-command-hook)
        (test-flan--check "the next command in that buffer clears it"
                          (null (flan-dev--error-overlays)))
        (test-flan--check "and the hook goes with the last overlay"
                          (not (memq #'flan-dev--clear-errors-on-command
                                     pre-command-hook))))))

  ;; ── Disassembly ───────────────────────────────────────────────────────
  ;;
  ;; Its own daemon, because the first one was disconnected above and a
  ;; disassembly is a question only a live session can answer: the daemon is
  ;; the thing that built the module and still has the .ll and the .so.
  (let ((socket3 (concat socket "-disasm")))
    (ignore-errors (delete-file socket3))
    (flan-dev program socket3)
    (test-flan--check "a daemon to disassemble against"
                      (process-live-p flan-dev--connection))

    (when (executable-find "objdump")
      (flan-disassemble "step")
      (with-current-buffer flan-disassembly-buffer
        (let ((text (buffer-string)))
          (test-flan--check "C-c C-a writes a disassembly of the name"
                            (string-match-p "\\`; disassembly for step" text))
          ;; The header is the half a listing cannot carry: what the answer
          ;; claims, which for generated code is never "this is running".
          (test-flan--check "with the daemon's own account of what it shows"
                            (string-match-p "showing" text))
          (test-flan--check "and instructions under it, numbered from zero"
                            (string-match-p "^  0000  " text)))))

    ;; The other half of the same question, on the same body.
    (flan-disassemble "step" t)
    (with-current-buffer flan-disassembly-buffer
      (let ((text (buffer-string)))
        (test-flan--check "C-u C-c C-a writes the IR it was built from"
                          (and (string-match-p "\\`; LLVM IR for step" text)
                               (string-match-p "^define .*flan\\.step" text)))
        ;; Nothing has been evaluated into this daemon, so the body in the
        ;; cell is still the one the process was launched with — the one case
        ;; where what is installed *now* is knowable, and it says so.
        (test-flan--check "and says the program is still running the host's copy"
                          (string-match-p "host executable" text))))

    ;; Refused by name rather than shown as an empty buffer.
    (test-flan--check "a name the program does not define is refused by name"
                      (let ((raised nil))
                        (condition-case err (flan-disassemble "no-such-thing")
                          (user-error (setq raised (error-message-string err))))
                        (and raised (string-match-p "no function named" raised))))
    (test-flan--check "and so is a global, which has no code to show"
                      (let ((raised nil))
                        (condition-case err (flan-disassemble "ticks")
                          (user-error (setq raised (error-message-string err))))
                        (and raised (string-match-p "not a function" raised))))

    (flan-dev-quit)
    (ignore-errors (delete-file socket3)))

  ;; ── Marking a form with (pause) ───────────────────────────────────────
  ;;
  ;; DISCUSS.md §9: `C-u' before an evaluation marks a form so the program
  ;; stops when it runs, and the buffer is never edited — the position goes on
  ;; the wire beside the code and the daemon splices the call in after parsing.
  ;;
  ;; Last in this file on purpose: the one live check here *stops the program*,
  ;; and everything above it needs one that is running.
  ;;
  ;; Three things are the client's own and need no daemon at all: which form a
  ;; prefix argument picks, the byte column that names it, and the fact that a
  ;; mark outlives the next command where a rejection does not.
  (with-temp-buffer
    (flan-mode)
    (insert "(defvar ticks i64)\n\n(defn step [] i64\n  (set ticks (+ ticks 1))\n  ticks)\n")
    (goto-char (point-min))
    (search-forward "(+ ticks 1)")
    (goto-char (1- (match-end 0)))       ; inside the (+ ...), before its ")"
    (let* ((b (flan-dev--defun-bounds))
           (inner (flan-dev--pause-bounds b '(4)))
           (whole (flan-dev--pause-bounds b '(16))))
      (test-flan--check "no prefix marks nothing"
                        (null (flan-dev--pause-bounds b nil)))
      (test-flan--check "C-u marks the form point is inside"
                        (equal (buffer-substring-no-properties
                                (car inner) (cdr inner))
                               "(+ ticks 1)"))
      ;; A `defn' is a declaration and cannot be wrapped in a `do', so the
      ;; daemon reads the top-level form's own position as "stop on entry".
      (test-flan--check "C-u C-u marks the top-level form itself"
                        (equal whole b)))
    ;; Point at the very start of the defn is not nested inside anything, and
    ;; `backward-up-list' would either fail or walk somewhere surprising.  It
    ;; falls back to the defun, which is the only honest answer.
    (goto-char (point-min))
    (search-forward "(defn step")
    (goto-char (match-beginning 0))
    (let ((b (flan-dev--defun-bounds)))
      (test-flan--check "and a prefix with point not nested falls back to it"
                        (equal (flan-dev--pause-bounds b '(4)) b)))
    ;; The column is a byte offset, because the reader walks the source a byte
    ;; at a time.  Same rule as the `:loc' column, the other way round — and
    ;; `flan-dev--position' is the inverse, so a round trip is the check.
    (goto-char (point-min))
    (search-forward "(+ ticks 1)")
    (let* ((pos (match-beginning 0))
           (lc (flan-dev--wire-position pos)))
      (test-flan--check "a marked position round-trips through the wire"
                        (= (flan-dev--position (nth 0 lc) (nth 1 lc)) pos)))
    (with-temp-buffer
      (insert ";; héllo\n(defn wörld [] i64 (+ 1 1))\n")
      (goto-char (point-min))
      (search-forward "(+ 1 1)")
      (test-flan--check "and counts bytes, not characters, past a non-ASCII one"
                        (equal (flan-dev--wire-position (match-beginning 0))
                               (list 2 (1+ (string-bytes "(defn wörld [] i64 ")))))))

  ;; A mark is an annotation on the running program and not feedback about one
  ;; command, so unlike a rejection it has to survive the next keystroke.  That
  ;; difference is the whole of its lifetime, and it is checked here the same
  ;; way the rejection's is: by calling what the command loop calls.
  (with-temp-buffer
    (flan-mode)
    (insert "(defn step [] i64 (+ 1 1))\n")
    (goto-char (point-min))
    (search-forward "(+ 1 1)")
    (flan-dev--show-pause (match-beginning 0) (match-end 0))
    (test-flan--check "a mark is drawn over the form"
                      (= 1 (length (flan-dev--pause-overlays))))
    (run-hooks 'pre-command-hook)
    (test-flan--check "and survives the next command, where a rejection would not"
                      (= 1 (length (flan-dev--pause-overlays))))
    ;; Re-marking the same form leaves one, not two stacked overlays whose
    ;; faces compound into something that is not the face.
    (flan-dev--show-pause (match-beginning 0) (match-end 0))
    (test-flan--check "and marking it again leaves one mark, not two"
                      (= 1 (length (flan-dev--pause-overlays))))
    (flan-dev-clear-pause)
    (test-flan--check "and clearing takes it down"
                      (null (flan-dev--pause-overlays))))

  ;; And once against a real daemon: the round trip, the overlay drawn off the
  ;; reply's `:pause' rather than off what was asked for, and the mark coming
  ;; down again when the same form is evaluated plainly.
  (let ((socket4 (concat socket "-pause")))
    (ignore-errors (delete-file socket4))
    (flan-dev program socket4)
    (test-flan--check "a daemon to mark a form in"
                      (process-live-p flan-dev--connection))
    (with-temp-buffer
      (flan-mode)
      (insert "(defn step [] i64\n  (set ticks (+ ticks 1))\n  ticks)\n")
      (goto-char (point-min))
      (search-forward "(+ ticks 1)")
      (goto-char (1- (match-end 0)))
      (flan-eval-defun '(4))
      (let ((ovs (flan-dev--pause-overlays)))
        (test-flan--check "C-u C-c C-c marks the form point is inside"
                          (and (= 1 (length ovs))
                               (equal (buffer-substring-no-properties
                                       (overlay-start (car ovs))
                                       (overlay-end (car ovs)))
                                      "(+ ticks 1)")))
        (test-flan--check "and marks it as a pause, not as an error"
                          (and ovs
                               (eq (overlay-get (car ovs) 'face)
                                   'flan-dev-pause-face))))
      ;; The program calls `step' every few milliseconds, so it stops almost at
      ;; once — but "almost" is not "before this line", so wait for it.
      (let ((tries 400))
        (while (and (> tries 0) (not (eq (flan-dev-state) 'stopped)))
          (setq tries (1- tries))
          (flan-dev--request (list :op "describe"))
          (sleep-for 0.005)))
      (test-flan--check "and the program stops there"
                        (eq (flan-dev-state) 'stopped))
      ;; A plain `C-c C-c' over the same form replaces the stored declaration
      ;; with an unmarked one, which is what makes the mark stop sticking — and
      ;; the overlay has to go with it or the buffer is claiming a breakpoint
      ;; the daemon no longer has.  Allowed while stopped: there is no frame in
      ;; progress for `step'.
      (flan-eval-defun)
      (test-flan--check "and an ordinary C-c C-c takes the mark down again"
                        (null (flan-dev--pause-overlays)))
      ;; Left running, because the next thing this file does is finish and the
      ;; daemon's program is killed with it — but a test that ends with the
      ;; program parked is one nobody can add anything after.
      (flan-dev-restart "continue")
      (let ((tries 400))
        (while (and (> tries 0) (eq (flan-dev-state) 'stopped))
          (setq tries (1- tries))
          (flan-dev--request (list :op "describe"))
          (sleep-for 0.005)))
      (test-flan--check "and it resumes when continue is taken"
                        (not (eq (flan-dev-state) 'stopped))))
    (flan-dev-quit)
    (ignore-errors (delete-file socket4)))

  ;; ── C-c C-m: what a macro call expands to ─────────────────────────────
  ;;
  ;; test_session.ml drives the expansion itself and is where the language
  ;; cases live.  What this adds is the half that is only true in an editor:
  ;; which region the command picks, that the expansion arrives as readable
  ;; source in a buffer, that expanding again in place works, and — the one
  ;; worth a real daemon — that a macro which never settles comes back as a
  ;; refusal drawn on the call, at its own line *and its own column*.
  ;;
  ;; That last one is what `flan-dev--text-at' exists for.  `C-x C-e' sends a
  ;; raw substring and `flan-dev--text' pads lines only, because a top-level
  ;; form starts at column 1; a macro call is written well inside a line, and
  ;; a refusal against it would otherwise be drawn at the start of that line.
  (let ((socket5 (concat socket "-macro")))
    (ignore-errors (delete-file socket5))
    (flan-dev program socket5)
    (test-flan--check "a daemon to expand macros against"
                      (process-live-p flan-dev--connection))
    (with-current-buffer (get-file-buffer file)
      (goto-char (point-max))
      (insert "\n(defn expandable [] i32\n  (unless false 1 2)\n  (clamp 9 0 3))\n")
      ;; One step, on a prelude macro.  Point on the opening paren, which is
      ;; where a reader puts it and which `C-x C-e' could not use.
      (goto-char (point-max))
      (search-backward "(unless false 1 2)")
      (flan-macroexpand)
      (test-flan--check
       "C-c C-m expands the form point is on"
       (with-current-buffer flan-macroexpansion-buffer
         (string-match-p "(if (not false)" (buffer-string))))
      (test-flan--check
       "and says which macro ran"
       (with-current-buffer flan-macroexpansion-buffer
         (string-match-p "macro +unless" (buffer-string))))
      (test-flan--check
       "and the buffer is Flan source, not a dump"
       (with-current-buffer flan-macroexpansion-buffer
         (and (derived-mode-p 'flan-mode) buffer-read-only)))
      ;; The three keys that would send an expansion back as though it were a
      ;; file refuse by name rather than doing nothing.
      (test-flan--check
       "C-c C-c in the expansion buffer refuses, and says why"
       (with-current-buffer flan-macroexpansion-buffer
         (condition-case e (progn (call-interactively
                                   (key-binding (kbd "C-c C-c")))
                                  nil)
           (user-error (string-match-p "not source" (error-message-string e))))))
      ;; All the way, off the same key with a prefix.
      (goto-char (point-max))
      (search-backward "(clamp 9 0 3)")
      (flan-macroexpand t)
      (test-flan--check
       "C-u C-c C-m expands all the way"
       (with-current-buffer flan-macroexpansion-buffer
         (and (string-match-p "all the way" (buffer-string))
              (string-match-p (regexp-quote "(min 3 (max 0 9))")
                              (buffer-string)))))
      ;; A macro that never settles, evaluated into the session and then asked
      ;; about.  One step answers — it makes one call and does not look at what
      ;; comes back — and all the way is refused at the bound rather than
      ;; hanging the daemon, which is the failure that would wedge the editor
      ;; with the program still on screen.
      (flan-dev--request
       (list :op "eval" :file file
             :code "(defmacro spinner [args] `(spinner ~@args))"))
      (goto-char (point-max))
      (insert "\n(defn spun [] i32\n  (spinner 1))\n")
      (goto-char (point-max))
      (search-backward "(spinner 1)")
      (let ((call (point))
            (r (flan-macroexpand)))
        (test-flan--check
         "one step of a macro that does not settle answers"
         (and (null (plist-get r :expanded))
              (equal (plist-get r :macro) "spinner")))
        (flan-dev-clear-errors)
        (goto-char call)
        (let ((said (condition-case e (progn (flan-macroexpand t) nil)
                      (user-error (error-message-string e)))))
          (test-flan--check
           "and all the way is refused rather than hanging"
           (and said (string-match-p "did not settle" said)))
          ;; The whole of `flan-dev--text-at': the refusal's location is the
          ;; call's own line and column, so the overlay lands on the call and
          ;; not at the start of the line it is written on.
          (let ((ovs (flan-dev--error-overlays)))
            (test-flan--check
             "and the refusal is drawn on the call, at its own column"
             (and (= 1 (length ovs))
                  (= (overlay-start (car ovs)) call)))))
        (flan-dev-clear-errors))

      ;; Expanding again in place, which is what makes one-step-by-default
      ;; usable rather than a thing you press once and lose.  Two macros into
      ;; the session, the outer one quasiquoting a call to the inner: that is
      ;; the shape where one step leaves a macro call standing, and it is the
      ;; only shape where expanding in place has anything to do.
      (flan-dev--request
       (list :op "eval" :file file
             :code "(defmacro m-inner [args] `(+ ~(at args 0) 1))"))
      (flan-dev--request
       (list :op "eval" :file file
             :code "(defmacro m-outer [args] `(m-inner ~(at args 0)))"))
      (goto-char (point-max))
      (insert "\n(defn outered [] i32 (m-outer 5))\n")
      (goto-char (point-max))
      (search-backward "(m-outer 5)")
      (flan-macroexpand)
      (test-flan--check
       "one step leaves the call to the macro it quasiquoted"
       (with-current-buffer flan-macroexpansion-buffer
         (string-match-p (regexp-quote "(m-inner 5)") (buffer-string))))
      (with-current-buffer flan-macroexpansion-buffer
        (goto-char (point-min))
        (search-forward "(m-inner 5)")
        (goto-char (match-beginning 0))
        (flan-macroexpand-again)
        (test-flan--check
         "m in the expansion buffer expands the form at point in place"
         (and (string-match-p (regexp-quote "(+ 5 1)") (buffer-string))
              (not (string-match-p (regexp-quote "(m-inner 5)")
                                   (buffer-string))))))
      ;; And the same call taken all the way in one go, which is the half the
      ;; prefix argument is for: no intermediate at all.
      (goto-char (point-max))
      (search-backward "(m-outer 5)")
      (flan-macroexpand t)
      (test-flan--check
       "C-u goes straight to the fixpoint"
       (with-current-buffer flan-macroexpansion-buffer
         (and (string-match-p (regexp-quote "(+ 5 1)") (buffer-string))
              (not (string-match-p (regexp-quote "(m-inner 5)")
                                   (buffer-string)))))))
    (flan-dev-quit)
    (ignore-errors (delete-file socket5)))

  (if (zerop test-flan--failures)
      (message "flan-dev.el: all tests passed")
    (message "\n%d failure(s)" test-flan--failures)
    (kill-emacs 1)))

;;; test-flan-dev.el ends here