172 lines
6.8 KiB
EmacsLisp
172 lines
6.8 KiB
EmacsLisp
;;; test-flan-fln-live.el --- The .fln keys against a real daemon -*- lexical-binding: t; -*-
|
|
|
|
;; Loaded by test-flan.el, near its end, with `flan-command' already the
|
|
;; compiler under test. test-flan-fln.el checks which text each key picks;
|
|
;; this checks the reader accepts that text as a whole form, on both backends:
|
|
;; a daemon of its own on a .fln file with no main, once on x86 and once on
|
|
;; LLVM, each key sent at least once, and a pause mark the daemon must find.
|
|
|
|
;;; Code:
|
|
|
|
(require 'flan-fln-mode)
|
|
|
|
(declare-function test-flan--check "test-flan" (name ok))
|
|
(declare-function test-flan--result "test-flan" ())
|
|
(defvar test-flan-fln-live-dir)
|
|
(defvar test-flan-fln-live-socket)
|
|
|
|
(defconst test-flan-fln-live--program
|
|
"fn fib(n: i64) -> i64
|
|
if n < 2
|
|
n
|
|
else
|
|
fib(n - 1) + fib(n - 2)
|
|
|
|
fn twice(n: i64) -> i64 = n * 2
|
|
|
|
fn total(n: i32) -> i32
|
|
let t = 0
|
|
for i in range(n)
|
|
t = t + i
|
|
t
|
|
|
|
comment():
|
|
twice(4)
|
|
if 2 > 1
|
|
twice(2)
|
|
else
|
|
0
|
|
let x = 3
|
|
twice(x) + 1
|
|
")
|
|
|
|
(defun test-flan-fln-live--run (backend args)
|
|
(let* ((sock (concat test-flan-fln-live-socket "-fln-" backend))
|
|
(file (expand-file-name (format "fln-live-%s.fln" backend)
|
|
test-flan-fln-live-dir))
|
|
(flan-daemon-args args)
|
|
(name (lambda (s) (format "%s: %s" backend s)))
|
|
(value (lambda (code)
|
|
(plist-get (flan--request
|
|
(list :op "eval-expr" :code code :file "<test>"))
|
|
:value)))
|
|
(goto (lambda (needle &optional after)
|
|
(goto-char (point-min))
|
|
(search-forward needle)
|
|
(unless after (goto-char (match-beginning 0)))))
|
|
(shows (lambda (v)
|
|
(let ((r (test-flan--result)))
|
|
(prog1 (and r (string-match-p (concat "=> " (regexp-quote v) "\\'")
|
|
(string-trim r)))
|
|
(flan-clear-result))))))
|
|
(with-temp-file file (insert test-flan-fln-live--program))
|
|
(ignore-errors (delete-file sock))
|
|
(flan file sock)
|
|
(test-flan--check (funcall name "a daemon starts on a .fln file")
|
|
(process-live-p flan--connection))
|
|
(unwind-protect
|
|
(with-current-buffer (find-file-noselect file)
|
|
(test-flan--check (funcall name "which opens in flan-fln-mode")
|
|
(eq major-mode 'flan-fln-mode))
|
|
|
|
;; C-c C-c, from inside a fn changed in the buffer.
|
|
(funcall goto "n * 2")
|
|
(delete-char 5)
|
|
(insert "n * 3")
|
|
(flan-fln-eval-defun)
|
|
(test-flan--check (funcall name "C-c C-c installs the fn at point")
|
|
(equal (funcall value "(twice 7)") "21"))
|
|
|
|
;; C-x C-e at the end of a column-0 declaration.
|
|
(funcall goto "n * 3")
|
|
(delete-char 5)
|
|
(insert "n * 4")
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e at the end of a column-0 fn installs it")
|
|
(equal (funcall value "(twice 7)") "28"))
|
|
|
|
;; C-x C-e at the end of an inner statement: text from column 3.
|
|
(funcall goto "twice(4)" t)
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e sends the statement ending at point")
|
|
(funcall shows "16"))
|
|
|
|
;; ...and inside a line, the term before point.
|
|
(funcall goto "twice(4)")
|
|
(let ((at (point)))
|
|
(insert "fib(10) + ")
|
|
(goto-char (+ at (length "fib(10)")))
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e inside a line sends the term before point")
|
|
(funcall shows "55"))
|
|
(delete-region at (+ at (length "fib(10) + "))))
|
|
|
|
;; C-c C-e on a clause: the whole if, from column 3, clauses and all.
|
|
(funcall goto "else\n 0")
|
|
(flan-fln-eval-statement)
|
|
(test-flan--check (funcall name "C-c C-e on a clause sends its if, and it reads")
|
|
(funcall shows "8"))
|
|
|
|
;; A bare let: it and the rest of its block, which is its scope.
|
|
(funcall goto "let x = 3")
|
|
(flan-fln-eval-statement)
|
|
(test-flan--check (funcall name "C-c C-e on a bare let sends its scope with it")
|
|
(funcall shows "13"))
|
|
|
|
;; A region of several statements reads as one (do ...).
|
|
(funcall goto "twice(4)")
|
|
(transient-mark-mode 1)
|
|
(set-mark (point))
|
|
(funcall goto "else\n 0" t)
|
|
(flan-fln-eval-statement)
|
|
(test-flan--check (funcall name "C-c C-e on a region of statements evaluates them in order")
|
|
(funcall shows "8"))
|
|
|
|
;; C-c C-n sends and moves on.
|
|
(funcall goto "twice(4)")
|
|
(flan-fln-eval-statement-and-next)
|
|
(test-flan--check (funcall name "C-c C-n sends the statement")
|
|
(funcall shows "16"))
|
|
(test-flan--check (funcall name "and moves to the next")
|
|
(looking-at "if 2 > 1"))
|
|
|
|
;; The pause mark. What is sent is a line and column, and the daemon
|
|
;; answers `:pause' only when a form the reader made starts exactly
|
|
;; there (`Ast.mark_pause'). Each kind of target once, and one position
|
|
;; a column off to show the answer can be no.
|
|
(dolist (c '(("n - 1)" "a call, from its name")
|
|
("n < 2" "an if statement")
|
|
("t = 0" "a let")
|
|
("i in range" "a for")
|
|
("+ i" "an assignment")))
|
|
(funcall goto (car c))
|
|
(let ((reply (flan-fln-eval-defun '(4))))
|
|
(test-flan--check (funcall name (format "C-u C-c C-c marks %s where the reader starts it"
|
|
(cadr c)))
|
|
(plist-get reply :pause)))
|
|
(flan-fln-eval-defun))
|
|
(test-flan--check (funcall name "and a plain C-c C-c takes the mark down")
|
|
(null (flan--pause-overlays)))
|
|
(funcall goto "fib(n - 1)")
|
|
(let* ((b (flan-fln--toplevel-bounds (point)))
|
|
(off (condition-case nil
|
|
(plist-get (flan--eval (flan--text (car b) (cdr b)) "defn"
|
|
nil nil (cons (1+ (point)) (+ 3 (point))))
|
|
:pause)
|
|
(user-error nil))))
|
|
(test-flan--check (funcall name "a position one column off the call is not taken")
|
|
(null off)))
|
|
(flan-fln-eval-defun)
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer))
|
|
;; Stopped whatever happened above: a daemon this started is its own to end.
|
|
(flan-quit))
|
|
(ignore-errors (delete-file sock))
|
|
(ignore-errors (delete-file file))))
|
|
|
|
(message "\nthe .fln keys, against a daemon on each backend")
|
|
(test-flan-fln-live--run "x86" nil)
|
|
(test-flan-fln-live--run "llvm" '("--llvm"))
|
|
|
|
;;; test-flan-fln-live.el ends here
|