12f99702b4
Whether a program is on the other end is the one fact worth a permanent place on screen, because every command in the client is a lie without it. Until now it was discovered by something failing, which is the worst moment to learn it. Three states, not two. `off' is never connected; `lost' is a daemon that has gone away, which is the ordinary case rather than an error — `flan dev' ends when its program does, and a program under development exits all the time. So `lost' is reconnected from, on the socket it was on, the next time anything is sent. The reconnect is strictly *before* a send and never after one. A connection that dies mid-request might have died after the daemon took the request and ran it; resending would install a definition twice, or evaluate a side-effecting expression twice. That case now reports what happened and says it was not resent, rather than silently doing it again. A socket that is not there is refused by name with the path, and a deliberate `flan-disconnect' forgets the socket, so the next command says "not connected" instead of quietly reopening what was just closed.
229 lines
11 KiB
EmacsLisp
229 lines
11 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)
|
|
|
|
(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")
|
|
(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))))))
|
|
|
|
;; 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
|