462 lines
16 KiB
EmacsLisp
462 lines
16 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
|
|
|
|
fn sign(n: i64) -> i64
|
|
if n < 0
|
|
-1
|
|
elif n == 0
|
|
0
|
|
else
|
|
1
|
|
|
|
enum Dir
|
|
north
|
|
south
|
|
east
|
|
|
|
fn pick(d: Dir) -> i64
|
|
match d
|
|
:north -> 10
|
|
:south -> 20
|
|
:east -> 1 +
|
|
2
|
|
_ ->
|
|
twice(3)
|
|
|
|
fn sign2(k: i64)
|
|
if k < 0 then -1
|
|
elif k == 0 then 0
|
|
else 1
|
|
|
|
fn size(k: i64) -> i64
|
|
if k < 10
|
|
1
|
|
else 2
|
|
|
|
fn lam(k: i64) -> i64
|
|
let add = fn(a: i64, b: i64) -> i64 => a + b
|
|
let dbl = fn(a: i64) -> i64 =>
|
|
a * 2
|
|
add(dbl(k), 1)
|
|
|
|
fn app(x: i64, f: Fn(i64) -> i64) -> i64 = f(x)
|
|
|
|
fn lam2(k: i64) -> i64
|
|
let a = 1
|
|
let b = app(k, fn(x) =>
|
|
let y = x + a
|
|
y)
|
|
let c = fn(z: i64) -> i64 =>
|
|
z * 2
|
|
c(b)
|
|
|
|
fn rs() -> i64
|
|
restart-case
|
|
3
|
|
restart retry() \"Try again\"
|
|
4
|
|
|
|
fn t2(k: i64) -> i64
|
|
let a = 1
|
|
let b = 2
|
|
let c: i64 = 3
|
|
a + b + c + k
|
|
|
|
fn dir(d: Dir) -> i64
|
|
match d
|
|
Dir.north -> 7
|
|
_ -> 8
|
|
|
|
struct Oops :parent Error
|
|
code: i64
|
|
|
|
type Count = i64
|
|
|
|
let speed: i64 = 3
|
|
|
|
fn speed-of() -> i64 = speed
|
|
|
|
struct Pair(a: i64, b: i64)
|
|
|
|
fn pair-sum(p: Pair) -> i64 = p.a + p.b
|
|
|
|
class shape(w, h)
|
|
|
|
generic area(s) -> dyn
|
|
|
|
method area(s: shape) = get(s, :w) * get(s, :h)
|
|
|
|
multi kind(v) -> dyn = type-of(v)
|
|
|
|
method kind(v) when :int = 1
|
|
|
|
method kind(v) when :else
|
|
0
|
|
|
|
fn counted(n: Count) -> Count = n + 1
|
|
|
|
fn oops-code() -> i64
|
|
handler-case
|
|
error(Oops{.code 7})
|
|
on Oops(c)
|
|
c.code
|
|
|
|
macro dbl-of(x, & more)
|
|
quote
|
|
~x + ~x
|
|
|
|
fn use-mac(k: i64) -> i64 = dbl-of(k)
|
|
|
|
fn gcd(a: i64, b: i64) -> i64
|
|
let x = a
|
|
let y = b
|
|
while y != 0
|
|
let r = x % y
|
|
x = y
|
|
y = r
|
|
x
|
|
|
|
fn sum-to(n: i64) -> i64
|
|
let i = 0
|
|
let acc = 0
|
|
until i > n
|
|
acc += i
|
|
i += 1
|
|
acc
|
|
|
|
comment():
|
|
if 1 < 2 and
|
|
3 < 4
|
|
twice(1)
|
|
elif 1 > 2 or
|
|
3 > 4
|
|
0
|
|
app(5, fn(a) =>
|
|
a * 3
|
|
)
|
|
if 2 < 1 then 5
|
|
elif 2 == 1 then 6
|
|
else 7
|
|
twice(4)
|
|
if 2 > 1
|
|
twice(2)
|
|
else
|
|
0
|
|
let x = 3
|
|
twice(x) + 1
|
|
|
|
fn grp(k: i64) -> i64
|
|
let a = k + 1
|
|
b = a * 2
|
|
a + b
|
|
|
|
comment():
|
|
let u = 2
|
|
v = u * 5
|
|
u + v
|
|
")
|
|
|
|
(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 let's bindings on the lines under it go with it, and read.
|
|
(funcall goto "v = u * 5")
|
|
(flan-fln-eval-statement)
|
|
(test-flan--check (funcall name "C-c C-e on a binding line sends its let's group and scope")
|
|
(funcall shows "12"))
|
|
|
|
;; 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"))
|
|
|
|
;; A one-line if with its clauses on the lines under it.
|
|
(funcall goto "if 2 < 1 then 5" t)
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e at the end of a one-line if that goes on evaluates the whole if")
|
|
(funcall shows "7"))
|
|
(funcall goto "elif 2 == 1")
|
|
(flan-fln-eval-statement)
|
|
(test-flan--check (funcall name "C-c C-e on a clause under a one-line if sends its if")
|
|
(funcall shows "7"))
|
|
;; The newer forms install from the buffer and run.
|
|
(pcase-dolist (`(,needle ,call ,want)
|
|
'(("fn sign2" "(sign2 0)" "0")
|
|
("fn size" "(size 20)" "2")
|
|
("fn lam" "(lam 3)" "7")
|
|
("fn lam2" "(lam2 3)" "8")
|
|
("fn rs" "(rs)" "3")
|
|
("fn dir" "(dir :north)" "7")
|
|
("struct Oops" "(oops-code)" "7")
|
|
("type Count" "(counted 1)" "2")
|
|
("struct Pair" "(pair-sum (Pair {.a 1 .b 2}))" "3")
|
|
("fn pair-sum" "(pair-sum (Pair {.a 1 .b 2}))" "3")
|
|
("class shape" "(i64 (area (shape 2 3)))" "6")
|
|
("generic area" "(i64 (area (shape 2 3)))" "6")
|
|
("method area" "(i64 (area (shape 2 3)))" "6")
|
|
("multi kind" "(i64 (kind 3))" "1")
|
|
("method kind(v) when :else" "(i64 (kind :x))" "0")
|
|
("fn counted" "(counted 1)" "2")
|
|
("fn oops-code" "(oops-code)" "7")
|
|
("macro dbl-of" "(use-mac 5)" "10")
|
|
("fn use-mac" "(use-mac 5)" "10")
|
|
("fn gcd" "(gcd 1071 462)" "21")
|
|
("fn sum-to" "(sum-to 4)" "10")))
|
|
(funcall goto needle)
|
|
(flan-fln-eval-defun)
|
|
(test-flan--check (funcall name (format "C-c C-c installs %s" needle))
|
|
(equal (funcall value call) want)))
|
|
|
|
;; A top-level let is a global, installed and re-run by C-c C-c.
|
|
(funcall goto "let speed: i64 = 3")
|
|
(end-of-line)
|
|
(delete-char -1)
|
|
(insert "9")
|
|
(flan-fln-eval-defun)
|
|
(test-flan--check (funcall name "C-c C-c on a top-level let installs the global")
|
|
(equal (funcall value "(speed-of)") "9"))
|
|
|
|
;; A macro changed in the buffer and installed again reaches the
|
|
;; function installed after it.
|
|
(funcall goto "~x + ~x")
|
|
(delete-char 7)
|
|
(insert "~x * 3")
|
|
(funcall goto "macro dbl-of")
|
|
(flan-fln-eval-defun)
|
|
(funcall goto "fn use-mac")
|
|
(flan-fln-eval-defun)
|
|
(test-flan--check (funcall name "C-c C-c on a changed macro takes effect")
|
|
(equal (funcall value "(use-mac 5)") "15"))
|
|
|
|
;; 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.
|
|
;; C-x C-e on an arm's value, and on a condition line.
|
|
(funcall goto ":south -> 20" t)
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e at the end of a match arm evaluates its value")
|
|
(funcall shows "20"))
|
|
(funcall goto ":east -> 1 +" t)
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e on an arm's wrapped value evaluates all of it")
|
|
(funcall shows "3"))
|
|
(funcall goto "if 1 < 2 and" t)
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e on a wrapped condition evaluates all of it")
|
|
(funcall shows "true"))
|
|
;; An error on the wrapped line of a condition or value cut out
|
|
;; mid-line is reported where it is in the buffer, column and all.
|
|
(let ((refused
|
|
(lambda (needle bad fix)
|
|
(funcall goto needle t)
|
|
(let ((line (1+ (line-number-at-pos))) col)
|
|
(save-excursion
|
|
(forward-line 1)
|
|
(search-forward fix (line-end-position))
|
|
(replace-match bad t t)
|
|
(setq col (1+ (- (point) (line-beginning-position)
|
|
(length (car (last (split-string bad " "))))))))
|
|
(prog1 (list (condition-case err (progn (flan-fln-eval-last) nil)
|
|
(user-error (error-message-string err)))
|
|
(format ":%d:%d)" line col))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(search-forward bad)
|
|
(replace-match fix t t)))))))
|
|
(pcase-dolist (`(,what ,needle ,bad ,fix)
|
|
'(("an if condition" "if 1 < 2 and" "3 < 4 4" "3 < 4")
|
|
("an elif condition" "elif 1 > 2 or" "3 > 4 4" "3 > 4")
|
|
("an arm's value" ":east -> 1 +" "2 2" "2")))
|
|
(let ((r (funcall refused needle bad fix)))
|
|
(test-flan--check
|
|
(funcall name (format "an error on the wrapped line of %s is reported at its column" what))
|
|
(and (car r) (string-suffix-p (cadr r) (car r))))
|
|
(unless (and (car r) (string-suffix-p (cadr r) (car r)))
|
|
(message " want ...%s\n got %S" (cadr r) (car r))))))
|
|
(flan-clear-errors)
|
|
;; A lambda's block inside a call's brackets: the call goes whole
|
|
;; from its header line, and reads.
|
|
(funcall goto "app(5")
|
|
(flan-fln-eval-statement)
|
|
(test-flan--check (funcall name "C-c C-e on a call with a block lambda sends it whole, and it reads")
|
|
(funcall shows "15"))
|
|
(funcall goto "app(5, fn(a) =>" t)
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e at the end of its header line too")
|
|
(funcall shows "15"))
|
|
(funcall goto "if 2 > 1" t)
|
|
(flan-fln-eval-last)
|
|
(test-flan--check (funcall name "C-x C-e at the end of an if line evaluates the condition")
|
|
(funcall shows "true"))
|
|
(dolist (c '(("n - 1)" "a call, from its name")
|
|
("elif n" "an elif, at its condition")
|
|
("else\n 1" "an else, at its block")
|
|
(":south -> 20" "a match arm, at its value")
|
|
("_ ->" "a match arm, at its block")
|
|
("n < 2" "an if statement")
|
|
("t = 0" "a let")
|
|
("i in range" "a for")
|
|
("+ i" "an assignment")
|
|
("if k < 0 then" "a one-line if")
|
|
("elif k" "a one-line elif, at its condition")
|
|
("else 1" "a one-line else, at its value")
|
|
("else 2" "a one-line else after a block, at its value")
|
|
("a: i64, b" "a typed lambda, from its fn")
|
|
("a * 2" "a typed lambda's block")
|
|
("x) =>" "a block lambda in a call, from its fn")
|
|
("let y = x" "a statement in a block lambda's block")
|
|
("y)" "the block's last statement, less the call's closer")
|
|
("let b = app" "a merged let's call with a block lambda, at its value")
|
|
("let c = fn" "a merged let's block lambda, at its value")
|
|
("restart retry" "a restart with a report, at its block")
|
|
("Dir.north" "an enum member's arm, at its value")
|
|
("let b = 2" "a let the let above takes in, at its value")
|
|
("let c: i64" "a typed one, at its value")
|
|
("while y != 0" "a while, at its word")
|
|
("let r = x % y" "a while's block")
|
|
("until i > n" "an until, at its word")
|
|
("acc += i" "an until's block")
|
|
("b = a * 2" "a binding under a let, at its value")))
|
|
(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
|