flan/emacs/test-flan-mode.el

;;; test-flan-mode.el --- Indentation, from written-out shapes  -*- lexical-binding: t; -*-

;; Loaded by test-flan-cider.el, which runs under `dune test'.  It is not a
;; file of its own in test/dune deliberately: `emacs/*.el' is already a
;; dependency of that stanza, so a new `.el' here needs no build change.
;;
;; Every case is a piece of Flan written the way the corpus writes it, with
;; every line's indentation thrown away and put back.  That is the whole test:
;; if what comes out is what went in, the indenter agrees with the code that
;; already exists.  A case that is *not* in the corpus is written from
;; `clojure-mode''s behaviour and says so.
;;
;; The cases come from the bug report and from reading the tree for the shapes
;; that share it: a `let' binding vector, `defn' parameters with and without a
;; return type, `handler-bind' and `restart-case' clause parameters, and struct
;; literals in both the `:x' and the `.x' spelling — the two must agree,
;; because a lane is converting the corpus from one to the other and the
;; indenter is not allowed to notice.

;;; Code:

(require 'flan-mode)

;; The harness, which is test-flan-cider.el's: it counts and it reports, and
;; this file is loaded from there.
(declare-function test-flan--check "test-flan-cider" (name ok))

(defun test-flan-mode--reindent (text)
  "Strip TEXT's indentation and let `flan-mode' put it back."
  ;; Quiet: `indent-region' reports progress, and in batch that lands in the
  ;; middle of the line a failure is being printed on.
  (let ((inhibit-message t))
   (with-temp-buffer
    (insert text)
    (flan-mode)
    (goto-char (point-min))
    ;; Leading whitespace off every line but the first: the first line's column
    ;; is the buffer's, not the indenter's, and a form is indented relative to
    ;; where it starts.  `eobp' rather than `forward-line''s return value,
    ;; which is 0 for a move to the end of a buffer that has no final newline
    ;; and would take the whole last line with it.
    (forward-line 1)
    (while (not (eobp))
      (skip-chars-forward " \t")
      (delete-region (line-beginning-position) (point))
      (forward-line 1))
    (indent-region (point-min) (point-max))
    (buffer-substring-no-properties (point-min) (point-max)))))

(defun test-flan-mode--check (name text)
  "Check that TEXT is what `flan-mode' indents it to."
  (let ((got (test-flan-mode--reindent text)))
    (test-flan--check name (equal got text))
    (unless (equal got text)
      ;; Line by line, and quoted: the difference is always a count of leading
      ;; spaces, which is exactly what two blocks of text printed as-is make
      ;; hardest to see.
      (let ((want (split-string text "\n")) (had (split-string got "\n")))
        (while (or want had)
          (unless (equal (car want) (car had))
            (message "    want %S\n     got %S" (car want) (car had)))
          (setq want (cdr want) had (cdr had)))))))

(message "\n-- indentation")

;; The bug, as reported: sand.flan's `settle'.  The second and later bindings
;; went one column too far, because the enclosing open is `[' and the symbol
;; after it is the first binding's *name*, so the old check fell through to
;; `lisp-indent-function', which treated the vector as a call and aligned under
;; the first argument — `(+ gravity …)' — instead of under `vel'.
(test-flan-mode--check
 "a let's bindings align name under name"
 "(defn settle [row i32  col i32] ()
  (let [vel (+ gravity (at velocity row col))
        y   (min (- rows 1) (+ row (i32 vel)))]
    (while (> y row)
      (set y (- y 1)))))")

;; The same shape one level in, which is where the report was actually hit: a
;; binding whose value is a struct literal, so the vector's alignment has to
;; survive a `{' in the middle of it.
(test-flan-mode--check
 "and still does with a struct literal in a value"
 "(let [tip (rl/Vector2 {.x 15.0 .y 12.0})
      vel (+ gravity 1.0)]
  (draw tip vel))")

;; The two spellings must be indented identically.  Nothing in the indenter
;; looks at the key — a brace aligns under its first element whatever that
;; element is — and this is the test that keeps it that way while the corpus
;; moves from `:x' to `.x'.
(test-flan-mode--check
 "a struct literal aligns under its first field"
 "(rl/Rectangle {.x 0.0 .y 0.0
               .width  (f32 screen-width)
               .height (f32 screen-height)})")

;; The colon spelling is gone from the language — the parser refuses it — but a
;; map literal will be written this way, and the indenter must not have learned
;; the difference: it aligns under the first element of a brace and never looks
;; at what that element is spelled like.
(test-flan-mode--check
 "and a brace of keyword keys aligns exactly the same way"
 "(counts {:north 0 :south 1
         :east  2
         :west  3})")

;; `defn' carries a return type between the parameters and the body, and it is
;; optional.  Both spellings indent the body by two, which is why the spec is
;; `:defn' and not a count: a count would have to know whether the type is
;; there.
(test-flan-mode--check
 "a defn with a return type indents its body by two"
 "(defn look [n i64  label str] i64
  (print label)
  n)")

(test-flan-mode--check
 "and a defn without one indents it the same"
 "(defn show-trim [s str] ()
  (print s)
  (println \"\"))")

;; A parameter list that wraps is the binding-vector rule again: it is a
;; vector, so it aligns under its first element and not under its second.
(test-flan-mode--check
 "a wrapped parameter list aligns under the first parameter"
 "(defn move-grain [row i32  col i32
                  to-row i32  to-col i32
                  vel f32] ()
  (set moved true))")

;; `handler-bind' clauses: the vector is the special argument, and each clause
;; inside it is `(Name [params] body…)' — `defn' with the name left off.  The
;; body indents by two from the clause's own paren, which is the rule the head
;; cannot be looked up for: `StorageExhausted' is a name the program invented.
(test-flan-mode--check
 "a handler-bind clause indents its body under its own paren"
 "(handler-bind
  [(StorageExhausted [c]
     (set failures (+ failures 1))
     (invoke-restart 'retry))]
  (load-all))")

(test-flan-mode--check
 "and two clauses in one vector line up with each other"
 "(handler-bind [(AssetMissing [c] (set seen (+ seen 10)))
               (Corrupt      [c] (set other (+ other 1)))]
  (load-all))")

;; `restart-case' is 1 rather than 0: with 0 a protected form written on the
;; head's line would drag every clause out to align under it.
(test-flan-mode--check
 "restart-case clauses indent by two under a protected form on the head's line"
 "(defn fetch [n i32] i32
  (restart-case (middle n)
    (use-placeholder [] -1)
    (retry           [] 7)))")

(test-flan-mode--check
 "and by two when the protected form is on its own line"
 "(restart-case
  (do (agent/poll)
      (game-update))
  (continue [] (do)))")

;; `declare-c' writes its parameters, return type and C symbol down the page in
;; one column.
(test-flan-mode--check
 "declare-c puts everything after the name in one column"
 "(declare-c is-mouse-button-pressed
  [button MouseButton] bool
  \"IsMouseButtonPressed\")")

;; An ordinary call, in the two cases every Lisp separates.
(test-flan-mode--check
 "a call with an argument on the head's line aligns under that argument"
 "(rl/draw-text \"hello\"
              10 20 30)")

(test-flan-mode--check
 "a call whose head is alone on its line indents its arguments by a body"
 "(rl/draw-rectangle-lines-ex
  (rl/Rectangle {.x 0.0 .y 0.0})
  (f32 2.0) (rl/get-color 0x303030FF))")

;; A `do' is all body, so its second form aligns under its first.
(test-flan-mode--check
 "a do aligns its forms with the first one"
 "(do (agent/poll)
    (game-update))")

;; Field access is an ordinary call whose head begins with a dot.  `.' is a
;; symbol constituent, so nothing special is needed — but if it ever stopped
;; being one, `(.x v)' would start indenting as data and this is what would
;; say so.
(test-flan-mode--check
 "field access indents as the call it is"
 "(set total
     (+ (.bytes c)
        (.align c)))")

;; `#_' discards the form after it, so the reader sees pairs either way and the
;; alignment must not shift.  See `lib/reader.ml'.
(test-flan-mode--check
 "a discarded binding does not disturb the pairs around it"
 "(let [#_a #_1 b 2
      c 3]
  (print c))")

;; A labelled loop, from `test/programs/loops.flan'.  The label is a keyword
;; written where the binding vector would otherwise go, so it pushes everything
;; along by one — and until the indenter was told, the body of a labelled loop
;; was dragged out under its own binding vector.
(test-flan-mode--check
 "a labelled dotimes indents its body by two, not under its vector"
 "(dotimes :outer [a 3]
  (dotimes [b 3]
    (when (= b 2) (break :outer))
    (print b) (println \"\")))")

;; `until' takes one on the same rule, and there the special argument is a test
;; rather than a vector — which is the case that shows the rule is about the
;; label and not about brackets.
(test-flan-mode--check
 "and so does a labelled until, whose special argument is a test"
 "(until :count (> n 10)
  (set n (+ n 1))
  (when (= n 3) (break :count)))")

;; The unlabelled form must not have moved, which is the other half of the
;; same claim.
(test-flan-mode--check
 "an unlabelled dotimes is where it always was"
 "(dotimes [b 3]
  (print b)
  (println \"\"))")

;; `dotimes' binding vectors now hold up to four elements — name, start, stop,
;; step — and the indenter must not have learned a count.  The vector is one
;; sexp whatever is in it, so the body is two in from the head in every arity,
;; and a vector that wraps aligns under its own first element.  From
;; `test/programs/dotimes-range.flan'.
(test-flan-mode--check
 "a three-element dotimes vector indents its body by two"
 "(dotimes [i 2 5]
  (print i)
  (println \"\"))")

(test-flan-mode--check
 "and a four-element one, counting down, does the same"
 "(dotimes [i 9 -1 -1]
  (print i)
  (println \"\"))")

(test-flan-mode--check
 "and a binding vector that wraps aligns under its first element"
 "(dotimes [i 0
          (length items)
          2]
  (print i))")

;; The object and dispatch forms all begin `def', so they reach the `:defn'
;; fallback and indent their bodies by two.  `defmethod' is the one with two
;; names before the parameter vector — the generic and the dispatch value —
;; which is exactly the case a count would have got wrong.  From
;; `test/programs/dev-classes.flan'.
(test-flan-mode--check
 "a defmethod indents its body by two, past generic and dispatch value"
 "(defmethod area point [p]
  (* (get p :x)
     (get p :y)))")

(test-flan-mode--check
 "a defclass puts its slot vector in the body column"
 "(defclass point
  [x y])")

(test-flan-mode--check
 "and a defmulti indents its body by two"
 "(defmulti describe [thing] dyn
  (class-of thing))")

;; `fn' is `defn' with no name and no return type: the parameter vector, then
;; the body.  From `test/programs/higher-order.flan', written down the page.
(test-flan-mode--check
 "an fn indents its body under its parameters by two"
 "(sort-by s (fn [a b]
             (< a b)))")

;; A macro body indents by two like any `def…' form.  It reaches that through
;; the `\\`def' fallback rather than through an entry, which is worth pinning:
;; the fallback is what covers every definer nobody listed.
(test-flan-mode--check
 "a defmacro indents its body by two"
 "(defmacro both [& args]
  `(do ~@args))")

;; A macro's parameter list destructures now, so it holds names and a `&'
;; rest marker rather than one blob.  It is still a vector, so a list that
;; wraps aligns name under name like every other vector here — and `&' is a
;; name character, so it does not split the marker off from what follows.
(test-flan-mode--check
 "a wrapped destructuring parameter list aligns under its first parameter"
 "(defmacro guard [test message
                 & body]
  `(when ~test ~@body))")

;; A generic `defn' writes its constraint map between the return type and the
;; body — `test/programs/generic-map-reject.flan'.  It is a brace, so it aligns
;; under its first element like every other brace, and the body after it is
;; still two in from `defn'.
(test-flan-mode--check
 "a where clause sits in the body column and does not move the body"
 "(defn is-seen [k $t] bool
  {:where (is-hashable $t)}
  (let [m (map-new t i32)]
    (put m k 1)))")

;; A comma is whitespace, so a vector written with commas is the same vector
;; and lines up the same way.  It reads as one now because the syntax table
;; says so; before, a comma was punctuation and sat in the middle of a name.
(test-flan-mode--check
 "commas between bindings change nothing"
 "(let [vel 1.0,
      y 2.0]
  (print y))")

;; A `with-' form is a body, qualified or not, whatever it takes on the head's
;; line — `clojure-indent-function''s fallback.  From `examples/core-2d-camera.flan'.
(test-flan-mode--check
 "a qualified with- form indents its body by two past an argument"
 "(rl/with-mode-2d camera
  (rl/draw-rectangle-rec player rl/red)
  (rl/draw-grid 10 1.0))")

(test-flan-mode--check
 "a qualified def form indents its body by two"
 "(m/defthing name
  (body))")

;; A qualified name finds the spec of its unqualified part.
(test-flan-mode--check
 "a qualified when keeps when's spec"
 "(rl/when (ready?)
  (go))")

;; `default…' begins with `def' and is not a definer.
(test-flan-mode--check
 "a default-prefixed call aligns its arguments"
 "(default-color a
               b)")

;; A cond result on its own line sits under its test, not deeper.
(test-flan-mode--check
 "a cond result on its own line aligns with its test"
 "(cond
  (= k 1)
  (one)
  :else
  (other))")

(test-flan-mode--check
 "a match result on its own line aligns with its pattern"
 "(match v
  (Int n) n
  (List items)
  (length items))")

;; A trailing argument of an ordinary call aligns under the first argument,
;; even when it is long; only a `with-', `def' or specced head gives a body.
(test-flan-mode--check
 "an ordinary call's arguments align under the first one"
 "(push missing
      `(when (ok) (go)))")


;;; Font lock

;; What is drawn is the language; what is drawn plain is the program.  A field
;; label, a builtin and a number are all part of reading a program and none of
;; them is coloured, which is how clojure-mode treats the same three.

(defun test-flan-mode--face-at (text needle)
  "The face on the first character of NEEDLE in TEXT, under `flan-mode'."
  (with-temp-buffer
    (insert text)
    (flan-mode)
    (font-lock-ensure)
    (goto-char (point-min))
    (search-forward needle)
    (get-text-property (- (point) (length needle)) 'face)))

(message "\n-- font lock")

;; The keyword rule is what is left of the constants: an enum member resolves
;; against a type and is worth marking.
(test-flan--check "an enum member is a constant"
                  (eq (test-flan-mode--face-at
                       "(rl/is-mouse-button-down :mouse-left)" ":mouse-left")
                      'font-lock-constant-face))

(dolist (case '(("(rl/Vector2 {.x 1.0 .y 2.0})" ".x" "a struct literal's field label")
                ("(rl/Vector2 {.x 1.0 .y 2.0})" ".y" "and the second one")
                ("(set total (.bytes c))" ".bytes" "a field accessor")
                ("(push v 42)" "42" "a number")
                ("(set mask 0xFF)" "0xFF" "a hex number")
                ("(push v x)" "push" "a builtin")
                ("(println (length xs))" "length" "and another")))
  (test-flan--check (format "%s is plain" (nth 2 case))
                    (null (test-flan-mode--face-at (nth 0 case) (nth 1 case)))))

;; A dot inside a number is not a label, and neither is the dot in a name that
;; has one in the middle.
;; A dot in the middle of a name is not a label: `\_<' anchors the rule to the
;; start of a symbol, and `a.b' is one symbol starting at `a'.
(test-flan--check "a dot inside a name does not start a label"
                  (null (test-flan-mode--face-at "(f alpha.beta)" ".beta")))

;; The pass over the static table.  Each row is a piece of the corpus and the
;; face the name in it should carry; several of these were drawn as nothing at
;; all until the table was brought back into line with `lib/parse.ml' and
;; `lib/check.ml'.
(dolist (case '(;; A definer that was missing: the head was not a keyword and
                ;; the name after it was not a function name.
                ("(defmacro both [& args] `(do ~@args))" "defmacro"
                 font-lock-keyword-face "defmacro's head")
                ("(defmacro both [& args] `(do ~@args))" "both"
                 font-lock-function-name-face "and the macro's name")
                ("(declare-c mouse-down? [b i32] bool \"X\")" "declare-c"
                 font-lock-keyword-face "declare-c's head")
                ;; The defining forms that arrived with the object system and
                ;; with the def/defonce/defconst trio.
                ("(def ticks i64 0)" "def" font-lock-keyword-face "def's head")
                ("(def ticks i64 0)" "ticks" font-lock-function-name-face
                 "and the name it introduces")
                ("(defonce seed i64 1)" "defonce" font-lock-keyword-face
                 "defonce")
                ;; A private defn: the head as a whole, not `defn' and a
                ;; stray `-', and the name after it.
                ("(defn- mix [a i32] i32 a)" "defn-" font-lock-keyword-face
                 "defn-'s head")
                ("(defn- mix [a i32] i32 a)" "mix"
                 font-lock-function-name-face "and the private function's name")
                ("(defclass point [x y])" "defclass" font-lock-keyword-face
                 "defclass")
                ("(defgeneric area [self] dyn)" "defgeneric"
                 font-lock-keyword-face "defgeneric")
                ("(defmethod area point [p] 1)" "defmethod"
                 font-lock-keyword-face "defmethod")
                ;; `handler-case' is implemented now and is a keyword like the
                ;; other three condition forms.
                ("(handler-case (go) [(E [c] 1)])" "handler-case"
                 font-lock-keyword-face "handler-case")
                ;; Special forms the old list had never heard of.
                ("(cond (= a 1) 2)" "cond" font-lock-keyword-face "cond")
                ;; until is a prelude macro, drawn as the control flow it is.
                ("(until (> i 3) (go))" "until" font-lock-keyword-face "until")
                ("(and a b)" "and" font-lock-keyword-face "and")
                ("(handler-bind [(E [c] 1)] (go))" "handler-bind"
                 font-lock-keyword-face "handler-bind")
                ("(restart-case (go) (retry [] 1))" "restart-case"
                 font-lock-keyword-face "restart-case")
                ("(signal ArithError {.op 1})" "signal"
                 font-lock-keyword-face "signal")
                ("(dotimes [b 3] (break :outer))" "break"
                 font-lock-keyword-face "break")
                ;; The two array constructors, which the parser reads itself
                ;; because their dimensions are in brackets — see
                ;; `test/programs/array-fill.flan'.
                ("(array-fill [rows cols] 255)" "array-fill"
                 font-lock-keyword-face "array-fill")
                ("(array-gen [n] f)" "array-gen"
                 font-lock-keyword-face "array-gen")
                ;; A builtin is a call and not a form the parser knows, and it
                ;; is left plain — the rows for that are above, with the field
                ;; labels and the numbers.
                ;;
                ;; Types.
                ("(defn f [x dyn] dyn x)" "dyn" font-lock-type-face "dyn")
                ("(def v (Vec u8))" "Vec" font-lock-type-face "Vec")
                ("(declare apply [(Fn [i64] i64)] i64)" "Fn"
                 font-lock-type-face "Fn")
                ("(declare call [(CFn [i64] i64)] i64)" "CFn"
                 font-lock-type-face "CFn")
                ("(defn is-seen [k $t] bool 1)" "$t" font-lock-type-face
                 "a type variable")
                ;; The package alias of a qualified name, `clojure-mode''s
                ;; rule for a namespace.
                ("(rl/draw-text \"hi\" 1 2 3)" "rl" font-lock-type-face
                 "a package alias")
                ("(defn f [x int] float 1.0)" "int" font-lock-type-face
                 "int, the builtin alias")
                ("(defn f [s [const u8]] 1)" "const" font-lock-type-face
                 "const, in a read-only slice type")
                ;; Constants that stand for themselves.
                ("(set done true)" "true" font-lock-constant-face "true")
                ("(= o None)" "None" font-lock-constant-face "None")
                ("(set x nil)" "nil" font-lock-constant-face "nil")
                ("(def buf (Vec u8) uninit)" "uninit" font-lock-constant-face
                 "uninit, which is only ever written here")))
  (test-flan--check (format "%s is drawn" (nth 3 case))
                    (eq (test-flan-mode--face-at (nth 0 case) (nth 1 case))
                        (nth 2 case))))

;; `Unit' is a name the resolver answers to and the parser refuses — unit is
;; written `()'.  Drawing it as a type would advertise a spelling that does not
;; compile, which is the same rule that keeps `await' out of the keyword list.
(test-flan--check
 "Unit is not drawn as a type, because the parser refuses the word"
 (null (test-flan-mode--face-at "(defn f [] Unit 1)" "Unit")))

;; `context/allocator' has a slash in it and is not a qualified name: there is
;; no package called `context'.  The constants rule runs first for exactly this
;; reason, and this is what would notice if it stopped.
(test-flan--check
 "context/allocator is one constant and not an alias and a name"
 (eq (test-flan-mode--face-at "(free-all (context/allocator))" "context/")
     'font-lock-constant-face))

;; The name after a package alias is left for the running program to speak for
;; — see the dynamic section below.  With no program it is undrawn, and that is
;; the state a file opened on its own is in.
(test-flan--check
 "the name after the alias is left alone"
 (null (test-flan-mode--face-at "(rl/draw-text \"hi\" 1 2 3)" "draw-text")))


;;; Font lock from the running program

;; `flan.el' adds a second set of rules that draw what the program *defines* —
;; a macro as a macro, a function as a function — and everything below drives
;; them from a fixture `flan--defs' rather than from a daemon.  The live half,
;; where an evaluation is accepted and the name lights up without anyone asking
;; for it, is in test-flan.el, which has a program to evaluate against.

(require 'flan)

(defconst test-flan-mode--defs
  ;; The shape `Dev.defs' answers with: (NAME KIND SIGNATURE LOC DOC).
  '(("settle"     "fn"     "settle [i32 i32] ()" "sand.flan:3" "")
    ("ticks"      "var"    "ticks i64" "" "")
    ("gravity"    "const"  "gravity f32" "" "")
    ("with-retry" "macro"  "with-retry [args] Form" "" "")
    ("Pixel"      "struct" "Pixel" "" "")
    ("Shape"      "data"   "Shape [Empty (Dot [x f64  y f64])]" "" "")
    ("Shape.Empty" "case"  "Shape.Empty" "" "")
    ("Shape.Dot"  "case"   "(Shape.Dot [x f64  y f64])" "" "")
    ("point"      "class"  "point [x y]" "sand.flan:20:1" "")
    ("Key"        "enum"   "Key" "" "")
    ("sim/step"   "fn"     "sim/step [] ()" "sand.flan:9" "")
    ("a/draw"     "fn"     "a/draw [] ()" "" "")
    ("b/draw"     "fn"     "b/draw [] ()" "" "")
    ;; The program is allowed to define a name the language already uses.  It
    ;; does not get to repaint it.
    ("length"     "fn"     "length [i32] i32" "" "")
    ("if"         "fn"     "if [i32] i32" "" "")
    ;; And a kind this editor has never heard of, which the daemon is allowed
    ;; to add.
    ("somenewthing" "sigil" "somenewthing" "" ""))
  "A `defs' reply to draw against.")

(defun test-flan-mode--dyn-face (text needle &optional defs)
  "The face on NEEDLE in TEXT with DEFS as what the program defines."
  (let ((flan--defs (if (eq defs 'none) nil (or defs test-flan-mode--defs))))
    (flan--dynamic-rebuild)
    (with-temp-buffer
      (insert text)
      (flan-mode)
      (flan--dynamic-install)
      (font-lock-ensure)
      (goto-char (point-min))
      (search-forward needle)
      (get-text-property (- (point) (length needle)) 'face))))

(message "\n-- font lock from the program")

;; `flan-font-lock-dynamically' is a list of kinds and defaults to macros
;; alone, so a macro is drawn and everything else the program defines is not.
;; A macro is the one kind a reader cannot work out from the call, because its
;; arguments are not evaluated; a function drawn as a function says only that
;; the name exists.  cider-mode's default is the same shape.
(test-flan--check
 "a macro the program defines is drawn as one"
 (eq (test-flan-mode--dyn-face "(with-retry (go))" "with-retry")
     'flan-macro-face))

(dolist (case '(("(settle 1 2)" "settle" "a function")
                ("(set ticks 0)" "ticks" "a global")
                ("(print gravity)" "gravity" "a constant")
                ("(def p (Vec Pixel))" "Pixel" "a struct")
                ("(defn f [s Shape] () 1)" "Shape" "a data type")
                ("(def k Key)" "Key" "an enum")))
  (test-flan--check
   (format "%s the program defines is left plain" (nth 2 case))
   (null (test-flan-mode--dyn-face (nth 0 case) (nth 1 case)))))

;; Asked for by name, the other kinds still draw: the default is a default and
;; not a removal.
(test-flan--check
 "a function is drawn when the setting asks for one"
 (let ((flan-font-lock-dynamically '(macro fn)))
   (eq (test-flan-mode--dyn-face "(settle 1 2)" "settle")
       'flan-function-face)))

(test-flan--check
 "and t still draws every kind"
 (let ((flan-font-lock-dynamically t))
   (eq (test-flan-mode--dyn-face "(set ticks 0)" "ticks")
       'flan-global-face)))

;; A macro and a function must not look alike — the whole point — so this is
;; asserted as a difference and not only as two faces.
(test-flan--check
 "a macro and a function are not drawn the same"
 (let ((flan-font-lock-dynamically '(macro fn)))
   (not (eq (test-flan-mode--dyn-face "(with-retry (go))" "with-retry")
            (test-flan-mode--dyn-face "(settle 1 2)" "settle")))))

;; A macro is compiled, so it has a body to disassemble and to lower — and the
;; lists that offer "a thing with a body" used to filter on kind `fn' alone.
;; Giving macros a kind of their own would have quietly dropped them out of
;; `flan-disassemble', `flan-disassemble-ir' and `flan-lowering' unless every
;; one of those learned the second word.
(test-flan--check
 "a macro is offered by the completion table for a compiled body"
 (let ((flan--defs test-flan-mode--defs))
   (and (member "with-retry" (flan--compiled-names))
        (member "settle" (flan--compiled-names)))))

(test-flan--check
 "and a global is not, because it has no body"
 (let ((flan--defs test-flan-mode--defs))
   (not (member "ticks" (flan--compiled-names)))))

;; A constructor is `Type.Case' and is one symbol.  The daemon lists each
;; case under that name, so the whole symbol is drawn, and it is drawn when
;; the data type is: a case is part of its type, not a kind to ask for apart.
(test-flan--check
 "a constructor is drawn whole, case half included"
 (let ((flan-font-lock-dynamically '(data)))
   (eq (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" ".Dot")
       'flan-type-face)))

(test-flan--check
 "and not when data types are not asked for"
 (null (test-flan-mode--dyn-face "(match s (Shape.Dot) 1)" "Shape.Dot")))

(test-flan--check
 "a case the program does not have draws only its type half"
 (let ((flan-font-lock-dynamically t))
   (and (eq (test-flan-mode--dyn-face "(match s (Shape.Nope) 1)" "Shape")
            'flan-type-face)
        (null (test-flan-mode--dyn-face "(match s (Shape.Nope) 1)" ".Nope")))))

(test-flan--check
 "a class the program defines is drawn when classes are asked for"
 (let ((flan-font-lock-dynamically '(class)))
   (eq (test-flan-mode--dyn-face "(point 1 2)" "point") 'flan-type-face)))

(test-flan--check
 "a name the program has never heard of is left alone"
 (null (test-flan-mode--dyn-face "(never-defined 1)" "never-defined")))

(test-flan--check
 "and so is a kind this editor does not know"
 (null (test-flan-mode--dyn-face "(somenewthing)" "somenewthing")))

;; The static rules win.  `length' is not the test it once was — a builtin is
;; drawn plain now, so both answers are plain and the row proves nothing — so
;; the claim rests on `if', which the language draws and the program may not
;; repaint.  Asked for every kind, so the program's own rule is live.
(test-flan--check
 "a program function named if is still drawn as the special form"
 (let ((flan-font-lock-dynamically t))
   (eq (test-flan-mode--dyn-face "(if a 1 2)" "if") 'font-lock-keyword-face)))

;; A buffer inside a package writes `step' for what the program calls
;; `sim/step'.  One package offers it, so it resolves — the rule `flan--lookup'
;; already follows for eldoc and `M-.'.
(test-flan--check
 "an unqualified name that one package offers is drawn"
 (let ((flan-font-lock-dynamically '(macro fn)))
   (eq (test-flan-mode--dyn-face "(step)" "step") 'flan-function-face)))

(test-flan--check
 "and one that two packages offer is not, because that would be a guess"
 (let ((flan-font-lock-dynamically '(macro fn)))
   (null (test-flan-mode--dyn-face "(draw)" "draw"))))

;; With no session there is nothing to say, and the buffer has to be drawn
;; exactly as `flan-mode' alone draws it.
(test-flan--check
 "with no session a program name is undrawn"
 (null (test-flan-mode--dyn-face "(settle 1 2)" "settle" 'none)))

(test-flan--check
 "and the language is drawn as it always was"
 (eq (test-flan-mode--dyn-face "(let [a 1] a)" "let" 'none)
     'font-lock-keyword-face))

;; Whole-buffer, because "nothing changes" is a claim about every character and
;; not about one name: a corpus file drawn with no session must come out
;; character for character and face for face as it did before any of this.
(defun test-flan-mode--faces (text &optional defs)
  "Every (POS . FACE) in TEXT, with DEFS as what the program defines."
  (let ((flan--defs (if (eq defs 'none) nil defs)))
    (flan--dynamic-rebuild)
    (with-temp-buffer
      (insert text)
      (flan-mode)
      (flan--dynamic-install)
      (font-lock-ensure)
      (let (acc)
        (dotimes (i (1- (point-max)))
          (push (get-text-property (1+ i) 'face) acc))
        (nreverse acc)))))

;; The text carries a macro call, because the default draws macros and nothing
;; else: a body of plain functions and globals is the same picture either way
;; and the last of the three claims below would be asserting nothing.
(let ((text "(defn settle [row i32] ()\n  (let [vel gravity]\n    (with-retry (set ticks vel))))\n"))
  (test-flan--check
   "a buffer with no session is drawn exactly as the mode alone draws it"
   (equal (test-flan-mode--faces text 'none)
          (let ((flan-font-lock-dynamically nil))
            (test-flan-mode--faces text test-flan-mode--defs))))
  ;; ...and turning the setting off with a session up is the same picture,
  ;; which is what makes it an off switch rather than a reconnect.
  (test-flan--check
   "and turning the option off gives that same picture back"
   (equal (test-flan-mode--faces text 'none)
          (let ((flan-font-lock-dynamically nil))
            (test-flan-mode--faces text test-flan-mode--defs))))
  (test-flan--check
   "while with one it is drawn differently"
   (not (equal (test-flan-mode--faces text 'none)
               (test-flan-mode--faces text test-flan-mode--defs)))))

;; Installing twice must not leave two copies of the rule behind: a refresh
;; happens after every accepted evaluation, and a rule added each time would
;; make redisplay slower for as long as the session lasted.
(test-flan--check
 "installing repeatedly leaves one copy of the rule"
 (let ((flan--defs test-flan-mode--defs))
   (flan--dynamic-rebuild)
   (with-temp-buffer
     (flan-mode)
     (font-lock-ensure)
     (dotimes (_ 5) (flan--dynamic-install))
     (= 1 (seq-count (lambda (k) (equal k (car flan--dynamic-keywords)))
                     font-lock-keywords)))))

;;; Electric pairs

;; `electric-pair-mode' reads the syntax table and nothing else, so the three
;; bracket pairs Flan writes work without a word being said about them — and
;; that is exactly why it wants a test: the table gained entries in this pass,
;; and a mistake in one of them would show up here first.

(message "\n-- electric pairs")

(defun test-flan-mode--pair (open)
  "Type OPEN in a Flan buffer with `electric-pair-mode' on, and read the line."
  (with-temp-buffer
    (flan-mode)
    (electric-pair-local-mode 1)
    (let ((last-command-event open))
      (call-interactively #'self-insert-command))
    (buffer-string)))

(dolist (case '((?\( "()" "a paren")
                (?\[ "[]" "a bracket")
                (?{ "{}" "a brace")
                (?\" "\"\"" "a string")))
  (test-flan--check (format "%s closes itself" (nth 2 case))
                    (equal (test-flan-mode--pair (nth 0 case)) (nth 1 case))))

(provide 'test-flan-mode)
;;; test-flan-mode.el ends here