Joseph Ferano
5f5cc8bee9
No DAP implementation here, and there should not be one. `flan build --debug' puts DWARF in the executable, lldb reads it, lldb-dap speaks the protocol — so what was actually missing was a dape-configs entry that knows to build a .flan file first and where the binary lands. The build goes through dape's own `compile' key rather than a shell-out, so a rejected program lands in a compilation buffer and next-error walks it. Flan's diagnostics are already file:line:col. `flan-debug' goes through `dape--config-eval' and not `alist-get'. `dape' takes a config whose forms are already evaluated — that is what M-x dape does after reading one — and handing it the stored entry would pass the list (flan-dape--binary (flan-dape--source)) to lldb as a program name. Driven headlessly to prove it: a breakpoint set by line in the .flan buffer, hit, reported as flan.tick at debug.flan:19 with c and n in scope. The keybinding is registered from here rather than in flan-mode.el, so this file is the only thing anyone has to load to get it and flan-mode keeps working for someone who never installs dape. The two frictions are written down at the bottom of flan-dape.el from lldb transcripts, not from reasoning about what ought to happen, because the guess I started from was wrong. Across a reload a breakpoint set by *name* gains a second location and both stay live — the old body is still mapped and still what old call sites reach. One set by *file and line* stops firing, and not because dape pinned it to an address: the redefinition module has no line table to resolve against. Given one, lldb does re-resolve on dlopen. Which names the gap: Emit.redefinition takes ~debug and Session.eval does not pass it, so `flan reload' and the `flan dev' daemon build modules without DWARF. lib/session.ml is the dev loop's file, not this lane's. test-flan-dape.el is not in dune test. It wants Emacs, dape, lldb-dap and a built flan at once, and wiring four optional things into the acceptance table would make that table's failures mean less, not more.
139 lines
6.4 KiB
EmacsLisp
139 lines
6.4 KiB
EmacsLisp
;;; test-flan-dape.el --- Drive a real dape session at a Flan program -*- lexical-binding: t; -*-
|
|
|
|
;; Run from the repository root, with flan on PATH and dape on the load path:
|
|
;;
|
|
;; emacs -Q --batch -L emacs -L /path/to/dape -l emacs/test-flan-dape.el
|
|
;;
|
|
;; Not part of `dune test'. It needs Emacs, dape, lldb-dap and a built flan
|
|
;; all at once, and wiring four optional things into the acceptance table
|
|
;; would make the table's failures mean less rather than more — the DWARF
|
|
;; itself is tested there, against LLVM and against lldb directly. What this
|
|
;; adds is the last link: that dape, driving lldb-dap, sets a breakpoint from
|
|
;; a .flan buffer, hits it, and reports Flan frames and locals.
|
|
;;
|
|
;; It exits non-zero and says why if any of that does not happen.
|
|
|
|
;;; Code:
|
|
|
|
(require 'flan-mode)
|
|
(require 'dape)
|
|
(require 'flan-dape)
|
|
|
|
(defvar flan-dape-test--program "test/programs/debug.flan")
|
|
(defvar flan-dape-test--failures 0)
|
|
|
|
(defun flan-dape-test--fail (fmt &rest args)
|
|
(setq flan-dape-test--failures (1+ flan-dape-test--failures))
|
|
(message "FAIL %s" (apply #'format fmt args)))
|
|
|
|
(defun flan-dape-test--ok (what)
|
|
(message " ok %s" what))
|
|
|
|
;; Batch Emacs has no idle loop, so every wait is an explicit pump.
|
|
(defun flan-dape-test--pump (pred secs)
|
|
(let ((deadline (+ (float-time) secs)))
|
|
(while (and (< (float-time) deadline) (not (funcall pred)))
|
|
(accept-process-output nil 0.05))
|
|
(funcall pred)))
|
|
|
|
(defun flan-dape-test--stopped ()
|
|
(dape--live-connection 'stopped t))
|
|
|
|
(unless (executable-find flan-dape-command)
|
|
(message "test-flan-dape: skipped (no %s on PATH)" flan-dape-command)
|
|
(kill-emacs 0))
|
|
(unless (executable-find flan-dape-adapter)
|
|
(message "test-flan-dape: skipped (no %s on PATH)" flan-dape-adapter)
|
|
(kill-emacs 0))
|
|
|
|
(setq dape-cwd-function (lambda () default-directory))
|
|
|
|
;; The breakpoint is set in the .flan buffer, by line, before anything is
|
|
;; built — which is the only way a person would ever set one, and the thing
|
|
;; that cannot work without a line table naming the .flan file.
|
|
(with-current-buffer (find-file-noselect flan-dape-test--program)
|
|
(unless (eq major-mode 'flan-mode)
|
|
(flan-dape-test--fail "%s did not open in flan-mode" flan-dape-test--program))
|
|
(unless (eq (key-binding (kbd "C-c C-g")) 'flan-debug)
|
|
(flan-dape-test--fail "C-c C-g is not bound to flan-debug in a Flan buffer"))
|
|
(goto-char (point-min))
|
|
(search-forward "(set (.heat c)")
|
|
(dape-breakpoint-toggle)
|
|
(let ((config (dape--config-eval 'flan nil)))
|
|
;; `dape--config-eval' is where the unquoted forms in `flan-dape-config'
|
|
;; turn into strings. If this is a list rather than a path, `flan-debug'
|
|
;; handed dape an unevaluated config and lldb would be given a program
|
|
;; named "(flan-dape--binary ...)".
|
|
(unless (stringp (plist-get config :program))
|
|
(flan-dape-test--fail ":program did not evaluate to a path: %S"
|
|
(plist-get config :program)))
|
|
(unless (zerop (call-process-shell-command (plist-get config 'compile) nil nil))
|
|
(flan-dape-test--fail "the configured build failed: %s"
|
|
(plist-get config 'compile))
|
|
(kill-emacs 1))
|
|
(flan-dape-test--ok "the config builds the program it points lldb at")
|
|
(dape config 'skip-compile)))
|
|
|
|
(if (not (flan-dape-test--pump #'flan-dape-test--stopped 60))
|
|
(flan-dape-test--fail "the session never stopped at the entry point")
|
|
(flan-dape-test--ok "lldb-dap launched and stopped at entry")
|
|
(dape-continue (flan-dape-test--stopped))
|
|
;; The entry stop has to clear before the next one counts as the breakpoint.
|
|
(flan-dape-test--pump (lambda () (not (flan-dape-test--stopped))) 5)
|
|
(if (not (flan-dape-test--pump #'flan-dape-test--stopped 60))
|
|
(flan-dape-test--fail "the breakpoint in %s never hit" flan-dape-test--program)
|
|
(let* ((conn (flan-dape-test--stopped))
|
|
(thread (car (dape--threads conn)))
|
|
(frames (plist-get thread :stackFrames))
|
|
(top (car frames)))
|
|
(flan-dape-test--ok "the breakpoint hit")
|
|
(unless (equal (plist-get top :name) "flan.tick")
|
|
(flan-dape-test--fail "the top frame is %S, wanted flan.tick"
|
|
(plist-get top :name)))
|
|
(unless (equal (plist-get (plist-get top :source) :name) "debug.flan")
|
|
(flan-dape-test--fail "the top frame's source is %S, wanted debug.flan"
|
|
(plist-get (plist-get top :source) :name)))
|
|
(unless (integerp (plist-get top :line))
|
|
(flan-dape-test--fail "the top frame has no line number"))
|
|
(flan-dape-test--ok
|
|
(format "frame %s at %s:%s" (plist-get top :name)
|
|
(plist-get (plist-get top :source) :name) (plist-get top :line)))
|
|
;; Locals, which dape fetches lazily — so they are asked for here.
|
|
(let ((seen nil) (done nil))
|
|
(dape-request
|
|
conn :scopes (list :frameId (plist-get top :id))
|
|
(lambda (body _err)
|
|
(dolist (scope (append (plist-get body :scopes) nil))
|
|
(dape-request
|
|
conn :variables
|
|
(list :variablesReference (plist-get scope :variablesReference))
|
|
(lambda (body _err)
|
|
(dolist (v (append (plist-get body :variables) nil))
|
|
(push (list (plist-get v :type) (plist-get v :name)
|
|
(plist-get v :value))
|
|
seen)))))
|
|
(setq done t)))
|
|
(flan-dape-test--pump (lambda () done) 15)
|
|
(accept-process-output nil 1.0)
|
|
(dolist (want '(("int" "n" "41") ("Cell *" "c" nil)))
|
|
(let ((hit (seq-find (lambda (v)
|
|
(and (equal (nth 0 v) (nth 0 want))
|
|
(equal (nth 1 v) (nth 1 want))
|
|
(or (null (nth 2 want))
|
|
(equal (nth 2 v) (nth 2 want)))))
|
|
seen)))
|
|
(if hit
|
|
(flan-dape-test--ok (format "%s %s = %s" (nth 0 hit) (nth 1 hit)
|
|
(nth 2 hit)))
|
|
(flan-dape-test--fail "no local %s of type %s; saw %S"
|
|
(nth 1 want) (nth 0 want) seen))))))))
|
|
|
|
(ignore-errors (dape-kill (dape--live-connection 'parent)))
|
|
|
|
(if (zerop flan-dape-test--failures)
|
|
(progn (message "flan-dape: all tests passed") (kill-emacs 0))
|
|
(message "%d failure(s)" flan-dape-test--failures)
|
|
(kill-emacs 1))
|
|
|
|
;;; test-flan-dape.el ends here
|