JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge: the Emacs client stops eating frames, replies, and second sessions

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-18 07:40:37 +07:00
commit 1eea388a47
3 changed files with 444 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

336
emacs/flan-dev.el
View File

@ -137,6 +137,31 @@ program finishes without announcing it, and the commonest way to finish is
closing its window with the mouse. Nothing about the session has gone — closing its window with the mouse. Nothing about the session has gone —
`flan-rerun' runs `main' again, with the globals as the last run left them.") `flan-rerun' runs `main' again, with the globals as the last run left them.")
;; The daemon this Emacs started, which is not the same thing as the
;; connection and must not be confused with one: `flan-connect' attaches to a
;; program running in a terminal, and from that moment the two name different
;; sessions. Kept up here with the rest of the client's state rather than
;; beside the code that starts a daemon, because `flan-connect' reads them
;; before it replaces anything.
(defvar flan-dev--file nil
"The program the daemon this Emacs started was started on, or nil.
Kept so that it can be started again on the same program and the same
socket, which is what `flan-dev-restart-program' is.")
(defvar flan-dev--daemon nil
"The `flan dev' process this Emacs started, or nil.
A daemon started in a terminal is not here, and `flan-connect' still works
for it — this is only what Emacs is responsible for killing.")
(defvar flan-dev--daemon-socket nil
"Path of the socket the daemon this Emacs started is listening on, or nil.
`flan-dev--socket' is where the *connection* is, and the two part company the
moment `flan-connect' attaches to something else: a second program in another
terminal is an ordinary thing to go and look at, and it does not stop this
Emacs being responsible for the daemon it launched. Keeping both is what lets
`flan-dev-quit' tell one session from two.")
(defvar flan-dev--busy nil (defvar flan-dev--busy nil
"Non-nil while a request is waiting for its reply. "Non-nil while a request is waiting for its reply.
`flan-dev--read-reply' runs `accept-process-output', which runs timers, so `flan-dev--read-reply' runs `accept-process-output', which runs timers, so
@ -177,16 +202,46 @@ original left a comment about. See `flan-watch--tick'."
(defun flan-dev--extract-reply (body-start n) (defun flan-dev--extract-reply (body-start n)
"Read the N bytes at BODY-START as a reply and delete the frame. "Read the N bytes at BODY-START as a reply and delete the frame.
Point is in the process buffer, and the frame is known to be complete." Point is in the process buffer, and the frame is known to be complete.
The frame is deleted *before* it is read, which is the whole of the ordering
and the only reason this is worth a comment. A payload that will not read is
a bug at the other end, and the client's job is to report it once: reading
first would leave those bytes at the head of the buffer, so the next request
would read the same unreadable frame again, and every request after that —
one bad reply and the connection is wedged until Emacs is restarted.
Consuming it first costs the reply, which was lost anyway, and leaves the
stream in step for the request that follows."
(let* ((end (byte-to-position (+ (position-bytes body-start) n))) (let* ((end (byte-to-position (+ (position-bytes body-start) n)))
(text (decode-coding-string (text (decode-coding-string
(encode-coding-string (buffer-substring-no-properties (encode-coding-string (buffer-substring-no-properties
body-start end) body-start end)
'utf-8 t) 'utf-8 t)
'utf-8)) 'utf-8)))
(form (car (read-from-string text))))
(delete-region (point-min) end) (delete-region (point-min) end)
form)) (car (read-from-string text))))
(defun flan-dev--no-reply (proc)
"Signal that PROC has not answered, saying which of the two silences it is.
Deliberately not retried, in either case. If the daemon took the request and
died before replying, the evaluation may well have happened — sending it again
would install it twice, or run a side-effecting expression twice.
Reconnecting happens before a send, never after one."
(if (process-live-p proc)
;; What a person does next, not just what failed. A live daemon that
;; has not answered is nearly always still working — a first compile of
;; a large program on a cold object cache is the case that runs long —
;; and the daemon's own log says which step it is on, so the message
;; names the buffer to look in and the setting to raise rather than
;; leaving both to be discovered.
(error "flan dev: no reply in %ss from %s; the daemon may still be building — see %s for its log, and raise `flan-dev-reply-timeout' if this build is simply long"
flan-dev-reply-timeout
(abbreviate-file-name (or flan-dev--socket "the daemon"))
flan-dev-daemon-buffer)
(error
"flan dev: the daemon on %s closed the connection; not resent, because it may already have run"
(abbreviate-file-name (or flan-dev--socket "?")))))
(defun flan-dev--read-reply (proc) (defun flan-dev--read-reply (proc)
"Block until PROC sends one complete framed message, and read it." "Block until PROC sends one complete framed message, and read it."
@ -198,31 +253,32 @@ Point is in the process buffer, and the frame is known to be complete."
(< (float-time) deadline)) (< (float-time) deadline))
(accept-process-output proc 0.05)) (accept-process-output proc 0.05))
(goto-char (point-min)) (goto-char (point-min))
;; Nothing is erased here, and that is the difference between the two
;; deadlines. A header that has not arrived in full is a valid prefix
;; of a reply still on its way — throwing it away would turn a daemon
;; that is merely slow into a stream out of step by however much of the
;; count had landed.
(unless (re-search-forward "\\`\\([0-9]+\\)\n" nil t) (unless (re-search-forward "\\`\\([0-9]+\\)\n" nil t)
;; Deliberately not retried. If the daemon took the request and died (flan-dev--no-reply proc))
;; before replying, the evaluation may well have happened — sending it
;; again would install it twice, or run a side-effecting expression
;; twice. Reconnecting happens before a send, never after one.
;; What a person does next, not just what failed. A live daemon that
;; has not answered is nearly always still working — a first compile
;; of a large program on a cold object cache is the case that runs
;; long — and the daemon's own log says which step it is on, so the
;; message names the buffer to look in and the setting to raise
;; rather than leaving both to be discovered.
(if (process-live-p proc)
(error "flan dev: no reply in %ss from %s; the daemon may still be building — see %s for its log, and raise `flan-dev-reply-timeout' if this build is simply long"
flan-dev-reply-timeout
(abbreviate-file-name (or flan-dev--socket "the daemon"))
flan-dev-daemon-buffer)
(error
"flan dev: the daemon on %s closed the connection; not resent, because it may already have run"
(abbreviate-file-name (or flan-dev--socket "?")))))
(let* ((n (string-to-number (match-string 1))) (let* ((n (string-to-number (match-string 1)))
(body-start (point))) (body-start (point)))
(while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n) (while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n)
(< (float-time) deadline)) (< (float-time) deadline))
(accept-process-output proc 0.05)) (accept-process-output proc 0.05))
(flan-dev--extract-reply body-start n))))) (if (>= (- (position-bytes (point-max)) (position-bytes body-start)) n)
(flan-dev--extract-reply body-start n)
;; The body never came, so the count at the head of the buffer is a
;; promise about bytes that will never be made good: reading on from
;; here would take the *next* reply's header as this one's payload
;; and every request after it would be answered by the one before.
;; The frame is dead — drop it, and the connection is in step again
;; for whatever a person does next. Testing the condition again
;; rather than trusting the loop is the whole fix: falling through
;; to `flan-dev--extract-reply' with a short buffer signals a
;; wrong-type error from `byte-to-position', which says nothing
;; about a timeout to whoever reads it.
(erase-buffer)
(flan-dev--no-reply proc))))))
(defun flan-dev--append-output (text) (defun flan-dev--append-output (text)
"Append TEXT, the running program's own output, to its buffer." "Append TEXT, the running program's own output, to its buffer."
@ -357,22 +413,35 @@ with it, and a rejected evaluation is a likely moment to *become* stopped."
reply) reply)
(defvar flan-dev-settle-hook nil (defvar flan-dev-settle-hook nil
"Run before a request is sent, with the connection already open. "Run before anything is sent, against the connection as it stands.
The protocol is one reply per request on one connection, and that is the whole The protocol is one reply per request on one connection, and that is the whole
reason this exists. Anything that sends without waiting — the watch timer is reason this exists. Anything that sends without waiting — the watch timer is
the only such thing — leaves a reply in flight that the *next* request would the only such thing — leaves a reply in flight that the *next* request would
otherwise read as its own. So a sender-in-flight hangs a function here that otherwise read as its own. So a sender-in-flight hangs a function here that
collects its own reply first, and the invariant holds: exactly one request collects its own reply first, and the invariant holds: exactly one request
outstanding, and every reply consumed by whoever asked for it.") outstanding, and every reply consumed by whoever asked for it.
Before the connection is checked, not after, and that ordering is the point.
An outstanding reply belongs to the connection it was asked on; if the daemon
has been restarted under Emacs, that connection is gone and no reply is coming
on the new one. Running this first is what lets a hook see that for itself
and drop its pending flag, rather than sitting out a full
`flan-dev-reply-timeout' waiting on a socket the question was never asked
down.")
(defun flan-dev--request (form) (defun flan-dev--request (form)
"Send FORM to the connected program and return its reply." "Send FORM to the connected program and return its reply."
(let* ((proc (flan-dev--live-connection)) ;; `flan-dev--busy' first of all, and around the reconnect as well as around
(flan-dev--busy t)) ;; the send: `flan-dev--live-connection' asks the new daemon what it
;; defines, and `accept-process-output' runs timers, so a poll firing in the
;; middle of that would be a second conversation on the connection this one
;; just opened.
(let ((flan-dev--busy t))
(run-hooks 'flan-dev-settle-hook) (run-hooks 'flan-dev-settle-hook)
(flan-dev--absorb (progn (flan-dev--send proc form) (let ((proc (flan-dev--live-connection)))
(flan-dev--read-reply proc))))) (flan-dev--absorb (progn (flan-dev--send proc form)
(flan-dev--read-reply proc))))))
;;; Noticing that the program stopped ;;; Noticing that the program stopped
@ -410,6 +479,15 @@ Set to nil to leave the program's state to whatever replies happen to say."
(let ((proc flan-dev--connection) (let ((proc flan-dev--connection)
(flan-dev--busy t)) (flan-dev--busy t))
(ignore-errors (ignore-errors
;; The same settle every other sender does, and for the same reason.
;; `flan-dev--busy' is not enough on its own: the watch timer leaves a
;; request in flight and *clears* nothing, deliberately — it binds no
;; busy flag, because it never waits — so a poll that checked only the
;; flag would send `describe' with the watch's reply still coming and
;; read that instead. The two would then stay swapped for the rest of
;; the session, each consumer answering the other's question, which is
;; exactly the interleaving `flan-dev-settle-hook' exists to prevent.
(run-hooks 'flan-dev-settle-hook)
;; `describe' rather than `break': it is the cheap op, it is what ;; `describe' rather than `break': it is the cheap op, it is what
;; drains the program's output, and the state is on every reply anyway. ;; drains the program's output, and the state is on every reply anyway.
;; Asking `break' would fetch restart names nobody is choosing from. ;; Asking `break' would fetch restart names nobody is choosing from.
@ -516,6 +594,29 @@ With no argument, look for `flan-dev-socket-name' up from this buffer."
(list (or (flan-dev--find-socket) (list (or (flan-dev--find-socket)
(read-file-name "flan dev socket: ")))) (read-file-name "flan dev socket: "))))
(unless socket (user-error "No %s found above this buffer" flan-dev-socket-name)) (unless socket (user-error "No %s found above this buffer" flan-dev-socket-name))
(setq socket (expand-file-name socket))
;; Attaching to a second program is a thing people do on purpose — a daemon
;; running in a terminal is exactly what this command is for — but it leaves
;; two sessions where the client can only name one, and until it was said
;; out loud the cost fell on `flan-dev-quit': "stop the daemon this Emacs
;; started" ended up closing whatever the connection happened to be pointing
;; at *and* killing the daemon, which by then were two different programs.
;; Naming both is most of the fix, because the situation is fine once it is
;; known about; the refusal for a Lisp caller matches `flan-dev''s, where a
;; running program is never discarded without someone saying so.
(when (and (process-live-p flan-dev--daemon)
flan-dev--daemon-socket
(not (equal socket flan-dev--daemon-socket)))
(let ((mine (abbreviate-file-name (or flan-dev--file flan-dev--daemon-socket)))
(theirs (abbreviate-file-name socket)))
(if (called-interactively-p 'interactive)
(unless (y-or-n-p
(format "%s is running here; connect to %s and leave it? "
mine theirs))
(user-error "flan dev: staying with %s" mine))
(user-error
"flan dev: %s is running from this Emacs; M-x flan-connect interactively to attach to %s as well"
mine theirs))))
(flan-dev--open socket) (flan-dev--open socket)
(let ((r (flan-dev--request '(:op "describe")))) (let ((r (flan-dev--request '(:op "describe"))))
(flan-dev-refresh-defs) (flan-dev-refresh-defs)
@ -571,21 +672,18 @@ A name is looked up on `exec-path'; a path is used as given."
It builds the program first, which for a cold project is most of this." It builds the program first, which for a cold project is most of this."
:type 'number) :type 'number)
(defvar flan-dev--file nil ;; The three variables that say what this Emacs started — `flan-dev--file',
"The program the daemon this Emacs started was started on, or nil. ;; `flan-dev--daemon' and `flan-dev--daemon-socket' — are declared with the
Kept so that it can be started again on the same program and the same ;; rest of the client's state at the top of the file for the same reason:
socket, which is what `flan-dev-restart-program' is.") ;; `flan-connect' reads all three before it replaces a connection, and the
;; byte-compiler reads a file in order.
(defvar flan-dev--daemon nil
"The `flan dev' process this Emacs started, or nil.
A daemon started in a terminal is not here, and `flan-connect' still works
for it — this is only what Emacs is responsible for killing.")
(defun flan-dev--daemon-sentinel (proc event) (defun flan-dev--daemon-sentinel (proc event)
"Say that the daemon PROC has gone, once, when it does. EVENT says how." "Say that the daemon PROC has gone, once, when it does. EVENT says how."
(unless (process-live-p proc) (unless (process-live-p proc)
(when (eq proc flan-dev--daemon) (when (eq proc flan-dev--daemon)
(setq flan-dev--daemon nil) (setq flan-dev--daemon nil)
(setq flan-dev--daemon-socket nil)
(force-mode-line-update t) (force-mode-line-update t)
;; Named, because the daemon exits for two very different reasons — the ;; Named, because the daemon exits for two very different reasons — the
;; program finished, or it never built — and the buffer is where the ;; program finished, or it never built — and the buffer is where the
@ -692,6 +790,7 @@ refuses: callers cannot silently discard a running program's state."
(unless (file-exists-p file) (unless (file-exists-p file)
(user-error "flan dev: no such file: %s" file)) (user-error "flan dev: no such file: %s" file))
(setq flan-dev--file file) (setq flan-dev--file file)
(setq flan-dev--daemon-socket socket)
(setq flan-dev--daemon (flan-dev--start-daemon file socket)) (setq flan-dev--daemon (flan-dev--start-daemon file socket))
(flan-dev--connect-when-ready socket flan-dev--daemon) (flan-dev--connect-when-ready socket flan-dev--daemon)
;; Connected by now, so the rest is what `flan-connect' does after opening: ;; Connected by now, so the rest is what `flan-connect' does after opening:
@ -707,46 +806,70 @@ refuses: callers cannot silently discard a running program's state."
(defun flan-dev-quit () (defun flan-dev-quit ()
"Stop the daemon this Emacs started, and the program with it. "Stop the daemon this Emacs started, and the program with it.
`close' first, which is the daemon's own way out and lets it unlink its `close' first, which is the daemon's own way out and lets it unlink its
socket; the process is killed only if it does not take it." socket; the process is killed only if it does not take it.
One session at a time, which is the whole of the guard at the top. The
connection and the daemon are usually the same program and were treated as
though they always were: `close' went down whichever connection was current
and the daemon was killed afterwards, so a `flan-connect' to a second program
in another terminal turned one command into the end of two sessions — one of
them belonging to somebody else's window. When the connection is not the
daemon's, this closes the connection and says what it left running."
(interactive) (interactive)
(unless (process-live-p flan-dev--daemon) (if (and (process-live-p flan-dev--daemon)
;; A daemon started in a terminal is not this Emacs' to kill, and (process-live-p flan-dev--connection)
;; `flan-disconnect' is the thing that ends one of those — it closes, which flan-dev--socket flan-dev--daemon-socket
;; the daemon takes as the end of the session. Saying so is better than (not (equal flan-dev--socket flan-dev--daemon-socket)))
;; doing the same thing under a name that claims more than it did. (let ((theirs (abbreviate-file-name flan-dev--socket))
(user-error "flan dev: no daemon started from Emacs%s" (mine (abbreviate-file-name
(if (process-live-p flan-dev--connection) (or flan-dev--file flan-dev--daemon-socket))))
"; M-x flan-disconnect ends the one you are connected to" ;; `flan-disconnect' is exactly the right half: it closes, which the
""))) ;; daemon on the other end takes as the end of its session, and it
(let ((proc flan-dev--daemon)) ;; touches nothing this Emacs started.
(when (process-live-p flan-dev--connection) (flan-disconnect)
(ignore-errors (flan-dev--request '(:op "close"))) (message
(delete-process flan-dev--connection)) "flan dev: closed %s; %s is still running here — M-x flan-dev-quit again to stop it"
(setq flan-dev--connection nil theirs mine))
flan-dev--socket nil (unless (process-live-p flan-dev--daemon)
flan-dev--stopped nil) ;; A daemon started in a terminal is not this Emacs' to kill, and
(flan-dev--stop-polling) ;; `flan-disconnect' is the thing that ends one of those — it closes, which
(flan-dev--forget-defs) ;; the daemon takes as the end of the session. Saying so is better than
(when (process-live-p proc) ;; doing the same thing under a name that claims more than it did.
;; It has been told; give it a moment to go on its own before killing (user-error "flan dev: no daemon started from Emacs%s"
;; it, so that it unlinks its socket and reaps its child itself. (if (process-live-p flan-dev--connection)
(let ((deadline (+ (float-time) 2))) "; M-x flan-disconnect ends the one you are connected to"
(while (and (process-live-p proc) (< (float-time) deadline)) "")))
(accept-process-output proc 0.05))) (let ((proc flan-dev--daemon))
(when (process-live-p flan-dev--connection)
(ignore-errors (flan-dev--request '(:op "close")))
(delete-process flan-dev--connection))
(setq flan-dev--connection nil
flan-dev--socket nil
flan-dev--stopped nil)
(flan-dev--stop-polling)
(flan-dev--forget-defs)
(when (process-live-p proc) (when (process-live-p proc)
;; Killed rather than asked, so its own cleanup never runs — and that ;; It has been told; give it a moment to go on its own before killing
;; cleanup is what signals the program. The program is therefore ;; it, so that it unlinks its socket and reaps its child itself.
;; probably still running, reparented, holding its agent socket, and (let ((deadline (+ (float-time) 2)))
;; saying "stopped" here would be the one place in this client where (while (and (process-live-p proc) (< (float-time) deadline))
;; a success message meant "probably". (accept-process-output proc 0.05)))
(delete-process proc) (when (process-live-p proc)
(setq flan-dev--daemon nil) ;; Killed rather than asked, so its own cleanup never runs — and that
(force-mode-line-update t) ;; cleanup is what signals the program. The program is therefore
(user-error ;; probably still running, reparented, holding its agent socket, and
"flan dev: the daemon would not close and was killed; its program may still be running"))) ;; saying "stopped" here would be the one place in this client where
(setq flan-dev--daemon nil) ;; a success message meant "probably".
(force-mode-line-update t) (delete-process proc)
(message "flan dev: stopped"))) (setq flan-dev--daemon nil
flan-dev--daemon-socket nil)
(force-mode-line-update t)
(user-error
"flan dev: the daemon would not close and was killed; its program may still be running")))
(setq flan-dev--daemon nil
flan-dev--daemon-socket nil)
(force-mode-line-update t)
(message "flan dev: stopped"))))
;;;###autoload ;;;###autoload
(defun flan-dev-restart-program () (defun flan-dev-restart-program ()
@ -769,8 +892,21 @@ running — `flan-dev' then starts it again, on the same program."
(interactive) (interactive)
(unless (process-live-p flan-dev--daemon) (unless (process-live-p flan-dev--daemon)
(user-error "flan dev: no daemon started from Emacs to restart")) (user-error "flan dev: no daemon started from Emacs to restart"))
;; Refused rather than half-done: this ends a program and builds it again,
;; and with the connection attached to somebody else's daemon there is no
;; reading of it that leaves one session where there was one.
(when (and (process-live-p flan-dev--connection)
flan-dev--socket flan-dev--daemon-socket
(not (equal flan-dev--socket flan-dev--daemon-socket)))
(user-error
"flan dev: connected to %s, which is not the %s started here; M-x flan-connect to it first"
(abbreviate-file-name flan-dev--socket)
(abbreviate-file-name (or flan-dev--file flan-dev--daemon-socket))))
(let ((file flan-dev--file) (let ((file flan-dev--file)
(socket flan-dev--socket)) ;; The daemon's socket and not the connection's: what is being
;; restarted is the program this Emacs started, and the connection may
;; by now be attached to a second one somewhere else.
(socket (or flan-dev--daemon-socket flan-dev--socket)))
(flan-dev-quit) ; returns only once it is really gone (flan-dev-quit) ; returns only once it is really gone
(flan-dev file socket))) (flan-dev file socket)))
@ -1741,14 +1877,37 @@ Requiring both rather than the head alone is the more conservative of the two
readings, and the one the user asked for: a `defn' written inside a `let' is readings, and the one the user asked for: a `defn' written inside a `let' is
not a definition of anything, and installing it as one would quietly accept not a definition of anything, and installing it as one would quietly accept
code the compiler is right to refuse. Sent as an expression it gets the code the compiler is right to refuse. Sent as an expression it gets the
parser's own message, which says exactly that." parser's own message, which says exactly that.
Three things have to be true before either question is worth asking, and the
first of them is that there *is* a form before point. `backward-sexp' does
not signal when there is nothing behind it — it goes to the beginning of the
buffer and stays there, which at point-min is no movement at all — and the
form it then looks at is the one *after* point, whose head is very likely a
declaration and whose text is empty. `C-x C-e' at the top of a file used to
install that: a `defn' by name, with no body, out of a region zero characters
wide. So START must have moved. The other two are that the form is not
inside a string or a comment, where a `defn' is prose and not a definition.
One known limit, left as one: `syntax-ppss' reports depth from the accessible
portion of the buffer, so in a narrowed buffer a form that is nested in the
file reads as top-level here. Widening to ask would be a different decision
about what `C-x C-e' means in a narrowed buffer, and it is not this one's to
make."
(save-excursion (save-excursion
(let ((end (point))) (let ((end (point)))
(condition-case nil (condition-case nil
(progn (progn
(backward-sexp) (backward-sexp)
(let ((start (point))) (let* ((start (point))
(and (zerop (car (syntax-ppss start))) ;; Every `syntax-ppss' call before the `looking-at' below:
;; it moves point and clobbers the match data, and the head
;; is read back out of that match.
(state (syntax-ppss start)))
(and (> end start)
(zerop (car state))
(not (nth 3 state)) ; inside a string
(not (nth 4 state)) ; inside a comment
(looking-at "([ \t\n]*\\(\\(?:\\sw\\|\\s_\\)+\\)") (looking-at "([ \t\n]*\\(\\(?:\\sw\\|\\s_\\)+\\)")
(member (match-string-no-properties 1) (member (match-string-no-properties 1)
flan-dev--declaration-heads) flan-dev--declaration-heads)
@ -1793,9 +1952,20 @@ does, until the same form is evaluated again without a prefix."
;; daemon installed no bodies and declared no names. ;; daemon installed no bodies and declared no names.
(flan-dev--eval (flan-dev--text start end) head start end (flan-dev--eval (flan-dev--text start end) head start end
(and arg (cons start end)))) (and arg (cons start end))))
(let ((code (buffer-substring-no-properties (let* ((start (save-excursion
(save-excursion (backward-sexp) (point)) (condition-case nil (backward-sexp) (scan-error nil))
(point)))) (point)))
(code (buffer-substring-no-properties start (point))))
;; Nothing behind point is nothing to send. `backward-sexp' does not
;; signal at the beginning of a buffer, it simply stays there, so the
;; region measured out is empty and the daemon is asked to evaluate
;; the empty string — which it answers, since an empty program is a
;; valid one, and the echo area then reports a success for an
;; evaluation nobody made. Saying so is the honest answer, and it is
;; also the answer to the likelier reading: point is at the top of the
;; file and the form meant was the one *after* it.
(when (= start (point))
(user-error "flan: no form before point to evaluate"))
(flan-dev--report (flan-dev--report
(flan-dev--request (flan-dev--request
(append (append

10
emacs/flan-watch.el
View File

@ -401,7 +401,15 @@ sends the next question, leaving at most one request in flight — the invariant
(flan-dev--busy nil) (flan-dev--busy nil)
(t (t
(when flan-watch--pending (when flan-watch--pending
(when-let* ((reply (flan-dev--take-reply flan-dev--connection))) ;; Taken off the connection either way. `flan-dev--extract-reply'
;; deletes a frame before it reads it, so a payload that will not read
;; has still been consumed — and a pending flag left standing after it
;; would wait for ever for a reply that is no longer in the buffer,
;; which stops the timer sending anything again. One bad reply costs
;; one tick, not the session.
(when-let* ((reply (condition-case nil
(flan-dev--take-reply flan-dev--connection)
(error (setq flan-watch--pending nil) nil))))
(setq flan-watch--pending nil) (setq flan-watch--pending nil)
(flan-watch--absorb reply))) (flan-watch--absorb reply)))
(unless flan-watch--pending (unless flan-watch--pending

182
emacs/test-flan-dev.el
View File

@ -101,6 +101,61 @@ is written instead — the real `message' call the real command makes."
(string-match-p "flan-dev-not-here.sock" raised) (string-match-p "flan-dev-not-here.sock" raised)
(string-match-p "nothing is listening" raised)))) (string-match-p "nothing is listening" raised))))
;; ── The two frames a real daemon does not send ────────────────────────
;;
;; Both of these are what the client does when the other end is wrong, and
;; neither can be asked of a daemon that is working: a stand-in process
;; stands where one would be, with its frames written into its buffer by
;; hand. A live process rather than a dead one on purpose — which of the
;; two silences the reader reports depends on whether the far end is still
;; there, and this is the branch a person actually meets.
;;
;; What is under test is the state the connection is left in. A truncated
;; frame used to raise `wrong-type-argument' out of `byte-to-position' and
;; leave its header in the buffer, so every later request read the frame
;; before its own, for ever; an unreadable payload used to be read before it
;; was deleted, so it was never consumed and the *same* bytes signalled
;; again on every request after it. Both were permanent, and both are meant
;; to cost one request now.
(let* ((buf (generate-new-buffer " *flan-stand-in*"))
;; `cat' with nothing on its input: a process that is alive, has a
;; buffer, and will never say anything of its own.
(stand-in (start-process "flan-stand-in" buf "cat")))
(set-process-query-on-exit-flag stand-in nil)
;; Unibyte, as `flan-dev--open' makes it: the framing counts bytes, and
;; `position-bytes' on a multibyte buffer counts something else.
(with-current-buffer buf (set-buffer-multibyte nil))
(unwind-protect
(let ((flan-dev-reply-timeout 0.3))
;; Announced 40 bytes, wrote 12, went quiet.
(with-current-buffer buf (insert "40\n(:status \"o"))
(let ((raised nil))
(condition-case err (flan-dev--read-reply stand-in)
(error (setq raised (error-message-string err))))
(test-flan--check "a body that stalls is a timeout, said in words"
(and raised (string-match-p "no reply in" raised)))
(test-flan--check "and the half-frame is dropped rather than left to be read as the next reply"
(zerop (buffer-size buf))))
;; A payload that will not read, with a good frame behind it: the
;; claim is that the second one arrives, which is the whole of
;; self-healing and stronger than an empty buffer.
;; Two frames, written one after the other because that is what
;; they are: three bytes of `(:a', which will not read, and then a
;; whole reply behind it.
(with-current-buffer buf
(insert "3\n(:a")
(insert "14\n(:status \"ok\")"))
(let ((raised nil))
(condition-case err (flan-dev--take-reply stand-in)
(error (setq raised (error-message-string err))))
(test-flan--check "a payload that will not read signals"
raised)
(test-flan--check "and is consumed, so the reply behind it arrives"
(equal (flan-dev--take-reply stand-in)
'(:status "ok")))))
(delete-process stand-in)
(kill-buffer buf)))
(let ((r (flan-dev--request '(:op "describe")))) (let ((r (flan-dev--request '(:op "describe"))))
(test-flan--check "describe lists the program's functions" (test-flan--check "describe lists the program's functions"
(member "step" (plist-get r :fns))) (member "step" (plist-get r :fns)))
@ -436,6 +491,41 @@ is written instead — the real `message' call the real command makes."
(string-match-p "=>" said)))) (string-match-p "=>" said))))
(delete-region beg (point-max))) (delete-region beg (point-max)))
;; A declaration can be written where it is prose and not a declaration, and
;; the depth at its open delimiter says nothing about that: a form at column
;; 1 inside a comment or a string is at depth 0 like any other, so the head
;; was the only thing being asked and a sentence would have been compiled.
(goto-char (point-max))
(let ((beg (point)))
(insert "\n;; (defvar commented i64 1)\n\"(defvar inside i64 1)\"")
;; Point after the form's own closing paren rather than at the end of the
;; line: `backward-sexp' walks over a whole comment, so from the end of
;; one it never reaches the paren inside it and the guard is never asked.
(goto-char beg)
(search-forward "commented i64 1)")
(test-flan--check "a declaration written in a comment is not one"
(null (flan-dev--declaration-before-point)))
(goto-char beg)
(search-forward "inside i64 1)")
(test-flan--check "and neither is one written in a string"
(null (flan-dev--declaration-before-point)))
(delete-region beg (point-max)))
;; And the top of the buffer, where there is nothing behind point at all.
;; `backward-sexp' does not signal there — it stays where it is — so the
;; form the predicate looked at was the one *after* point and the region it
;; measured out was empty: C-x C-e at point-min sent the first declaration
;; in the file by name with no body at all, and the daemon installed it.
;; Nothing is sent now, from either path, and the refusal says why.
(goto-char (point-min))
(test-flan--check "the form after point is not the form before it"
(null (flan-dev--declaration-before-point)))
(test-flan--check "and C-x C-e at the top of a buffer refuses rather than sending nothing"
(let ((raised nil))
(condition-case err (flan-eval-last-sexp)
(user-error (setq raised (error-message-string err))))
(and raised (string-match-p "no form before point" raised))))
;; The bug this key had: a `defvar' typed at the top of a file could only be ;; The bug this key had: a `defvar' typed at the top of a file could only be
;; evaluated with C-c C-c, because C-x C-e sent it to the expression ;; evaluated with C-c C-c, because C-x C-e sent it to the expression
;; evaluator and the parser refused it as a declaration. One round trip, on ;; evaluator and the parser refused it as a declaration. One round trip, on
@ -693,6 +783,42 @@ is written instead — the real `message' call the real command makes."
(flan-watch--tick) (flan-watch--tick)
(test-flan--check "a tick leaves a request in flight rather than waiting for it" (test-flan--check "a tick leaves a request in flight rather than waiting for it"
flan-watch--pending) flan-watch--pending)
;; The background poll is a sender too, and it was the one sender that did
;; not settle: it guarded on `flan-dev--busy' alone, which the watch timer
;; deliberately does not bind — it never waits, so it has nothing to hold —
;; and sent `describe' straight into a connection that already owed a reply.
;; It then read the watch's answer as its own, and the two stayed swapped
;; for the rest of the session. The second check is where that would show:
;; a `describe' answered by the watch table has no `:fns' in it at all.
(flan-dev--poll)
(test-flan--check "a poll settles the watch's reply rather than reading it as its own"
(null flan-watch--pending))
(test-flan--check "and the request after it is still answered by its own reply"
(member "step" (plist-get (flan-dev--request '(:op "describe"))
:fns)))
;; And the same hook against a daemon restarted under an armed watch. The
;; reply the watch is owed was asked for on the connection that has gone, so
;; there is nothing to wait for — running the hook before the connection is
;; checked is what lets it see that. Asking after the reconnect meant a
;; whole `flan-dev-reply-timeout' of frozen Emacs on the first thing anybody
;; typed after a restart, which is why the wait itself is what is measured.
(flan-watch--tick)
(delete-process flan-dev--connection)
;; The timeout and the assertion are deliberately different numbers: what is
;; being told apart is a request that waited one out from a request that did
;; not, and the wider the gap the less this depends on how loaded the machine
;; running the suite happens to be. A reconnect and a `describe' are
;; milliseconds of work.
(let ((flan-dev-reply-timeout 10)
(started (float-time)))
(let ((r (flan-dev--request '(:op "describe"))))
(test-flan--check "a request after a restart does not wait out a reply the old connection owed"
(and (member "step" (plist-get r :fns))
(< (- (float-time) started) 3)))
(test-flan--check "and the watch is not left waiting for one either"
(null flan-watch--pending))))
;; A request in flight again, for the interleaving below.
(flan-watch--tick)
;; And now the interleaving, with a reply outstanding on purpose. If the ;; And now the interleaving, with a reply outstanding on purpose. If the
;; settle hook were not there this would return the watch table's plist and ;; settle hook were not there this would return the watch table's plist and
;; `flan-dev--report' would take its missing :status for a rejection. ;; `flan-dev--report' would take its missing :status for a rejection.
@ -801,6 +927,62 @@ is written instead — the real `message' call the real command makes."
(not (file-exists-p socket2)))) (not (file-exists-p socket2))))
(ignore-errors (delete-file socket2))) (ignore-errors (delete-file socket2)))
;; ── One command, one session ──────────────────────────────────────────
;;
;; Attaching to a second program while a daemon of this Emacs' own is
;; running is an ordinary thing to do — the other one is in a terminal, and
;; `flan-connect' is the command for it — and it used to cost the first
;; program its life: `flan-dev-quit' sent `close' down whichever connection
;; was current and then killed the daemon, which by then were two different
;; programs. Both halves are checked here.
;;
;; Stand-ins rather than two real daemons. Nothing about this is a claim
;; about the wire: what is under test is which process each command reaches
;; for, and a `cat' is a live process with a buffer, which is all either of
;; them looks at. `cat' also parrots whatever is written to it, so the
;; `close' a disconnect sends comes straight back as its own reply and
;; nothing waits. Every variable touched is bound, so the suite carries on
;; with the state it had.
(let* ((mine-buf (generate-new-buffer " *flan-mine*"))
(theirs-buf (generate-new-buffer " *flan-theirs*"))
(mine (start-process "flan-mine" mine-buf "cat"))
(theirs (start-process "flan-theirs" theirs-buf "cat")))
(set-process-query-on-exit-flag mine nil)
(set-process-query-on-exit-flag theirs nil)
(with-current-buffer theirs-buf (set-buffer-multibyte nil))
(unwind-protect
(let ((flan-dev--daemon mine)
(flan-dev--daemon-socket "/tmp/flan-emacs-mine.sock")
(flan-dev--file "/tmp/flan-emacs-mine.flan")
(flan-dev--connection theirs)
(flan-dev--socket "/tmp/flan-emacs-theirs.sock")
(flan-dev--defs nil))
(test-flan--check
"flan-connect elsewhere names both programs rather than dropping one"
(let ((raised nil))
(condition-case err (flan-connect "/tmp/flan-emacs-elsewhere.sock")
(user-error (setq raised (error-message-string err))))
(and raised
(string-match-p "flan-emacs-mine" raised)
(string-match-p "flan-emacs-elsewhere" raised))))
(test-flan--check "and the connection it refused to replace is untouched"
(eq flan-dev--connection theirs))
;; And the command whose name promises one program. It closes the
;; connection it is on and leaves the daemon alone, saying so —
;; where it used to end both.
(let ((said (test-flan--said (flan-dev-quit))))
(test-flan--check "quit ends the session it is connected to"
(not (process-live-p theirs)))
(test-flan--check "and leaves the daemon this Emacs started running"
(process-live-p mine))
(test-flan--check "and says which one it left"
(and said (string-match-p "still running" said)
(string-match-p "flan-emacs-mine" said)))))
(ignore-errors (delete-process mine))
(ignore-errors (delete-process theirs))
(kill-buffer mine-buf)
(kill-buffer theirs-buf)))
;; A program that does not exist is refused here rather than by a daemon ;; A program that does not exist is refused here rather than by a daemon
;; that starts, fails to build and exits — which looks the same from a ;; that starts, fails to build and exits — which looks the same from a
;; distance and takes a compile to find out. ;; distance and takes a compile to find out.