9e7eba1479
An install that reports nothing is indistinguishable from one that failed silently, which is the one thing this loop cannot afford: the whole promise is that the running program now has the body you just wrote. The names come from the reply rather than from what was typed, because the daemon is the one that knows which of them it installed — a `defvar' the program already had is not among them, and the reply already says so with `:note'. That case now reads "nothing to install" instead of quoting a build time for a build that did not happen. `:fns` and `:names' are reported separately for the same reason: a buffer of five functions and two vars should not report as five of anything. A long list is counted and then sampled rather than truncated, since an echo area cut off in the middle of the tenth name tells you neither how many there were nor which. And the region that was sent is flashed, which answers a question the echo area cannot: `beginning-of-defun' may well have found a different form from the one you thought point was in.
266 lines
13 KiB
EmacsLisp
266 lines
13 KiB
EmacsLisp
;;; 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)
|
|
|
|
(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)))
|
|
(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))))
|
|
|
|
;; 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)))))
|
|
|
|
;; 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))))
|
|
|
|
;; 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"))
|
|
|
|
;; 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 (print-line \"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 "(print-line \"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))))
|
|
|
|
(flan-disconnect)
|
|
(test-flan--check "disconnected" (not (process-live-p flan-dev--connection)))
|
|
|
|
(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
|