;;; test-flan-cider.el --- The inspector and break buffers, from fixtures  -*- lexical-binding: t; -*-

;; Run as:  emacs -Q --batch -L emacs -l emacs/test-flan-cider.el
;;
;; Nothing here needs a daemon or a running program, and that is deliberate
;; rather than a shortcut.  Both buffers are functions from *a reply's data* to
;; *text with properties on it*, and the interesting failures are all on that
;; side: a struct the reader mis-parses, a shadowed restart drawn as though it
;; could be chosen, a section quietly omitted instead of refused.  Driving it
;; from fixtures tests exactly that, and it tests the cases a live program
;; cannot easily be made to produce — a value past the renderer's depth bound,
;; two restarts with one name, a frame with locals in it at all.
;;
;; The fixtures are not invented.  Every rendered string below is the shape
;; `Session.render' writes, case by case, and the comment on each says which.

;;; Code:

(require 'flan-inspect)
(require 'flan-cnr)
;; For `flan-dev--auto-break', which is a decision about globals and windows
;; and needs neither a daemon nor a socket to be asked.
(require 'flan-dev)

(defvar test-flan--failures 0)
(defvar test-flan--ran 0)

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

(defun test-flan--text (thunk)
  "Run THUNK in a scratch buffer and return what it drew."
  (with-temp-buffer
    (funcall thunk)
    (buffer-substring-no-properties (point-min) (point-max))))

(defun test-flan--caught (thunk)
  "The message of the error THUNK signals, or nil if it does not."
  (condition-case e (progn (funcall thunk) nil)
    (error (error-message-string e))))


;;; The reader

(message "\nreading what the renderer wrote")

;; (V {.x 1.5 .y 0}) — Types.Named, lib/session.ml.
(let ((n (flan-inspect-parse "(V {.x 1.5 .y 0})")))
  (test-flan--check "a struct is a struct" (eq (plist-get n :kind) 'struct))
  (test-flan--check "with its type name" (equal (plist-get n :type) "V"))
  (test-flan--check "and its fields in order"
                    (equal (mapcar #'car (plist-get n :children)) '("x" "y")))
  (test-flan--check "carrying their values"
                    (equal (plist-get (cdr (assoc "x" (plist-get n :children))) :text)
                           "1.5")))

;; The whole of NEXT.md's worked example, nested two deep with a string that
;; has escaped quotes in it and a slice at the end.
(let* ((src "(Blob {.id 7 .name \"sandy \\\"quoted\\\"\" .pos (V {.x 1.5 .y 0}) .tags [ 0 42 0]})")
       (n (flan-inspect-parse src))
       (kids (plist-get n :children)))
  (test-flan--check "every field of a nested struct"
                    (equal (mapcar #'car kids) '("id" "name" "pos" "tags")))
  (test-flan--check "an escaped quote does not end the string early"
                    (equal (plist-get (cdr (assoc "name" kids)) :text)
                           "\"sandy \"quoted\"\""))
  (test-flan--check "a struct inside a struct"
                    (equal (plist-get (cdr (assoc "pos" kids)) :type) "V"))
  (test-flan--check "a slice inside a struct, with its elements"
                    (equal (mapcar #'car (plist-get (cdr (assoc "tags" kids)) :children))
                           '(0 1 2))))

;; [ 0 42 0] — Types.Slice and Types.Array both write this.
(let ((n (flan-inspect-parse "[ 0 42 0]")))
  (test-flan--check "a sequence is a sequence" (eq (plist-get n :kind) 'seq))
  (test-flan--check "indexed from zero"
                    (equal (mapcar #'car (plist-get n :children)) '(0 1 2))))

;; [ [ 0 0] [ 1 ...] ...] — span truncation at both levels, which is what
;; sand's [100 [100 u32]] actually produces.
(let* ((n (flan-inspect-parse "[ [ 0 0] [ 1 ...] ...]"))
       (kids (plist-get n :children)))
  (test-flan--check "a trailing ... is truncation, not an element"
                    (and (= (length kids) 2) (plist-get n :truncated)))
  (test-flan--check "and it is noticed on the inner sequence too"
                    (plist-get (cdr (nth 1 kids)) :truncated)))

;; The renderer's refusals, each of which becomes a leaf here.
(test-flan--check "a pointer is a pointer"
                  (eq (plist-get (flan-inspect-parse "<ptr>") :kind) 'ptr))
(test-flan--check "a type the walk had no structure for"
                  (eq (plist-get (flan-inspect-parse "<Widget>") :kind) 'opaque))
(test-flan--check "the depth bound"
                  (eq (plist-get (flan-inspect-parse "...") :kind) 'trunc))
(test-flan--check "an option"
                  (eq (plist-get (flan-inspect-parse "(some 3)") :kind) 'option))
(test-flan--check "an enum member is an atom, not a field"
                  (eq (plist-get (flan-inspect-parse ":blue") :kind) 'atom))
(test-flan--check "and so is a u64 that fills the range"
                  (equal (plist-get (flan-inspect-parse "18446744073709551615") :text)
                         "18446744073709551615"))

;; A struct with a `...' where a field would be: span truncation *inside* a
;; struct, which is a different position in the grammar from a sequence's.
(let ((n (flan-inspect-parse "(Wide {.a 1 .b 2 ...})")))
  (test-flan--check "a struct's span bound is truncation, not a field"
                    (and (equal (mapcar #'car (plist-get n :children)) '("a" "b"))
                         (plist-get n :truncated))))


;;; Where a field is, said in Flan

(message "\nthe path is an expression")

(test-flan--check "a field is a field accessor"
                  (equal (flan-inspect-step-expr "b" '(:field "pos")) "(.pos b)"))
(test-flan--check "an element is `at'"
                  (equal (flan-inspect-step-expr "(.tags b)" '(:index 2))
                         "(at (.tags b) 2)"))
(test-flan--check "and they compose, which is the whole trick"
                  (equal (flan-inspect-step-expr
                          (flan-inspect-step-expr "b" '(:field "pos")) '(:field "x"))
                         "(.x (.pos b))"))


;;; Refusals, by name, with the reason

(message "\nwhat cannot be entered says so")

(dolist (case '(("<ptr>" "pointer") ("..." "depth bound") ("7" "atom")
                ("(some 3)" "accessor form") ("<Widget>" "no structure")))
  (let ((why (flan-inspect-refusal (flan-inspect-parse (car case)))))
    (test-flan--check (format "%s refuses, naming %s" (car case) (cadr case))
                      (and why (string-match-p (regexp-quote (cadr case)) why)))))

(test-flan--check "a struct with fields does not refuse"
                  (null (flan-inspect-refusal (flan-inspect-parse "(V {.x 1 .y 2})"))))

(test-flan--check "and a pointer says the address is not there either"
                  (string-match-p "does not write the address"
                                  (flan-inspect-refusal
                                   (flan-inspect-parse "<ptr>"))))


;;; What a number reads as in the other two bases

;; Arithmetic on text the renderer already wrote: nothing is asked of the
;; program, which is why these need no daemon and no fixture beyond the string.

(message "\na number in the other bases")

(dolist (case '(("255" "0xFF" "0b1111_1111")
                ("0" "0x0" "0b0")
                ("7" "0x7" "0b0111")
                ;; sand.flan's world-edge colour, which is the case this is for:
                ;; written 0x303030FF in the source and decimal everywhere else.
                ("808464639" "0x303030FF" "0b0011_0000_0011_0000_0011_0000_1111_1111")))
  (let ((detail (flan-inspect--detail (flan-inspect-parse (nth 0 case)))))
    (test-flan--check (format "%s is %s" (nth 0 case) (nth 1 case))
                      (and detail (string-match-p (regexp-quote (nth 1 case)) detail)))
    (test-flan--check (format "%s is %s" (nth 0 case) (nth 2 case))
                      (and detail (string-match-p (regexp-quote (nth 2 case)) detail)))))

;; A negative is the 64-bit two's complement it is in memory, and says so: the
;; rendered value carries no width, and every Flan integer comes back through
;; i64, so 64 is the one that can be stated honestly.
(let ((detail (flan-inspect--detail (flan-inspect-parse "-1"))))
  (test-flan--check "a negative is two's complement, at a stated width"
                    (and detail
                         (string-match-p "0xFFFFFFFFFFFFFFFF" detail)
                         (string-match-p "64-bit" detail))))

;; The whole u64 range, which is past a fixnum and relies on bignums.
(test-flan--check "a u64 at the top of its range"
                  (string-match-p
                   "0xFFFFFFFFFFFFFFFF"
                   (or (flan-inspect--detail
                        (flan-inspect-parse "18446744073709551615")) "")))

;; Not everything that looks numeric is one.  A float's bits are an IEEE layout
;; and the rendered text does not carry the width to reinterpret them, so it is
;; left alone rather than answered wrongly.
(dolist (text '("1.5" "-0.25" "true" ":green" "none" "..." "<ptr>" "\"7\""))
  (test-flan--check (format "%s has no other base" text)
                    (null (flan-inspect--detail (flan-inspect-parse text)))))

;; And it reaches the buffer, in both places it is drawn: the header of a value
;; opened on its own, and the field list where a leaf can only ever be seen.
(let ((flan-inspect-request-function
       (lambda (_) '(:status "ok" :value "255")))
      (flan-inspect-buffer " *test-inspect*"))
  (let ((text (with-current-buffer (save-window-excursion (flan-inspect "flags"))
                (buffer-string))))
    (test-flan--check "a number opened on its own shows its bases"
                      (string-match-p "0xFF  0b1111_1111" text))))

(let ((flan-inspect-request-function
       (lambda (_) '(:status "ok" :value "(Mask {.bits 255 .name \"all\"})")))
      (flan-inspect-buffer " *test-inspect*"))
  (let ((text (with-current-buffer (save-window-excursion (flan-inspect "m"))
                (buffer-string))))
    (test-flan--check "and a numeric field shows them in the field list"
                      (string-match-p "\\.bits +255 +0xFF  0b1111_1111" text))
    (test-flan--check "while a string field is left alone"
                      (string-match-p "\\.name +\"all\"\n" text))))


;;; The address root, and the registry listings

(message "\nthe address root")

;; The rooting mode with no frame in it. What is asserted here is the *wire*:
;; the buffer sends `at' with the address, sends `:type' only when one was
;; named, and refuses a path rather than dropping it. What the daemon does
;; with that is test_dev.ml's business, over a real program.

(let* ((sent nil)
       (flan-inspect-request-function
        (lambda (form) (setq sent form) '(:status "ok" :value "<ptr (Enemy {.hp 41 .x 2})>"
                                          :type "(Ptr Enemy)" :live t :recorded "Enemy")))
       (flan-inspect-buffer " *test-inspect*"))
  (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
  (let ((text (with-current-buffer
                  (save-window-excursion
                    (flan-inspect--show (list :addr 4096 nil) nil))
                (buffer-string))))
    (test-flan--check "an address root asks the daemon for `at'"
                      (equal (plist-get sent :op) "at"))
    (test-flan--check "with the address"
                      (equal (plist-get sent :addr) 4096))
    ;; Absent and not empty: leaving it out is what makes the registry answer
    ;; for the type, which is the whole of what the address root buys.
    (test-flan--check "and no :type when none was named"
                      (null (plist-get sent :type)))
    (test-flan--check "the address is named in hex at the top"
                      (string-match-p "#x1000" text))))

(let* ((sent nil)
       (flan-inspect-request-function
        (lambda (form) (setq sent form) '(:status "ok" :value "<ptr 41>" :type "(Ptr i32)")))
       (flan-inspect-buffer " *test-inspect*"))
  (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
  (let ((text (with-current-buffer
                  (save-window-excursion
                    (flan-inspect--show (list :addr 4096 "i32") nil))
                (buffer-string))))
    (test-flan--check "a named type is sent as :type"
                      (equal (plist-get sent :type) "i32"))
    (test-flan--check "and shown beside the address"
                      (string-match-p "#x1000 as i32" text))))

;; A path is refused rather than dropped. A path with a step silently gone
;; would render a different value and say nothing, which is the failure the
;; whole buffer is built to avoid.
(let ((flan-inspect-request-function
       (lambda (_) '(:status "ok" :value "<ptr 41>"))))
  (test-flan--check "an address root refuses a path"
                    (eq 'caught
                        (condition-case nil
                            (flan-inspect--value (list :addr 4096 nil) '((:field "x")))
                          (user-error 'caught)))))

;; And a followed pointer is refused for the true reason rather than for "no
;; structure": it has structure, it is drawn, and the step would be a second
;; deref nobody asked about.
(test-flan--check "a followed pointer says why it cannot be entered"
                  (string-match-p
                   "second deref"
                   (flan-inspect-refusal
                    (flan-inspect-parse "<ptr (Enemy {.hp 41 .x 2})>"))))

(message "\nthe registry listings")

(let* ((sent nil)
       (flan-dev--request-stub
        (lambda (form)
          (setq sent form)
          '(:status "ok"
            :types (("Enemy" 2 64) ("i32" 1 16))
            :blocks 3 :bytes 80 :overflow nil
            :note "every block the registry recorded"))))
  (cl-letf (((symbol-function 'flan-dev--request) flan-dev--request-stub)
            ((symbol-function 'display-buffer) #'ignore))
    (let ((flan-allocations-buffer " *test-allocations*"))
      (flan-allocations)
      (test-flan--check "the breakdown asks for `allocations'"
                        (equal (plist-get sent :op) "allocations"))
      (let ((text (with-current-buffer " *test-allocations*" (buffer-string))))
        (test-flan--check "and lists each type with its blocks and bytes"
                          (string-match-p "2 +64 +Enemy" text))
        (test-flan--check "with a total under it"
                          (string-match-p "3 +80 +in 2 types" text)))
      (flan-leaks)
      (test-flan--check "the leak report asks for `leaks'"
                        (equal (plist-get sent :op) "leaks"))
      (kill-buffer " *test-allocations*"))))

;; An overflowed table has blocks in the program that are in nobody's row, so
;; every number under it is a floor. Said before the numbers, because a reader
;; who missed it would quote them as counts.
(cl-letf (((symbol-function 'flan-dev--request)
           (lambda (_) '(:status "ok" :types (("Enemy" 1 32)) :blocks 1 :bytes 32
                         :overflow t)))
          ((symbol-function 'display-buffer) #'ignore))
  (let ((flan-allocations-buffer " *test-allocations*"))
    (flan-allocations)
    (let ((text (with-current-buffer " *test-allocations*" (buffer-string))))
      (test-flan--check "an overflowed table is said to be a floor"
                        (string-match-p "floors, not counts" text)))
    (kill-buffer " *test-allocations*")))

;; And a release build, which records nothing and says so. The refusal comes
;; back as an ordinary error status and reaches the person, rather than an
;; empty listing that reads like a program holding nothing.
(cl-letf (((symbol-function 'flan-dev--request)
           (lambda (_) '(:status "error"
                         :message "the allocation registry is off; this is not a dev build")))
          ((symbol-function 'display-buffer) #'ignore))
  (test-flan--check "a build with no registry refuses rather than showing nothing"
                    (eq 'caught
                        (condition-case nil (flan-leaks) (user-error 'caught)))))


;;; The inspector buffer

(message "\nthe inspector buffer")

(defun test-flan--inspect (expr rendered)
  "Draw EXPR's RENDERED value in a temp buffer and return it, live.
The expression root, which is what most of the block below is about: the
rooting the buffer has always had, and the one that still works on a running
program."
  (let ((flan-inspect-request-function
         (lambda (_) (list :status "ok" :value rendered)))
        (flan-inspect-buffer " *test-inspect*"))
    (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
    (save-window-excursion (flan-inspect--show (list :expr expr) nil))))

(let* ((buf (test-flan--inspect
             "b" "(Blob {.id 7 .name \"sandy\" .pos (V {.x 1.5 .y 0})})"))
       (text (with-current-buffer buf (buffer-string))))
  (test-flan--check "the expression is at the top" (string-match-p "\\`b\n" text))
  (test-flan--check "and the type under it" (string-match-p "a Blob" text))
  (test-flan--check "the fields are listed" (string-match-p "\\.id.*7" text))
  (test-flan--check "a nested struct is summarised, not expanded"
                    (string-match-p "\\.pos +(V … 2 fields)" text))
  (test-flan--check "and the keys are shown" (string-match-p "RET inspect" text))
  ;; Every field line carries the step that reaches it.
  (with-current-buffer buf
    (goto-char (point-min))
    (flan-inspect-next)
    (test-flan--check "TAB lands on the first field"
                      (equal (get-text-property (point) 'flan-inspect-step)
                             '(:field "id")))
    (flan-inspect-next)
    (flan-inspect-next)
    (test-flan--check "and walks to the third"
                      (equal (get-text-property (point) 'flan-inspect-step)
                             '(:field "pos")))
    ;; Backwards is the same list walked the other way. It is tested because
    ;; an asymmetry here is the kind of thing nobody reports and everybody
    ;; notices — and because point lands mid-line after a search, where a
    ;; property-change walk and a field walk disagree.
    (flan-inspect-previous)
    (test-flan--check "p comes back to the second"
                      (equal (get-text-property (point) 'flan-inspect-step)
                             '(:field "name")))
    ;; From the middle of a line, `p' goes to the start of the field point is
    ;; *in*, which is CIDER's behaviour and the reason both commands go
    ;; through one list of field starts: walking property changes from
    ;; mid-line finds the end of the current field instead, and forward and
    ;; backward then disagree about where a field begins.
    (end-of-line)
    (flan-inspect-previous)
    (test-flan--check "from mid-line, p reaches this field's start"
                      (equal (get-text-property (point) 'flan-inspect-step)
                             '(:field "name")))
    (flan-inspect-previous)
    (test-flan--check "and then the one before it"
                      (equal (get-text-property (point) 'flan-inspect-step)
                             '(:field "id")))
    (flan-inspect-previous)
    (test-flan--check "p wraps to the last, as n wraps to the first"
                      (equal (get-text-property (point) 'flan-inspect-step)
                             '(:field "pos")))
    (flan-inspect-next)
    (test-flan--check "and n wraps round from it"
                      (equal (get-text-property (point) 'flan-inspect-step)
                             '(:field "id")))))

;; Going in sends a *different expression*, which is the entire adaptation.
(let ((asked nil))
  (let ((flan-inspect-request-function
         (lambda (form)
           (push (plist-get form :code) asked)
           (list :status "ok"
                 :value (if (equal (plist-get form :code) "(.pos b)")
                            "(V {.x 1.5 .y 0})"
                          "(Blob {.id 7 .pos (V {.x 1.5 .y 0})})"))))
        (flan-inspect-buffer " *test-inspect*"))
    (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
    (save-window-excursion
      (flan-inspect--show '(:expr "b") nil)
      (with-current-buffer " *test-inspect*"
        (goto-char (point-min))
        (flan-inspect-next) (flan-inspect-next)   ; :pos
        (flan-inspect-into)
        (test-flan--check "going in asks for the accessor expression"
                          (equal (car asked) "(.pos b)"))
        (test-flan--check "and the buffer is now showing that"
                          (string-match-p "\\`(\\.pos b)\n" (buffer-string)))
        (test-flan--check "with the stack behind it"
                          (string-match-p "via  b  >  here" (buffer-string)))
        (flan-inspect-pop)
        (test-flan--check "coming back asks for the one we came from"
                          (equal (car asked) "b"))
        (test-flan--check "and there is no stack left"
                          (not (string-match-p "via" (buffer-string))))
        (test-flan--check "popping at the root refuses"
                          (string-match-p
                           "nothing behind it"
                           (or (test-flan--caught #'flan-inspect-pop) "")))))))

;; RET on something that cannot be entered refuses there, rather than sending
;; an expression the program would reject.
(let* ((buf (test-flan--inspect "p" "(Node {.next <ptr> .n 1})")))
  (with-current-buffer buf
    (goto-char (point-min))
    (flan-inspect-next)
    (test-flan--check "RET on a pointer field refuses, naming it"
                      (string-match-p "pointer"
                                      (or (test-flan--caught #'flan-inspect-into) "")))))

;; An atom root has nothing to go into, and the buffer says so rather than
;; drawing an empty field list.
(let ((text (with-current-buffer (test-flan--inspect "(.x p)" "1.5") (buffer-string))))
  (test-flan--check "an atom root explains itself"
                    (string-match-p "Nothing to go into:.*atom" text)))

;; The span bound is drawn, because a field list that silently stops is a lie
;; about the value.
(let ((text (with-current-buffer
                (test-flan--inspect "w" "(Wide {.a 1 .b 2 ...})") (buffer-string))))
  (test-flan--check "span truncation is drawn, not dropped"
                    (string-match-p "span bound of 8" text)))


;;; The slot root

(message "\nthe slot root: a frame and a slot index")

;; The other rooting mode, and the reason it exists: an expression is
;; evaluated where the evaluator stands, so a local's *name* names the right
;; storage only on the innermost frame.  This root names the frame.

(defvar test-flan--asked nil
  "Every request the last slot-root fixture sent, newest first.")

(defun test-flan--slot (frame slot name replies body)
  "Open the slot root on FRAME/SLOT/NAME and run BODY in its buffer.
REPLIES answers each request.  BODY runs *inside* the binding of
`flan-inspect-request-function', which is not optional here: RET and `l' are
further requests, so a helper that returned the buffer and let the binding
unwind would send the next one to a daemon that is not there."
  (setq test-flan--asked nil)
  (let ((flan-inspect-request-function
         (lambda (form) (push form test-flan--asked) (funcall replies form)))
        (flan-inspect-buffer " *test-inspect*"))
    (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
    (save-window-excursion
      (with-current-buffer (flan-inspect-slot frame slot name)
        (funcall body)))))

;; The header names the frame, which is the whole of what the expression root
;; could not say, and the type comes from the reply rather than being read
;; back out of the rendering — a rendering of `7' does not carry `i64'.
(test-flan--slot
 1 3 "b"
 (lambda (_) (list :status "ok" :type "Blob"
                   :value "(Blob {.id 7 .pos (V {.x 1.5 .y 0})})"))
 (lambda ()
   (let ((text (buffer-string)))
     (test-flan--check "the slot root names the frame in the header"
                       (string-match-p "\\`b \\[frame 1\\]\n" text))
     (test-flan--check "and the daemon's type is what is shown"
                       (string-match-p "\nBlob\n" text)))
   (test-flan--check "it asks the inspect op, not eval-expr"
                     (equal (plist-get (car test-flan--asked) :op) "inspect"))
   (test-flan--check "with the frame and the slot index it was given"
                     (and (= 1 (plist-get (car test-flan--asked) :frame))
                          (= 3 (plist-get (car test-flan--asked) :slot))))
   ;; An empty path is sent by *omission*: Emacs prints an empty list as
   ;; `nil', which is a symbol on the wire and would be refused as a step.
   (test-flan--check "and no :path at all for the slot itself"
                     (null (plist-get (car test-flan--asked) :path)))))

;; Going in extends the path.  The root does not change, and that is what
;; makes `l' unable to cross: every entry on the stack was pushed with the
;; root it belongs to, so `l' can only ever restore a pair it built.
(test-flan--slot
 1 3 "b"
 (lambda (form)
   (if (equal (plist-get form :path) '("pos"))
       (list :status "ok" :type "V" :value "(V {.x 1.5 .y 0})")
     (list :status "ok" :type "Blob"
           :value "(Blob {.id 7 .pos (V {.x 1.5 .y 0})})")))
 (lambda ()
   (goto-char (point-min))
   (flan-inspect-next) (flan-inspect-next)   ; .pos
   (flan-inspect-into)
   (test-flan--check "RET sends a path step, not an expression"
                     (equal (plist-get (car test-flan--asked) :path) '("pos")))
   (test-flan--check "the header walks with it"
                     (string-match-p "\\`b \\[frame 1\\]\\.pos\n" (buffer-string)))
   (test-flan--check "with the frame's own root behind it in the trail"
                     (string-match-p "via  b \\[frame 1\\]  >  here" (buffer-string)))
   (flan-inspect-pop)
   (test-flan--check "l shortens the path back to the root"
                     (null (plist-get (car test-flan--asked) :path)))
   (test-flan--check "and the root never changed under it"
                     (seq-every-p (lambda (f) (equal (plist-get f :op) "inspect"))
                                  test-flan--asked))
   (test-flan--check "so nothing was ever evaluated as an expression"
                     (not (seq-some (lambda (f) (plist-get f :code))
                                    test-flan--asked)))
   (test-flan--check "and popping at the root refuses, as for an expression"
                     (string-match-p
                      "nothing behind it"
                      (or (test-flan--caught #'flan-inspect-pop) "")))))

;; An option's payload: the one thing the slot root reaches and the expression
;; root cannot, because Flan has no accessor form that names it.  So the
;; refusal is the *root's* and not the value's, and it has to be asked with
;; the root in hand.
(test-flan--check "an expression root refuses an option's payload"
                  (string-match-p
                   "no accessor form"
                   (or (flan-inspect-refusal (flan-inspect-parse "(some 3)")
                                             '(:expr "o"))
                       "")))
(test-flan--check "a slot root does not"
                  (null (flan-inspect-refusal (flan-inspect-parse "(some 3)")
                                              '(:slot 0 1 "o"))))

(test-flan--slot
 0 2 "o"
 (lambda (form)
   (if (plist-get form :path)
       (list :status "ok" :type "V" :value "(V {.x 1 .y 2})")
     (list :status "ok" :type "(Option V)" :value "(some (V {.x 1 .y 2}))")))
 (lambda ()
   (goto-char (point-min))
   (flan-inspect-next)
   (flan-inspect-into)
   ;; The payload has no name, so the step is the symbol `some' and not a
   ;; field called "some".
   (test-flan--check "RET into an option sends the symbol some"
                     (equal (plist-get (car test-flan--asked) :path) '(some)))
   (test-flan--check "and the trail says so"
                     (string-match-p "\\`o \\[frame 0\\]\\.some\n" (buffer-string)))))

;; A union case's field.  The payload sits at an offset that depends on which
;; case the value is in, and only the renderer knows which it currently holds
;; — it wrote the head `Shape.circle'.  So the case travels with the name.
(test-flan--check "a union field carries its case on the wire"
                  (equal (flan-inspect-wire-step '(:field "r" "Shape.circle"))
                         "Shape.circle.r"))
(test-flan--check "a struct field does not"
                  (equal (flan-inspect-wire-step '(:field "x" "V")) "x"))
(test-flan--check "an element is its number"
                  (equal (flan-inspect-wire-step '(:index 2)) 2))


;; And the other half of that pair: under an *expression* root there is no
;; accessor to send, so RET refuses there rather than sending `(.at s)' for
;; the checker to reject.  A union's fields are reached by `(match ...)' in
;; the language, which binds names rather than producing a value.  It is a
;; refusal of the parent, not of the value at point — a struct field that
;; merely *holds* a union is an ordinary accessor and stays enterable.
(let ((buf (test-flan--inspect "s" "(Shape.circle {.at (V {.x 1 .y 2})})")))
  (with-current-buffer buf
    (goto-char (point-min))
    (flan-inspect-next)
    (test-flan--check "an expression root refuses a union case's field"
                      (string-match-p
                       "reached by (match"
                       (or (test-flan--caught #'flan-inspect-into) "")))))

(let ((asked nil))
  (let ((flan-inspect-request-function
         (lambda (form) (push (plist-get form :code) asked)
           (list :status "ok"
                 :value "(Cell {.id 1 .s (Shape.circle {.at (V {.x 1 .y 2})})})")))
        (flan-inspect-buffer " *test-inspect*"))
    (when (get-buffer " *test-inspect*") (kill-buffer " *test-inspect*"))
    (save-window-excursion
      (flan-inspect--show '(:expr "c") nil)
      (with-current-buffer " *test-inspect*"
        (goto-char (point-min))
        (flan-inspect-next) (flan-inspect-next)   ; .s, which holds the union
        (test-flan--check "but a struct field that merely holds one is enterable"
                          (progn (flan-inspect-into) (equal (car asked) "(.s c)")))))))

(test-flan--slot
 0 1 "s"
 (lambda (form)
   (if (plist-get form :path)
       (list :status "ok" :type "V" :value "(V {.x 1 .y 2})")
     (list :status "ok" :type "Shape"
           :value "(Shape.circle {.at (V {.x 1 .y 2})})")))
 (lambda ()
   (goto-char (point-min))
   (flan-inspect-next)
   (flan-inspect-into)
   (test-flan--check "RET into a union field names the case it is in"
                     (equal (plist-get (car test-flan--asked) :path)
                            '("Shape.circle.at")))))

;; The daemon is allowed to refuse — a program that resumed, or a frame whose
;; body was redefined since it was entered — and the refusal has to reach the
;; person rather than being answered from somewhere else.  Being answered from
;; somewhere else is the bug this root exists to fix, so it is asserted.
(let ((flan-inspect-request-function
       (lambda (_)
         (list :status "error"
               :message "look's body was redefined since that frame was entered")))
      (flan-inspect-buffer " *test-inspect*"))
  (test-flan--check "a refused slot root says why, and shows nothing"
                    (string-match-p
                     "redefined"
                     (or (test-flan--caught
                          (lambda () (flan-inspect-slot 0 1 "p")))
                         ""))))

;; And the structural claim about `l' from the other side: a new root always
;; starts a fresh stack, so there is never an entry of another kind left
;; underneath for `l' to land on.
(let ((flan-inspect-request-function
       (lambda (form) (if (equal (plist-get form :op) "inspect")
                          (list :status "ok" :type "i32" :value "7")
                        (list :status "ok" :value "9"))))
      (flan-inspect-buffer " *test-inspect*"))
  (save-window-excursion
    (flan-inspect-slot 1 3 "b")
    (flan-inspect "g")
    (with-current-buffer " *test-inspect*"
      (test-flan--check "a new root drops the stack it did not build"
                        (null flan-inspect--stack))
      (test-flan--check "and l has nothing to cross back into"
                        (string-match-p
                         "nothing behind it"
                         (or (test-flan--caught #'flan-inspect-pop) ""))))))


;;; Restarts: which of them can be taken

(message "\nrestarts, and §4's shadowing")

(let ((rows (flan-cnr-annotate-restarts '("retry" "use-placeholder" "retry" "skip"))))
  (test-flan--check "numbered from zero, innermost first"
                    (equal (mapcar (lambda (r) (nth 0 r)) rows) '(0 1 2 3)))
  (test-flan--check "the first of a name owns it"
                    (null (nth 2 (nth 0 rows))))
  (test-flan--check "a repeat is shadowed by it"
                    (equal (nth 2 (nth 2 rows)) 0))
  (test-flan--check "and a different name is not"
                    (null (nth 2 (nth 3 rows)))))

(test-flan--check "no restarts is a list of no rows"
                  (null (flan-cnr-annotate-restarts nil)))


;;; The break buffer

(message "\nthe break buffer")

(defun test-flan--cnr (state)
  "Draw STATE and return the buffer."
  (let ((buf (get-buffer-create " *test-cnr*")))
    (with-current-buffer buf
      (let ((inhibit-read-only t)) (erase-buffer))
      (flan-cnr-mode)
      (setq flan-cnr--open nil)
      (flan-cnr--render state))
    buf))

;; What the daemon can answer today, and nothing more: a class name and a list
;; of names.
(let* ((buf (test-flan--cnr
             (list :condition "Missing"
                   :restarts '("retry" "use-placeholder" "retry"))))
       (text (with-current-buffer buf (buffer-string))))
  ;; SBCL's order, which is the claim this buffer is making.
  (test-flan--check "the condition is first"
                    (string-match-p "\\`Missing" text))
  (test-flan--check "the restarts are before the stack"
                    (< (string-match "Restarts" text) (string-match "Stack" text)))
  (test-flan--check "restarts are numbered"
                    (string-match-p " 0: \\[retry\\]" text))
  (test-flan--check "a shadowed one has no bracket, as SBCL's has none"
                    (string-match-p " 2:  retry " text))
  (test-flan--check "and says why, and what it would take"
                    (string-match-p "shadowed by 0.*restart-at" text))
  (test-flan--check "abort is the last entry on the same list"
                    (string-match-p " 3: \\[abort\\]" text))
  ;; The rule: nothing implemented is refused by name, with the reason.  These
  ;; three sections exist and are empty, and each says what would fill it.
  ;; The shape of a condition and the values in it are two different
  ;; refusals, and with nothing at all the outer one is what shows.
  (test-flan--check "the condition's fields are refused, not omitted"
                    (string-match-p "Condition fields:\n  not available.*Tast.structs" text))
  ;; The stack is no longer refused for want of a mechanism — the shadow stack
  ;; landed and the daemon answers `backtrace'.  What this fixture has is no
  ;; stack *passed in*, which is the running-program case, so the reason it
  ;; names is that one.
  (test-flan--check "the stack says the program is running, not that it is unbuilt"
                    (string-match-p "Stack.*\n  not available.*running"
                                    (substring text (string-match "--- Stack" text))))
  (test-flan--check "and the keys are shown" (string-match-p "TAB fold a frame" text)))

;; A stopped program with nothing on offer between the error and the top.  It
;; is a real state — spec-conditions §2's `error' with no `restart-case' above
;; it — and it must not look like a bug in the buffer.
(let ((text (with-current-buffer
                (test-flan--cnr (list :condition "Missing" :restarts nil))
              (buffer-string))))
  (test-flan--check "no restarts is said, not drawn blank"
                    (string-match-p "none are active" text))
  (test-flan--check "and abort is still offered"
                    (string-match-p " 0: \\[abort\\]" text)))

;; Taking one sends `restart' with the name.
(let ((sent nil))
  (let ((flan-cnr-request-function
         (lambda (form) (setq sent form) (list :status "ok" :note "accepted"))))
    (with-current-buffer (test-flan--cnr
                          (list :condition "Missing" :restarts '("retry" "skip")))
      (goto-char (point-min))
      (search-forward " 1: ")
      (save-window-excursion (flan-cnr-take))
      (test-flan--check "RET on a restart sends its name"
                        (equal sent '(:op "restart" :name "skip"))))))

;; And a shadowed one is refused here rather than sent, which is the bug in
;; today's `completing-read': it would send "retry" and the *inner* frame would
;; take it, silently.
(let ((sent nil))
  (let ((flan-cnr-request-function (lambda (form) (setq sent form) '(:status "ok"))))
    (with-current-buffer (test-flan--cnr
                          (list :condition "Missing" :restarts '("retry" "a" "retry")))
      (goto-char (point-min))
      (search-forward " 2: ")
      (let ((err (test-flan--caught #'flan-cnr-take)))
        (test-flan--check "a shadowed restart refuses"
                          (and err (string-match-p "shadowed by 0" err)))
        (test-flan--check "and nothing was sent" (null sent))))))

;; A digit takes one, as it does in SBCL.
(let ((sent nil))
  (let ((flan-cnr-request-function
         (lambda (form) (setq sent form) (list :status "ok" :note "accepted"))))
    (with-current-buffer (test-flan--cnr
                          (list :condition "Missing" :restarts '("retry" "skip")))
      (goto-char (point-max))
      (let ((last-command-event ?0))
        (save-window-excursion (call-interactively #'flan-cnr-take-number)))
      (test-flan--check "0 takes the innermost"
                        (equal sent '(:op "restart" :name "retry")))
      (let ((last-command-event ?2))
        (save-window-excursion (call-interactively #'flan-cnr-take-number)))
      (test-flan--check "and the number past the last is abort"
                        (equal sent '(:op "abort"))))))

;; The stack and its locals.  The fixture is the shape `backtrace' and `locals'
;; answer with, and both frames carry `:fetched t' because their locals are
;; already here: without it `flan-cnr-toggle-frame' goes and asks the daemon
;; for them, and there is no daemon behind these tests on purpose.
(let* ((state (list :condition "Missing"
                    :restarts '("retry")
                    :stack (list (list :fn "sim/settle" :loc "sand.flan:42:3"
                                       :fetched t
                                       ;; Four elements now: the fourth is
                                       ;; the slot's index, which is what `i'
                                       ;; hands to the inspector.
                                       :locals '(("i" "i32" "7" 0)
                                                 ("b" "Blob" "(Blob {.id 7})" 1)))
                                 (list :fn "sim/step" :loc "sand.flan:60:1"
                                       :fetched t :locals nil))))
       (buf (test-flan--cnr state))
       (text (with-current-buffer buf (buffer-string))))
  (test-flan--check "frames are numbered, innermost first"
                    (string-match-p " 0: > sim/settle" text))
  (test-flan--check "with where they are" (string-match-p "sand.flan:42:3" text))
  (test-flan--check "locals are collapsed to begin with"
                    (not (string-match-p "i32 i = 7" text)))
  (with-current-buffer buf
    (goto-char (point-min))
    (search-forward " 0: > sim/settle")
    (flan-cnr-toggle-frame)
    (test-flan--check "TAB on a frame opens its locals"
                      (string-match-p "i32 i = 7" (buffer-string)))
    (test-flan--check "and the marker turns"
                      (string-match-p " 0: v sim/settle" (buffer-string)))
    ;; A frame whose locals nobody could read says so, in the same place the
    ;; locals would have been.
    (goto-char (point-min))
    (search-forward " 1: > sim/step")
    (flan-cnr-toggle-frame)
    ;; DWARF stopped being the reason when the shadow stack landed: a frame
    ;; with nothing nameable is one whose slots the compiler invented, or whose
    ;; bindings had not run.
    (test-flan--check "a frame with no locals refuses, with a reason"
                      (string-match-p "not available.*no named locals"
                                      (buffer-string)))
    (goto-char (point-min))
    (search-forward " 0: v sim/settle")
    (flan-cnr-toggle-frame)
    (test-flan--check "and TAB again closes it"
                      (not (string-match-p "i32 i = 7" (buffer-string))))))

;; The two buffers meet, and this is the fixture the bug lived in.  `i' used
;; to send the local's *name* to be evaluated, which resolves wherever the
;; evaluator stands: right on the innermost frame by luck, and on any other
;; frame a global, another binding of the same name, or nothing — with the
;; listing right above it showing the frame's own storage and nothing saying
;; the two disagree.  It sends the frame and the slot index now.
(let ((asked nil))
  (let ((flan-inspect-request-function
         (lambda (form) (push form asked)
           (list :status "ok" :type "Blob" :value "(Blob {.id 7})")))
        (flan-inspect-buffer " *test-inspect*"))
    (with-current-buffer (test-flan--cnr
                          (list :condition "Missing" :restarts '("retry")
                                :stack (list (list :fn "g" :fetched t
                                                   :locals '(("b" "Blob" "…" 4)))
                                             (list :fn "f" :fetched t
                                                   :locals '(("b" "Blob" "…" 2))))))
      (goto-char (point-min))
      (search-forward " 1: > f")
      (flan-cnr-toggle-frame)
      (goto-char (point-min))
      (search-forward " 1: v f")
      (search-forward "Blob b")
      (save-window-excursion (flan-cnr-inspect))
      (test-flan--check "`i' on a local inspects it by frame and slot"
                        (equal (plist-get (car asked) :op) "inspect"))
      ;; The outer frame, and its own slot index — the two facts a name cannot
      ;; carry.  Frame 1 has a `b' and so does frame 0; sending "b" would have
      ;; reached whichever one the evaluator stands in.
      (test-flan--check "naming the frame the listing was drawn from"
                        (= 1 (plist-get (car asked) :frame)))
      (test-flan--check "and the slot index that frame's listing gave"
                        (= 2 (plist-get (car asked) :slot)))
      (test-flan--check "nothing is evaluated as an expression"
                        (null (plist-get (car asked) :code))))))

;; `flan-cnr-show' refuses a running program by name rather than opening an
;; empty buffer.
;; The layout without the values: what a `layout' op alone would buy. The
;; names and the types come out of Tast.structs, which the daemon holds
;; whether or not a program is running; only the values need the pointer the
;; break loop was handed. Drawing the two apart is strictly more than saying
;; nothing, and it is what tells you whether the field you were about to
;; blame is even a field of this condition.
(let ((text (with-current-buffer
                (test-flan--cnr (list :condition "Missing" :restarts '("retry")
                                      :fields '(("path" "string" nil)
                                                ("tried" "i32" "3"))))
              (buffer-string))))
  (test-flan--check "a field is named and typed even with no value"
                    (string-match-p ":path *string *value not available" text))
  (test-flan--check "and the missing value names the verb it needs"
                    (string-match-p "value not available.*agent verb: `condition'" text))
  (test-flan--check "a value that is there is simply shown"
                    (string-match-p ":tried *i32 *3" text)))

;; Backwards through the buffer, for the same reason as in the inspector.
(with-current-buffer (test-flan--cnr
                      (list :condition "Missing" :restarts '("retry" "skip")))
  (goto-char (point-min))
  (search-forward "[abort]")
  (beginning-of-line)
  (flan-cnr-previous)
  (test-flan--check "p from abort lands on the last restart"
                    (equal (get-text-property (point) 'flan-cnr-index) 1))
  (flan-cnr-next)
  (test-flan--check "and n goes back to abort"
                    (get-text-property (point) 'flan-cnr-abort)))


;; The `layout' op, from this side: the condition's own name goes out as
;; `:type' and comes back as fields with no values. Two requests are made for
;; one `C-c C-b' — `break', `layout', then `backtrace' — so the stub records
;; all three. The assertions below look the `layout' request up by op rather
;; than by position: this list grew once already when `backtrace' landed, and a
;; positional assertion breaks every time the buffer learns to ask something
;; new, which is not what it is testing.
(let ((asked nil))
  (let ((flan-cnr-request-function
         (lambda (form)
           (push form asked)
           (pcase (plist-get form :op)
             ("break" '(:status "ok" :stopped t :condition "sim/Missing"
                        :restarts ("retry")))
             ("layout" '(:status "ok" :type "sim/Missing"
                         :fields (("path" "string") ("tried" "i32"))))))))
    (let ((text (with-current-buffer (save-window-excursion (flan-cnr-show))
                  (buffer-string))))
      (test-flan--check "the condition's name is what `layout' is asked for"
                        (equal (plist-get (car (last asked)) :op) "break"))
      ;; By op rather than by position: `flan-cnr-show' asks three things now —
      ;; `break', `layout', `backtrace' — and which of them is last is not what
      ;; this is testing.
      (test-flan--check "and it is sent back verbatim, qualified as it came"
                        (equal (plist-get
                                (seq-find (lambda (f)
                                            (equal (plist-get f :op) "layout"))
                                          asked)
                                :type)
                               "sim/Missing"))
      (test-flan--check "the fields are drawn, named and typed"
                        (string-match-p ":path *string" text))
      ;; Shape and contents are two different questions, and only the first is
      ;; answerable without the pointer the break loop discards.
      (test-flan--check "and every value still says why it is missing"
                        (string-match-p ":tried *i32 *value not available" text)))))

;; A layout the daemon refuses — a bare name it will not guess between two
;; packages, or a type it cannot place — leaves the section drawing its reason
;; rather than turning `C-c C-b' into an error. The restarts are the decision
;; in front of you and they are still there.
(let ((flan-cnr-request-function
       (lambda (form)
         (pcase (plist-get form :op)
           ("break" '(:status "ok" :stopped t :condition "Missing"
                      :restarts ("retry")))
           ("layout" '(:status "error" :message "Missing is not a qualified name"
                       :candidates ("a/Missing" "b/Missing")))))))
  (let ((text (with-current-buffer (save-window-excursion (flan-cnr-show))
                (buffer-string))))
    (test-flan--check "a refused layout is a section that says so"
                      (string-match-p "not available.*needs a \\*qualified\\* name" text))
    (test-flan--check "and the restarts are drawn anyway"
                      (string-match-p "\\[retry\\]" text))))

;; The globals section.  One section rather than a fold under each frame, and
;; the fixtures below are what makes that visible: `grid' is touched by two
;; frames and appears once.
(let* ((state (list :condition "Boom"
                    :restarts '("retry")
                    :stack (list (list :fn "sim/inner" :loc "g.flan:12:1")
                                 (list :fn "main" :loc "g.flan:30:1"))
                    ;; Ordered as the daemon orders it: by the innermost frame
                    ;; that touches each one.
                    :globals '(("grid" "[4 i32]" "[ 7 5 0 0]" (0 1))
                               ("pressure" "i64" "12" (0))
                               ("label" "string" "\"running\"" (1)))))
       (buf (test-flan--cnr state))
       (text (with-current-buffer buf (buffer-string))))
  (test-flan--check "a global is named, typed and valued"
                    (string-match-p "pressure +i64 = 12" text))
  (test-flan--check "and it is one section, not one per frame"
                    (= 1 (seq-count (lambda (l) (string-match-p "grid" l))
                                    (split-string text "\n"))))
  ;; The annotation is what recovers the half per-frame nesting would have
  ;; told you, and it costs no duplication to say it.
  (test-flan--check "a global two frames touch says both"
                    (string-match-p "frames 0, 1" text))
  (test-flan--check "and one only the innermost touches says one"
                    (string-match-p "frame 0\n" text))
  (test-flan--check "the innermost frame's globals come first"
                    (< (string-match "pressure" text) (string-match "label" text)))
  ;; `i' reaches a global the same way it reaches a local: a global's name is
  ;; an expression the program can be handed, which is the whole trick the
  ;; inspector is built on.
  (with-current-buffer buf
    (goto-char (point-min))
    (test-flan--check "and a global line is inspectable, by expression"
                      (progn (search-forward "pressure")
                             (equal (get-text-property (point) 'flan-cnr-inspect)
                                    '(:expr "pressure"))))))

;; Empty is a claim, not a gap: the section is the union of what the stack
;; reaches, so nothing in it means the state is all in the locals.
(let ((text (with-current-buffer
                (test-flan--cnr (list :condition "Boom" :restarts '("retry")
                                      :stack (list (list :fn "f"))))
              (buffer-string))))
  (test-flan--check "an empty globals section says what empty means"
                    (string-match-p "not available.*union of what the frames reach"
                                    text)))

;; A frame the daemon could not attribute makes the union smaller than the real
;; one, and a list that is short without saying so is the failure this whole
;; buffer is built to avoid.
(let ((text (with-current-buffer
                (test-flan--cnr
                 (list :condition "Boom" :restarts '("retry")
                       :stack (list (list :fn "f"))
                       :globals '(("label" "string" "\"x\"" (1)))
                       :globals-refused '(("weird" "no printer for (Map i64 i64)"))
                       :globals-skipped
                       '(("0: sim/inner" "this frame's body was redefined since it was entered"))))
              (buffer-string))))
  (test-flan--check "a global with no printer is refused by name"
                    (string-match-p "weird: no printer" text))
  (test-flan--check "an unattributable frame says the union is incomplete"
                    (string-match-p "union is incomplete" text))
  (test-flan--check "and names the frame it lost"
                    (string-match-p "0: sim/inner" text)))

;; The fetch is a function from a reply to data, like the other two, so it is
;; drivable with no socket.
(let ((flan-cnr-request-function
       (lambda (_) '(:status "ok"
                     :globals (("g" "i64" "1" (0)))
                     :refused (("h" "no printer"))
                     :skipped (("1: m" "redefined"))))))
  (let ((got (flan-cnr-globals)))
    (test-flan--check "globals come back as entries, refusals and skipped frames"
                      (equal got '((("g" "i64" "1" (0)))
                                   (("h" "no printer"))
                                   (("1: m" "redefined")))))))

(let ((flan-cnr-request-function (lambda (_) '(:status "error" :message "running"))))
  (test-flan--check "and a refusal is nil, not an error"
                    (null (flan-cnr-globals))))

(let ((flan-cnr-request-function
       (lambda (_) '(:status "ok" :restarts nil :stopped nil))))
  (test-flan--check "a running program is refused, by name"
                    (string-match-p "no restart stack"
                                    (or (test-flan--caught #'flan-cnr-show) ""))))

(let ((flan-cnr-request-function
       (lambda (_) '(:status "error" :message "the program exited"))))
  (test-flan--check "and the daemon's own refusal is passed through"
                    (string-match-p "the program exited"
                                    (or (test-flan--caught #'flan-cnr-show) ""))))


;;; Opening the break buffer by itself

;; `flan-dev--auto-break' is a decision — given the state the client is in,
;; does the break buffer appear — so it is asked here with the state bound
;; rather than by stopping a real program.  Every guard in it exists because
;; the answer is no in some state a person is actually in.

(message "\nthe break buffer opening itself")

(defun test-flan--auto-break (&rest bindings)
  "Non-nil if `flan-dev--auto-break' would show the buffer.
BINDINGS is a plist of extra state; the defaults are a live connection and a
stopped program, which is the case where it should fire."
  (let ((shown nil))
    (cl-letf (((symbol-function 'flan-cnr-show) (lambda () (setq shown t) nil))
              ;; A process object that is not live, and `process-live-p' of a
              ;; non-process is nil — so the default has to be overridden by
              ;; the caller, which is what `:live' does.
              ((symbol-function 'process-live-p)
               (lambda (_) (if (plist-member bindings :live)
                               (plist-get bindings :live) t))))
      (let ((flan-dev--stopped
             (if (plist-member bindings :stopped)
                 (plist-get bindings :stopped) "Missing"))
            (flan-dev-break-on-stop
             (if (plist-member bindings :setting)
                 (plist-get bindings :setting) 'display))
            (flan-dev--busy (plist-get bindings :busy))
            (executing-kbd-macro (plist-get bindings :macro))
            (flan-dev--connection 'stub))
        (flan-dev--auto-break)))
    shown))

(test-flan--check "a stopped program opens it"
                  (test-flan--auto-break))
(test-flan--check "a running one does not"
                  (not (test-flan--auto-break :stopped nil)))
(test-flan--check "nor does a connection that has gone"
                  (not (test-flan--auto-break :live nil)))
;; The reason it is deferred at all: `flan-dev--absorb' notices the stop in the
;; middle of reading a reply, and three more requests down the same socket
;; would interleave two conversations.
(test-flan--check "nor while a request is still in flight"
                  (not (test-flan--auto-break :busy t)))
;; A prompt is modal and someone is in the middle of it.
(test-flan--check "nor under an active minibuffer"
                  (let ((probe (lambda (&rest _) t)))
                    (advice-add 'active-minibuffer-window :override probe)
                    (unwind-protect (not (test-flan--auto-break))
                      (advice-remove 'active-minibuffer-window probe))))
;; A macro must do the same thing every time it is run, and whether the program
;; happened to stop during it is not something a macro can depend on.
(test-flan--check "nor inside a keyboard macro"
                  (not (test-flan--auto-break :macro t)))
(test-flan--check "and not at all when it is turned off"
                  (not (test-flan--auto-break :setting nil)))

;; `(pause)' is a stop and not a failure, and it is the one thing about it that
;; the buffer gets to say differently.  Everything underneath is identical.
(let ((text (test-flan--text
             (lambda () (flan-cnr--insert-condition
                         (list :condition flan-cnr-breakpoint))))))
  (test-flan--check "a breakpoint is called a breakpoint"
                    (string-match-p "a breakpoint; stopped where (pause)" text))
  (test-flan--check "and is not called unhandled"
                    (not (string-match-p "unhandled" text))))

(let ((text (test-flan--text
             (lambda () (flan-cnr--insert-condition '(:condition "Missing"))))))
  (test-flan--check "while an error still is"
                    (string-match-p "unhandled" text)))


;; `flan-mode' itself — indentation, which is a function from text to text and
;; so belongs with the other fixture-driven checks rather than with anything
;; that needs a daemon.  Loaded rather than run separately because
;; `emacs/*.el' is already a dependency of test/dune's stanza, so a file here
;; needs no build change to be run.
(load (expand-file-name "test-flan-mode.el"
                        (file-name-directory load-file-name))
      nil t)

;; Ghost text, which is the same kind of thing: rows in, overlays out, and the
;; buffer it reads is a fixture like any other reply here.  Loaded for the same
;; reason.
(load (expand-file-name "test-flan-watch.el"
                        (file-name-directory load-file-name))
      nil t)

(message "\n%d checks, %d failures" test-flan--ran test-flan--failures)
(kill-emacs (if (> test-flan--failures 0) 1 0))

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