Joseph Ferano
8a94f16acd
Its stdout is a pipe into the daemon now, and whatever it printed since the last reply rides along with the next one into *flan-output*. Arriving with a reply rather than by a separate request is the point: the output an evaluation itself caused is the output anyone wants to see. Draining that pipe is a liveness requirement, not a nicety. A pipe nobody reads fills at 64K and the next write blocks the program forever, so it is read from the accept loop's select whether or not an editor is asking, and the buffer is capped - a program printing every frame must not grow the daemon without limit, and the newest text is the useful end. test_dev read the program's transcript off the daemon's stdout, which is no longer where it goes; it collects :output from replies instead, which is also what the editor does. The emacs test moved to a fixture that keeps running, since it now evaluates more times than the old one had reloads to give.
87 lines
3.7 KiB
EmacsLisp
87 lines
3.7 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)
|
|
|
|
(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))
|
|
|
|
(flan-connect socket)
|
|
(test-flan--check "connected" (process-live-p flan-dev--connection))
|
|
|
|
(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 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))
|
|
|
|
(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
|