diff --git a/emacs/flan-dev.el b/emacs/flan-dev.el index ed957d1..3983c63 100644 --- a/emacs/flan-dev.el +++ b/emacs/flan-dev.el @@ -2,7 +2,10 @@ ;; The editor half of Flan's dev loop. `flan dev program.flan' compiles the ;; program, launches it, and listens on .flan-dev.sock beside the source; this -;; connects to that socket and sends it forms. +;; connects to that socket and sends it forms. M-x flan-dev starts that +;; daemon from here and connects when it is serving, so the loop needs no +;; terminal — and M-x flan-dev-quit ends it, which ends the program, because +;; the daemon is what owns the program's lifetime. ;; ;; C-c C-c recompiles the top-level form at point and installs it in the ;; running program, at that program's next frame boundary. Call sites compiled @@ -252,7 +255,7 @@ Set to nil to leave the program's state to whatever replies happen to say." (unless (process-live-p flan-dev--connection) (cond ((null flan-dev--socket) - (error "Not connected: M-x flan-connect, or start `flan dev program.flan'")) + (error "Not connected: M-x flan-dev to start a program, or M-x flan-connect")) ((not (file-exists-p flan-dev--socket)) (setq flan-dev--connection nil) (force-mode-line-update t) @@ -312,6 +315,221 @@ With no argument, look for `flan-dev-socket-name' up from this buffer." (force-mode-line-update t) (message "flan dev: disconnected")) +;;; Starting the daemon + +;; Before this, a dev loop began in a terminal: `flan dev program.flan' in one +;; window and Emacs in another, with the socket found by walking up from the +;; buffer. That is one window too many for something an editor can own — and +;; it is the daemon that owns the program's lifetime, so the terminal was also +;; the only place a program could be stopped from. +;; +;; Waiting for the socket *file* is what this deliberately does not do. The +;; daemon unlinks a stale socket before binding, so a file left behind by a +;; crashed run exists before the new daemon has bound anything: waiting for it +;; to appear either succeeds instantly against nothing or races the unlink. +;; Connecting is the only test that means what it says, so it is retried until +;; it works, until the timeout, or until the daemon exits — whichever comes +;; first. + +(defcustom flan-dev-command "flan" + "The Flan compiler, as `flan dev' is started from Emacs. +A name is looked up on `exec-path'; a path is used as given." + :type 'string) + +(defcustom flan-dev-daemon-buffer "*flan-dev*" + "Buffer the daemon's own output goes to. +This is where a build that failed says so: the daemon compiles the program +before it binds its socket, so a program that does not compile produces no +socket at all and this buffer is the only account of why." + :type 'string) + +(defcustom flan-dev-start-timeout 60 + "Seconds to wait for a daemon started from Emacs to accept a connection. +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.") + +(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) + (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 + ;; difference is written. + (message "flan dev: the daemon exited (%s); see %s" + (string-trim (or event "")) flan-dev-daemon-buffer)))) + +(defun flan-dev--start-daemon (file socket) + "Start `flan dev' on FILE listening on SOCKET, and return the process." + (let ((buf (get-buffer-create flan-dev-daemon-buffer)) + ;; Expanded before `default-directory' moves, so that a command given + ;; as a path is the path the user meant and not one relative to the + ;; program's directory. A bare name is left alone for `exec-path'. + (cmd (if (file-name-directory flan-dev-command) + (expand-file-name flan-dev-command) + flan-dev-command)) + ;; The daemon runs where the program is, and so does the program it + ;; launches — it inherits this. A game opening "assets/tiles.png" + ;; means the project's directory, not whichever buffer Emacs happened + ;; to be in when the command was typed. (Imports do not depend on + ;; this: lib/load.ml resolves those from the importing file.) + (default-directory (file-name-directory (expand-file-name file)))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (format "%s dev %s -s %s\n\n" cmd file socket))) + (setq default-directory (file-name-directory (expand-file-name file)))) + (make-process + :name "flan-dev-daemon" :buffer buf + :command (list cmd "dev" file "-s" socket) + ;; The daemon writes its ready line and the program's stderr to stderr, + ;; and both belong in the same buffer in the order they happened. + :connection-type 'pipe :noquery t + :sentinel #'flan-dev--daemon-sentinel))) + +(defun flan-dev--connect-when-ready (socket proc) + "Connect to SOCKET once PROC is serving it, or say why that never happened." + (let ((deadline (+ (float-time) flan-dev-start-timeout)) + (done nil)) + (while (not done) + (cond + ((condition-case nil (progn (flan-dev--open socket) t) (error nil)) + (setq done t)) + ((not (process-live-p proc)) + ;; The likeliest failure by far: the program did not compile, so the + ;; daemon died before binding. The reason is in its buffer and not in + ;; anything this end can see — so show the buffer rather than name it + ;; and leave someone to go and find it. + (display-buffer flan-dev-daemon-buffer) + (user-error "flan dev: the daemon exited before it was ready; see %s" + flan-dev-daemon-buffer)) + ((> (float-time) deadline) + (display-buffer flan-dev-daemon-buffer) + (user-error "flan dev: no socket on %s after %ss; see %s" + (abbreviate-file-name socket) flan-dev-start-timeout + flan-dev-daemon-buffer)) + (t (accept-process-output proc 0.05)))))) + +;;;###autoload +(defun flan-dev (file &optional socket) + "Start `flan dev' on FILE and connect to it when it is ready. +SOCKET defaults to `flan-dev-socket-name' beside FILE, which is where the +daemon puts it when it is not told otherwise. + +Refuses while a daemon this Emacs started is still alive, by name: killing it +would take its program — and everything that program has in memory — with it, +which is the one thing a dev loop exists to avoid doing by accident." + (interactive + ;; The program last started, where there was one: a restart after a quit is + ;; the common case, and it is rarely the buffer point happens to be in — + ;; you quit from wherever you were reading when you decided to. + (list (read-file-name "flan dev: " nil flan-dev--file t + (and buffer-file-name + (string-suffix-p ".flan" buffer-file-name) + (file-name-nondirectory buffer-file-name))))) + (when (process-live-p flan-dev--daemon) + (user-error "flan dev: already running on %s; M-x flan-dev-quit first" + (abbreviate-file-name (or flan-dev--socket "a socket")))) + (let* ((file (expand-file-name file)) + (socket (or socket + (expand-file-name flan-dev-socket-name + (file-name-directory file))))) + (unless (file-exists-p file) + (user-error "flan dev: no such file: %s" file)) + (setq flan-dev--file file) + (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: + ;; learn what the program defines, and say what is on the other end. + (let ((r (flan-dev--request '(:op "describe")))) + (flan-dev-refresh-defs) + (message "flan dev: %s running (%d functions, %d globals)" + (file-name-nondirectory file) + (length (plist-get r :fns)) (length (plist-get r :globals)))) + flan-dev--daemon)) + +;;;###autoload +(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." + (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))) + (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"))) + +;;;###autoload +(defun flan-dev-restart-program () + "Stop the program this Emacs started and start it again from source. + +For a change the running program cannot take: a struct whose layout moved, a +function whose signature changed, anything the daemon refuses by telling you +to restart. There is no smaller version of this. A session's struct layouts +and global types describe the memory of a process only if that session +compiled it, so a new layout means a new build, which means a new process and +the session that made it — and the program's state goes with it, which is the +whole cost and the reason this is a separate command rather than something +`C-c C-c' falls back to. + +The old daemon is waited for before the new one starts, because it unlinks +the socket on its way out and would otherwise unlink the one its successor +had just bound. If it will not close and has to be killed, this stops there +rather than starting a second program on top of one that may still be +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")) + (let ((file flan-dev--file) + (socket flan-dev--socket)) + (flan-dev-quit) ; returns only once it is really gone + (flan-dev file socket))) + ;;; The modeline ;; Whether there is a program on the other end is the one thing worth a @@ -706,6 +924,93 @@ Nothing is offered when nothing is known — an empty table would look like ;; indenting it is ASCII, so the two agree here. (max 0 (1- (nth 2 parts))))))))))))) +;;; Documentation + +;; What the daemon already knows about a name, in a buffer rather than in the +;; echo area. eldoc gives you the signature of the thing you are typing, which +;; is the right answer while typing and the wrong one when the question is +;; "what is this?" — a signature that has scrolled past, a kind you are not +;; sure of, and a location you want to look at rather than jump to. +;; +;; Nothing here asks the program anything new: `defs' carries all four facts +;; already. It is refreshed first when there is a connection, because the +;; cache is otherwise as old as the last install and a doc buffer is exactly +;; where a stale signature would be believed. + +(defvar flan-doc-buffer "*flan-doc*" + "Buffer `flan-doc' writes into.") + +(define-derived-mode flan-doc-mode special-mode "Flan-Doc" + "Mode for the buffer `flan-doc' writes.") + +(defun flan-doc--goto (loc) + "Visit LOC, a \"file:line:col\" the daemon gave for a definition." + (let ((parts (flan-dev--parse-loc loc))) + (unless parts (user-error "flan: unreadable location: %s" loc)) + (find-file-other-window (nth 0 parts)) + (goto-char (flan-dev--position (nth 1 parts) (nth 2 parts))))) + +(defun flan-doc--where (d) + "Insert where D is defined, or why that cannot be said." + (let* ((loc (nth 3 d)) + (parts (and (not (equal loc "")) (flan-dev--parse-loc loc)))) + (cond + ;; Said, not omitted. A missing line reads as "it has no home"; the + ;; truth is that Tast.global and Tast.extern carry no Loc, which is a + ;; fact about the compiler and worth saying in the same words M-. uses. + ((equal loc "") + (insert (format "Defined the daemon reports no location for a %s\n" + (nth 1 d)))) + ((null parts) (insert (format "Defined at %s, which is unreadable\n" loc))) + ((or (string-match-p "\\`<.*>\\'" (nth 0 parts)) + (not (file-exists-p (nth 0 parts)))) + (insert (format "Defined in %s, which is not a file on disk\n" + (nth 0 parts)))) + (t + (insert "Defined ") + (insert-button (format "%s:%d" (nth 0 parts) (nth 1 parts)) + 'action (lambda (_) (flan-doc--goto loc)) + 'follow-link t + 'help-echo "Visit this definition") + (insert "\n"))))) + +;;;###autoload +(defun flan-doc (name) + "Show what the running program knows about NAME. +Interactively, the name at point, or one read with completion when point is +not on one. Refuses a bare name that could be several packaged ones, in the +same words `M-.' does: picking one would be a guess about which you meant." + (interactive + (list (or (thing-at-point 'symbol t) + (completing-read "Describe name: " (mapcar #'car flan-dev--defs) + nil t)))) + (unless flan-dev--defs + (user-error "flan: nothing is known about any name; connect first (C-c C-z)")) + (when (process-live-p flan-dev--connection) + (ignore-errors (flan-dev-refresh-defs))) + (let ((d (flan-dev--lookup name))) + (unless d + (if-let ((hits (flan-dev--ambiguous name))) + (user-error "flan: %s could be %s; write the one you mean" + name (string-join (mapcar #'car hits) " or ")) + (user-error "flan: the running program defines no %s" name))) + (with-current-buffer (get-buffer-create flan-doc-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (flan-doc-mode) + (insert (propertize (nth 0 d) 'face 'font-lock-function-name-face) "\n\n") + (insert (propertize (nth 2 d) 'face 'font-lock-type-face) "\n\n") + (insert (format "Kind %s\n" (nth 1 d))) + (flan-doc--where d) + ;; Parameter names are not in the Tast — the checker keeps types — + ;; so a signature is types only, and someone reading this buffer + ;; should be told that rather than left to wonder. + (when (member (nth 1 d) '("fn" "extern")) + (insert "\nParameter names are not kept past the checker, so a\n" + "signature shows types only.\n")) + (goto-char (point-min)))) + (display-buffer flan-doc-buffer))) + ;;; Wiring it into a buffer (defun flan-dev-setup () diff --git a/emacs/flan-mode.el b/emacs/flan-mode.el index 077fe32..c981a3b 100644 --- a/emacs/flan-mode.el +++ b/emacs/flan-mode.el @@ -8,6 +8,9 @@ ;;; Code: (require 'lisp-mode) +;; For `imenu-generic-expression', which is set below and which would +;; otherwise be made buffer-local before its own defvar had run. +(require 'imenu) ;; The keymap binds them; loading the client is what defines them, and a user ;; may well edit Flan without ever connecting to a running program. @@ -19,6 +22,11 @@ (declare-function flan-describe "flan-dev") (declare-function flan-show-output "flan-dev") (declare-function flan-repl "flan-repl") +(declare-function flan-break "flan-dev") +(declare-function flan-doc "flan-dev") +(declare-function flan-dev "flan-dev") +(declare-function flan-dev-quit "flan-dev") +(declare-function flan-dev-restart-program "flan-dev") (defgroup flan nil "Editing and evaluating Flan." @@ -52,6 +60,38 @@ . font-lock-constant-face)) "Font lock for `flan-mode'.") +(defconst flan--name-re "\\(\\(?:\\sw\\|\\s_\\)+\\)" + "A Flan name, as one group. +Written in terms of the syntax table rather than as a character class, so +that the characters a name may contain are stated in one place — the table +below — and not again here.") + +;; Anchored at the start of a line, which is where a top-level form is: a +;; `defn' nested inside a `let' is not a definition of anything, and a match +;; that ignored the column would offer one. +(defvar flan-imenu-generic-expression + `(("Functions" ,(concat "^(defn\\s-+" flan--name-re) 1) + ("Types" ,(concat "^(def\\(?:struct\\|union\\|enum\\|alias\\)\\s-+" + flan--name-re) + 1) + ("Variables" ,(concat "^(def\\(?:var\\|const\\)\\s-+" flan--name-re) 1) + ;; A forward declaration is not a definition, and a file with both would + ;; otherwise show the same name twice with nothing to tell them apart. + ("Declared" ,(concat "^(declare\\s-+" flan--name-re) 1)) + "Imenu index for `flan-mode', by what each form introduces.") + +(defun flan-current-defun-name () + "The name of the top-level definition point is in, or nil. +For `which-func-functions': a long file scrolled into the middle of a +function is the case this exists for, and it is the case where the header +line is off screen." + (save-excursion + (ignore-errors + (beginning-of-defun) + (and (looking-at (concat "(" (regexp-opt flan--definers t) "\\_>\\s-+" + flan--name-re)) + (match-string-no-properties 2))))) + (defvar flan-mode-syntax-table (let ((table (make-syntax-table lisp-mode-syntax-table))) ;; Flan's own punctuation in names: a name may contain - ? > / and . @@ -81,6 +121,14 @@ (define-key map (kbd "C-c C-o") #'flan-show-output) (define-key map (kbd "C-c C-r") #'flan-repl) (define-key map (kbd "C-c C-b") #'flan-break) + ;; Help on the name at point. C-c C-d is taken by `flan-describe', which + ;; is about the session rather than about a name, and renaming a key that + ;; is already documented costs more than it is worth. Not C-c C-h either: + ;; C-h after a prefix is how anyone finds out what is under C-c, and a + ;; binding there takes that away. + (define-key map (kbd "C-c C-v") #'flan-doc) + ;; The way out when a reload is refused: rebuild, relaunch, reconnect. + (define-key map (kbd "C-c C-x") #'flan-dev-restart-program) map) "Keymap for `flan-mode'.") @@ -96,7 +144,10 @@ (setq-local font-lock-defaults '(flan-font-lock-keywords)) (setq-local indent-line-function #'lisp-indent-line) (setq-local lisp-indent-function #'flan-indent-function) - (setq-local outline-regexp ";;;;+[ \t]*")) + (setq-local outline-regexp ";;;;+[ \t]*") + (setq-local imenu-generic-expression flan-imenu-generic-expression) + ;; Buffer-locally, because this answers for Flan and nothing else. + (add-hook 'which-func-functions #'flan-current-defun-name nil t)) (defun flan-indent-function (indent-point state) "Indent like Lisp, with Flan's body forms as special forms. diff --git a/emacs/test-flan-dev.el b/emacs/test-flan-dev.el index e579b42..cd5cfa9 100644 --- a/emacs/test-flan-dev.el +++ b/emacs/test-flan-dev.el @@ -35,7 +35,13 @@ is written instead — the real `message' call the real command makes." (let* ((args (cdr (member "--" command-line-args))) (socket (nth 0 args)) - (file (nth 1 args))) + (file (nth 1 args)) + (flan (nth 2 args)) + ;; The buffer above is a copy in a temporary directory; this is the + ;; program where it actually lives, which is the one a second daemon + ;; can be started on — an `import' is resolved from the importing + ;; file's own directory, and a copy in /tmp has no packages above it. + (program (nth 3 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 @@ -457,11 +463,171 @@ is written instead — the real `message' call the real command makes." (and said (string-match-p "2" said)))) (delete-region beg (point-max))) + ;; ── The documentation buffer ────────────────────────────────────────── + ;; + ;; The same four facts `defs' carries, in a buffer: eldoc answers while you + ;; are typing, and a signature in the echo area is gone the moment you do + ;; anything else. Run before the disconnect below, because it reads the + ;; running program. + (flan-doc "step") + (with-current-buffer flan-doc-buffer + (let ((text (buffer-string))) + (test-flan--check "the doc buffer names the thing and its signature" + (and (string-match-p "\\`step" text) + (string-match-p "step \\[\\] i64" text))) + (test-flan--check "and says what kind of thing it is" + (string-match-p "Kind +fn" text)) + )) + ;; Where it is written, for a name that has not been re-installed from a + ;; buffer since the daemon built it: `main' is still at the location the + ;; daemon read it from, which is the ordinary case and the one with a + ;; button on it. + (flan-doc "main") + (with-current-buffer flan-doc-buffer + (test-flan--check "and where a definition is written" + (string-match-p + (regexp-quote (file-name-nondirectory program)) + (buffer-string)))) + ;; A global has no Loc in the Tast, so the buffer says that in the same words + ;; M-. refuses in — rather than leaving the line out, which reads as though + ;; the name had no home at all. + (flan-doc "ticks") + (with-current-buffer flan-doc-buffer + (test-flan--check "a global says why there is no location" + (string-match-p "no location for a var" (buffer-string)))) + (let ((raised nil)) + (condition-case err (flan-doc "no-such-name") + (user-error (setq raised (error-message-string err)))) + (test-flan--check "and a name the program has not got is refused" + (and raised (string-match-p "no no-such-name" raised)))) + (flan-disconnect) (test-flan--check "disconnected" (not (process-live-p flan-dev--connection))) (test-flan--check "and the poll timer is cancelled with it" (null flan-dev--timer)) + ;; ── Starting the daemon from Emacs ──────────────────────────────────── + ;; + ;; Last, and after the disconnect above, because it runs a *second* daemon: + ;; nothing before this should have to reason about which of two programs a + ;; request went to. Its own socket for the same reason — and because + ;; `flan dev' with no -s puts one beside the program, which for a test + ;; program in /tmp is a path shared with every other thing running there. + (setq flan-dev-command flan) + (let ((socket2 (concat socket "-started-from-emacs"))) + (ignore-errors (delete-file socket2)) + (test-flan--check "nothing to quit before anything was started" + (let ((raised nil)) + (condition-case err (flan-dev-quit) + (user-error (setq raised (error-message-string err)))) + (and raised (string-match-p "no daemon started" raised)))) + (flan-dev program socket2) + (test-flan--check "M-x flan-dev builds, launches and connects" + (and (process-live-p flan-dev--daemon) + (eq (flan-dev-state) 'live))) + (test-flan--check "and it is the program that was asked for" + (member "step" (plist-get (flan-dev--request '(:op "describe")) + :fns))) + ;; Refused rather than silently restarted: a second daemon would take the + ;; first one's program and everything in its memory with it. + (test-flan--check "a second one is refused while the first is alive" + (let ((raised nil)) + (condition-case err (flan-dev program socket2) + (user-error (setq raised (error-message-string err)))) + (and raised (string-match-p "already running" raised)))) + ;; The daemon owns the program's lifetime, so quitting has to actually end + ;; the process — not just drop the socket and leave it running. + ;; Restarting the program: for a change the running one cannot take — a + ;; struct whose layout moved — where the answer is a new build, a new + ;; process and the session that compiled it. Proved by what it throws + ;; away: a name installed into the old program is not in the new one. + (flan-dev--eval "(defn only-in-the-old-program [] i64 1)" "form") + (test-flan--check "a name installed into the running program is there" + (assoc "only-in-the-old-program" flan-dev--defs)) + (let ((old flan-dev--daemon)) + (flan-dev-restart-program) + (test-flan--check "restarting gives a different daemon, connected" + (and (not (process-live-p old)) + (process-live-p flan-dev--daemon) + (not (eq old flan-dev--daemon)) + (eq (flan-dev-state) 'live)))) + (test-flan--check "and a program built from source, without the addition" + (and (assoc "step" flan-dev--defs) + (null (assoc "only-in-the-old-program" + flan-dev--defs)))) + + (let ((proc flan-dev--daemon)) + (flan-dev-quit) + ;; The process, not the variable: forgetting a daemon is not stopping + ;; one, and a program left running with nothing attached to it is + ;; exactly what the terminal loop used to leave behind. + (test-flan--check "quitting ends the daemon" + (and (not (process-live-p proc)) + (null flan-dev--daemon) + (not (process-live-p flan-dev--connection)) + (eq (flan-dev-state) 'off))) + ;; The daemon unlinks its socket on the way out, so this is the same + ;; claim seen from the other side. + (test-flan--check "and takes its socket with it" + (not (file-exists-p socket2)))) + (ignore-errors (delete-file socket2))) + + ;; 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. + (test-flan--check "a file that is not there is refused before anything starts" + (let ((raised nil)) + (condition-case err (flan-dev "/nonexistent/nope.flan") + (user-error (setq raised (error-message-string err)))) + (and raised (string-match-p "no such file" raised)))) + + ;; ── Navigating a file ───────────────────────────────────────────────── + ;; + ;; No daemon in any of this: imenu and which-function read the buffer, which + ;; is the point — they work on a file nobody has run yet, and they keep + ;; working when the program is stopped or gone. + (with-temp-buffer + (insert ";;;; A file with one of everything.\n" + "(defstruct Missing [id i32])\n" + "(defvar ticks i64)\n" + "(defconst limit i64 10)\n" + "(declare later [] i64)\n" + "(defn step [] i64\n" + " (let [x 1]\n" + " (defn not-top-level [] i64 2)\n" + " (+ ticks x)))\n") + (flan-mode) + (let* ((index (imenu--make-index-alist)) + (group (lambda (name) (cdr (assoc name index))))) + (test-flan--check "imenu finds a function, where it is written" + (equal (marker-position + (cdr (assoc "step" (funcall group "Functions")))) + (save-excursion (goto-char (point-min)) + (search-forward "(defn step") + (match-beginning 0)))) + (test-flan--check "and a struct, under its own heading" + (assoc "Missing" (funcall group "Types"))) + (test-flan--check "and both kinds of global" + (and (assoc "ticks" (funcall group "Variables")) + (assoc "limit" (funcall group "Variables")))) + ;; A forward declaration is not a definition; listing it beside one + ;; would show the same name twice with nothing to tell them apart. + (test-flan--check "and a declaration, said to be one" + (and (assoc "later" (funcall group "Declared")) + (null (assoc "later" (funcall group "Functions"))))) + ;; A `defn' inside a `let' defines nothing at the top level, and the + ;; index is anchored at column 0 so that it cannot offer one. + (test-flan--check "and nothing that is not a top-level form" + (null (assoc "not-top-level" (funcall group "Functions"))))) + ;; which-function: the case is a long body scrolled past its own header. + (goto-char (point-min)) + (search-forward "(+ ticks x)") + (test-flan--check "which-function names the definition point is in" + (equal (flan-current-defun-name) "step")) + (goto-char (point-min)) + (test-flan--check "and says nothing above the first one" + (null (flan-current-defun-name)))) + (if (zerop test-flan--failures) (message "flan-dev.el: all tests passed") (message "\n%d failure(s)" test-flan--failures) diff --git a/test/test_emacs.ml b/test/test_emacs.ml index 79119a6..4bafa59 100644 --- a/test/test_emacs.ml +++ b/test/test_emacs.ml @@ -27,6 +27,16 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ]; let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in let flan = "../bin/main.exe" in + (* Absolute, because the client starts its own daemon at the end of the run + and does it from the program's directory rather than from this one. *) + let flan_abs = try Unix.realpath flan with Unix.Unix_error _ -> flan in + (* And the program itself, for the same reason: the client starts a daemon + of its own at the end of the run, and the copy it edits is in a + temporary directory with no package collections above it. *) + let program = + let p = "programs/dev-repl.flan" in + try Unix.realpath p with Unix.Unix_error _ -> p + in let pid = Unix.create_process flan [| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |] @@ -52,8 +62,10 @@ let () = let code = Sys.command (Printf.sprintf - "emacs -Q --batch -L ../../../emacs -l ../../../emacs/test-flan-dev.el -- %s %s 2>&1" - (Filename.quote sock) (Filename.quote buf)) + "emacs -Q --batch -L ../../../emacs -l ../../../emacs/test-flan-dev.el \ + -- %s %s %s %s 2>&1" + (Filename.quote sock) (Filename.quote buf) (Filename.quote flan_abs) + (Filename.quote program)) in (* The client disconnects at the end, which is what ends the daemon. If it did not get that far — because it failed — nothing else will, so it is