From a70cfadd945a7ab0ee3495118123e32e32958b1f Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:29:34 +0700 Subject: [PATCH 1/5] A bad frame costs one request, not the connection Two orderings in the reply reader, and both of them were permanent. A frame whose header arrived and whose body did not fell through the wait loop into `flan-dev--extract-reply', where `byte-to-position' signalled a wrong-type error on a position past the end of the buffer -- so the timeout message the function goes to some trouble to word was never the one anybody read, and the header stayed at the front of the buffer, where the next request took it as its own and every request after that was answered by the one before it. The body deadline is tested again now rather than trusted, and the dead frame is erased: the timeout is said in the words meant for it, and the connection is back in step. The header deadline still erases nothing, because a partial header is a valid prefix of a reply that is merely slow. The other is `flan-dev--extract-reply' reading the payload before deleting it, so a payload that would not read was never consumed and the same bytes signalled again on every later request. It is deleted first now. That makes the frame gone whether or not the read succeeded, which `flan-watch--tick' has to know: it cleared its pending flag only on a reply it got back, and would otherwise wait for ever for one no longer in the buffer. --- emacs/flan-dev.el | 77 +++++++++++++++++++++++++++++------------- emacs/flan-watch.el | 10 +++++- emacs/test-flan-dev.el | 50 +++++++++++++++++++++++++++ 3 files changed, 113 insertions(+), 24 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 1586a26..3f39b38 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -177,16 +177,46 @@ original left a comment about. See `flan-watch--tick'." (defun flan-dev--extract-reply (body-start n) "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))) (text (decode-coding-string (encode-coding-string (buffer-substring-no-properties body-start end) 'utf-8 t) - 'utf-8)) - (form (car (read-from-string text)))) + 'utf-8))) (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) "Block until PROC sends one complete framed message, and read it." @@ -198,31 +228,32 @@ Point is in the process buffer, and the frame is known to be complete." (< (float-time) deadline)) (accept-process-output proc 0.05)) (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) - ;; Deliberately not retried. 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. - ;; 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 "?"))))) + (flan-dev--no-reply proc)) (let* ((n (string-to-number (match-string 1))) (body-start (point))) (while (and (< (- (position-bytes (point-max)) (position-bytes body-start)) n) (< (float-time) deadline)) (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) "Append TEXT, the running program's own output, to its buffer." diff --git a/emacs/flan-watch.el b/emacs/flan-watch.el index f0f6e0f..bc245ba 100644 --- a/emacs/flan-watch.el +++ b/emacs/flan-watch.el @@ -401,7 +401,15 @@ sends the next question, leaving at most one request in flight — the invariant (flan-dev--busy nil) (t (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) (flan-watch--absorb reply))) (unless flan-watch--pending diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index 3419615..5860e23 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -101,6 +101,56 @@ is written instead — the real `message' call the real command makes." (string-match-p "flan-dev-not-here.sock" 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. + (with-current-buffer buf (insert "3\n(:a14\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")))) (test-flan--check "describe lists the program's functions" (member "step" (plist-get r :fns))) From acf38ac064413a2e9d5633fb185e5ac7d412fe6b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:30:43 +0700 Subject: [PATCH 2/5] The poll settles like every other sender, and the settle runs before the reconnect `flan-dev--poll' guarded on `flan-dev--busy' and nothing else, and the watch timer is precisely the sender that does not bind it: it sends without waiting, so it has nothing to hold. A poll landing in that gap sent `describe' down a connection that already owed a reply, read the watch's answer as its own, and left its own for the watch to read a tick later -- after which the two consumers stayed swapped for the session, each of them answering the other's question. It runs `flan-dev-settle-hook' now, which is the invariant the hook's docstring already claimed. And the hook runs before `flan-dev--live-connection' rather than after. An outstanding reply belongs to the connection it was asked on; when a daemon has been restarted the old connection is gone and no reply is coming on the new one, but the hook was being asked about the new one and blocked a full `flan-dev-reply-timeout' -- a frozen Emacs on the first key pressed after a restart, with the watch armed. `flan-dev--busy' now covers the reconnect too, which asks the new daemon what it defines and so must not be interrupted by a poll either. --- emacs/flan-dev.el | 34 ++++++++++++++++++++++++++++------ emacs/test-flan-dev.el | 31 +++++++++++++++++++++++++++++++ 2 files changed, 59 insertions(+), 6 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 3f39b38..ac512e1 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -388,22 +388,35 @@ with it, and a rejected evaluation is a likely moment to *become* stopped." reply) (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 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 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 -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) "Send FORM to the connected program and return its reply." - (let* ((proc (flan-dev--live-connection)) - (flan-dev--busy t)) + ;; `flan-dev--busy' first of all, and around the reconnect as well as around + ;; 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) - (flan-dev--absorb (progn (flan-dev--send proc form) - (flan-dev--read-reply proc))))) + (let ((proc (flan-dev--live-connection))) + (flan-dev--absorb (progn (flan-dev--send proc form) + (flan-dev--read-reply proc)))))) ;;; Noticing that the program stopped @@ -441,6 +454,15 @@ Set to nil to leave the program's state to whatever replies happen to say." (let ((proc flan-dev--connection) (flan-dev--busy t)) (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 ;; drains the program's output, and the state is on every reply anyway. ;; Asking `break' would fetch restart names nobody is choosing from. diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index 5860e23..b29db9b 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -743,6 +743,37 @@ is written instead — the real `message' call the real command makes." (flan-watch--tick) (test-flan--check "a tick leaves a request in flight rather than waiting for it" 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) + (let ((flan-dev-reply-timeout 2) + (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) 2))) + (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 ;; 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. From eed0cfa9508ebcff995e1fb67742444226d56e28 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:32:34 +0700 Subject: [PATCH 3/5] C-x C-e at the top of a file has nothing behind it, and says so `backward-sexp' does not signal when there is no form before point; it goes to the beginning of the buffer and stays there. At point-min that is no movement, so the form the dispatch then looked at was the one *after* point -- whose head is very often a declaration -- and the region between start and end was empty. The key installed the file's first declaration by name with no body, which the daemon accepts, and the echo area reported it as a change. Both paths check for movement now: the predicate refuses, and the expression arm refuses in words rather than asking the daemon to evaluate the empty string. The same predicate asked only for the depth at the open delimiter, and a form written at column 1 inside a comment or a string is at depth 0 like any other. A `defvar' in a comment is prose; it is not offered as a declaration any more. Depth in a narrowed buffer still means depth within the narrowing, which is noted where it is read rather than changed. --- emacs/flan-dev.el | 46 ++++++++++++++++++++++++++++++++++++------ emacs/test-flan-dev.el | 35 ++++++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+), 6 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index ac512e1..689ab66 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -1794,14 +1794,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 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 -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 (let ((end (point))) (condition-case nil (progn (backward-sexp) - (let ((start (point))) - (and (zerop (car (syntax-ppss start))) + (let* ((start (point)) + ;; 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_\\)+\\)") (member (match-string-no-properties 1) flan-dev--declaration-heads) @@ -1846,9 +1869,20 @@ does, until the same form is evaluated again without a prefix." ;; daemon installed no bodies and declared no names. (flan-dev--eval (flan-dev--text start end) head start end (and arg (cons start end)))) - (let ((code (buffer-substring-no-properties - (save-excursion (backward-sexp) (point)) - (point)))) + (let* ((start (save-excursion + (condition-case nil (backward-sexp) (scan-error nil)) + (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--request (append diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index b29db9b..feac0de 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -486,6 +486,41 @@ is written instead — the real `message' call the real command makes." (string-match-p "=>" said)))) (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 ;; 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 From f186284a4df30c3087dde10d0401b07a02cd034b Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:35:27 +0700 Subject: [PATCH 4/5] Quitting ends one session, and connecting elsewhere says what it is leaving `flan-dev-quit' promises to stop the daemon this Emacs started. It sent `close' down the current connection as well, on the assumption that the two are the same program -- and `flan-connect' is the command for attaching to one that is not, so the assumption was one keystroke from being false. Connect to a daemon running in a terminal, quit, and two programs ended: the one Emacs owned, and somebody else's. The daemon's socket is now kept apart from the connection's, which is what lets one be told from the other. `flan-connect' names both programs before it abandons a connection belonging to a daemon this Emacs started, and refuses outright for a Lisp caller, as `flan-dev' already did for a running program. `flan-dev-quit' on a connection that is not the daemon's closes that connection and says what it left running. `flan-dev-restart-program' restarts on the daemon's own socket, and refuses while the connection is elsewhere: there is no reading of "build it again" that leaves one session where there was one. --- emacs/flan-dev.el | 179 ++++++++++++++++++++++++++++++----------- emacs/test-flan-dev.el | 56 +++++++++++++ 2 files changed, 187 insertions(+), 48 deletions(-) diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index 689ab66..0eeb13b 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -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 — `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 "Non-nil while a request is waiting for its reply. `flan-dev--read-reply' runs `accept-process-output', which runs timers, so @@ -569,6 +594,29 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (list (or (flan-dev--find-socket) (read-file-name "flan dev socket: ")))) (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) (let ((r (flan-dev--request '(:op "describe")))) (flan-dev-refresh-defs) @@ -624,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." :type 'number) -(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.") +;; The three variables that say what this Emacs started — `flan-dev--file', +;; `flan-dev--daemon' and `flan-dev--daemon-socket' — are declared with the +;; rest of the client's state at the top of the file for the same reason: +;; `flan-connect' reads all three before it replaces a connection, and the +;; byte-compiler reads a file in order. (defun flan-dev--daemon-sentinel (proc event) "Say that the daemon PROC has gone, once, when it does. EVENT says how." (unless (process-live-p proc) (when (eq proc flan-dev--daemon) (setq flan-dev--daemon nil) + (setq flan-dev--daemon-socket nil) (force-mode-line-update t) ;; Named, because the daemon exits for two very different reasons — the ;; program finished, or it never built — and the buffer is where the @@ -745,6 +790,7 @@ refuses: callers cannot silently discard a running program's state." (unless (file-exists-p file) (user-error "flan dev: no such file: %s" file)) (setq flan-dev--file file) + (setq flan-dev--daemon-socket socket) (setq flan-dev--daemon (flan-dev--start-daemon file socket)) (flan-dev--connect-when-ready socket flan-dev--daemon) ;; Connected by now, so the rest is what `flan-connect' does after opening: @@ -760,46 +806,70 @@ refuses: callers cannot silently discard a running program's state." (defun flan-dev-quit () "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 -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) - (unless (process-live-p flan-dev--daemon) - ;; A daemon started in a terminal is not this Emacs' to kill, and - ;; `flan-disconnect' is the thing that ends one of those — it closes, which - ;; the daemon takes as the end of the session. Saying so is better than - ;; doing the same thing under a name that claims more than it did. - (user-error "flan dev: no daemon started from Emacs%s" - (if (process-live-p flan-dev--connection) - "; M-x flan-disconnect ends the one you are connected to" - ""))) - (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) - ;; It has been told; give it a moment to go on its own before killing - ;; it, so that it unlinks its socket and reaps its child itself. - (let ((deadline (+ (float-time) 2))) - (while (and (process-live-p proc) (< (float-time) deadline)) - (accept-process-output proc 0.05))) + (if (and (process-live-p flan-dev--daemon) + (process-live-p flan-dev--connection) + flan-dev--socket flan-dev--daemon-socket + (not (equal flan-dev--socket flan-dev--daemon-socket))) + (let ((theirs (abbreviate-file-name flan-dev--socket)) + (mine (abbreviate-file-name + (or flan-dev--file flan-dev--daemon-socket)))) + ;; `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 + ;; touches nothing this Emacs started. + (flan-disconnect) + (message + "flan dev: closed %s; %s is still running here — M-x flan-dev-quit again to stop it" + theirs mine)) + (unless (process-live-p flan-dev--daemon) + ;; A daemon started in a terminal is not this Emacs' to kill, and + ;; `flan-disconnect' is the thing that ends one of those — it closes, which + ;; the daemon takes as the end of the session. Saying so is better than + ;; doing the same thing under a name that claims more than it did. + (user-error "flan dev: no daemon started from Emacs%s" + (if (process-live-p flan-dev--connection) + "; M-x flan-disconnect ends the one you are connected to" + ""))) + (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) - ;; Killed rather than asked, so its own cleanup never runs — and that - ;; cleanup is what signals the program. The program is therefore - ;; probably still running, reparented, holding its agent socket, and - ;; saying "stopped" here would be the one place in this client where - ;; a success message meant "probably". - (delete-process proc) - (setq flan-dev--daemon 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) - (force-mode-line-update t) - (message "flan dev: stopped"))) + ;; It has been told; give it a moment to go on its own before killing + ;; it, so that it unlinks its socket and reaps its child itself. + (let ((deadline (+ (float-time) 2))) + (while (and (process-live-p proc) (< (float-time) deadline)) + (accept-process-output proc 0.05))) + (when (process-live-p proc) + ;; Killed rather than asked, so its own cleanup never runs — and that + ;; cleanup is what signals the program. The program is therefore + ;; probably still running, reparented, holding its agent socket, and + ;; saying "stopped" here would be the one place in this client where + ;; a success message meant "probably". + (delete-process proc) + (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 (defun flan-dev-restart-program () @@ -822,8 +892,21 @@ running — `flan-dev' then starts it again, on the same program." (interactive) (unless (process-live-p flan-dev--daemon) (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) - (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 file socket))) diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index feac0de..04f6de9 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -917,6 +917,62 @@ is written instead — the real `message' call the real command makes." (not (file-exists-p 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 ;; that starts, fails to build and exits — which looks the same from a ;; distance and takes a compile to find out. From 866c0792e0038f1e69bae879eac66f8f92efc6dc Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 18 Sep 2026 07:40:10 +0700 Subject: [PATCH 5/5] Two checks that would have been read wrong, and one that could have flaked The unreadable-frame case wrote both frames as one string, where `(:a14' reads as a typo rather than as the end of one frame and the start of the next; they are two inserts now, with a line saying which is which. And the check that a request after a daemon restart does not wait out a reply the old connection owed was asserting against the same number it had bound the timeout to -- the one arrangement that cannot tell "fast" from "timed out a moment ago". The timeout is ten seconds and the assertion is three, which is the gap the claim is actually about. --- emacs/test-flan-dev.el | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index 04f6de9..8688fec 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -139,7 +139,12 @@ is written instead — the real `message' call the real command makes." ;; 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. - (with-current-buffer buf (insert "3\n(:a14\n(:status \"ok\")")) + ;; 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)))) @@ -799,12 +804,17 @@ is written instead — the real `message' call the real command makes." ;; typed after a restart, which is why the wait itself is what is measured. (flan-watch--tick) (delete-process flan-dev--connection) - (let ((flan-dev-reply-timeout 2) + ;; 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) 2))) + (< (- (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.