1547 lines
78 KiB
EmacsLisp
1547 lines
78 KiB
EmacsLisp
;;; test-flan-fln.el --- The .fln mode, from written-out text -*- lexical-binding: t; -*-
|
|
|
|
;; Loaded by test-flan-cider.el, which runs under `dune test', for the reason
|
|
;; test-flan-mode.el is: `emacs/*.el' is already that stanza's dependency.
|
|
;; Nothing here needs a daemon; what the daemon makes of what these commands
|
|
;; send is test-flan-fln-live.el's, run from test-flan.el.
|
|
;;
|
|
;; Every snippet is text; each check says where point is with a `|' written
|
|
;; into it, which is removed before the check runs.
|
|
|
|
;;; Code:
|
|
|
|
(require 'flan-fln-mode)
|
|
(require 'flan)
|
|
|
|
(declare-function test-flan--check "test-flan-cider" (name ok))
|
|
|
|
(defmacro test-flan-fln--in (text &rest body)
|
|
"Run BODY in a .fln buffer holding TEXT, point where TEXT has its `|'."
|
|
(declare (indent 1))
|
|
`(with-temp-buffer
|
|
(insert ,text)
|
|
(flan-fln-mode)
|
|
(goto-char (point-min))
|
|
(when (search-forward "|" nil t)
|
|
(delete-char -1))
|
|
,@body))
|
|
|
|
(defun test-flan-fln--text (b)
|
|
(and b (cdr b) (buffer-substring-no-properties (car b) (cdr b))))
|
|
|
|
(defun test-flan-fln--is (name got want)
|
|
(test-flan--check name (equal got want))
|
|
(unless (equal got want)
|
|
(message " want %S\n got %S" want got)))
|
|
|
|
(defun test-flan-fln--thing (thing)
|
|
(test-flan-fln--text (bounds-of-thing-at-point thing)))
|
|
|
|
(message "\nthe .fln mode")
|
|
|
|
;;; One parent
|
|
|
|
(test-flan--check "flan-mode is a flan-base-mode"
|
|
(provided-mode-derived-p 'flan-mode 'flan-base-mode))
|
|
(test-flan--check "flan-fln-mode is a flan-base-mode"
|
|
(provided-mode-derived-p 'flan-fln-mode 'flan-base-mode))
|
|
(test-flan--check ".fln opens in flan-fln-mode"
|
|
(eq (cdr (assoc "\\.fln\\'" auto-mode-alist)) 'flan-fln-mode))
|
|
(test-flan-fln--in "fn f() -> i32 = 1\n"
|
|
(test-flan--check "a .fln buffer sends the indented syntax"
|
|
(equal (flan--syntax) "indented"))
|
|
(test-flan--check "and gets the client's completion, as a .flan one does"
|
|
(memq #'flan-completion-at-point completion-at-point-functions))
|
|
(test-flan--check "and the modeline indicator"
|
|
(member '(:eval (flan-mode-line)) mode-line-misc-info))
|
|
(test-flan--check "the shared keys reach it through the parent's map"
|
|
(eq (key-binding (kbd "C-c C-b")) 'flan-cnr-show))
|
|
(test-flan--check "and its own keys pick .fln forms"
|
|
(and (eq (key-binding (kbd "C-c C-c")) 'flan-fln-eval-defun)
|
|
(eq (key-binding (kbd "C-x C-e")) 'flan-fln-eval-last))))
|
|
(require 'flan-watch)
|
|
(let ((b (generate-new-buffer "ghost.fln")))
|
|
(with-current-buffer b (flan-fln-mode))
|
|
(switch-to-buffer b)
|
|
(test-flan--check "watch paints ghost text in a shown .fln buffer"
|
|
(memq b (flan-watch--ghost-buffers)))
|
|
(with-current-buffer b
|
|
(insert "fn f() -> ()\n watch-i64(\"x\", 1)\n")
|
|
(test-flan--check "and finds a watch call written as a .fln call"
|
|
(equal (mapcar #'car (flan-watch--ghost-sites)) '("x"))))
|
|
(kill-buffer b))
|
|
(require 'flan-dape)
|
|
(test-flan--check "dape offers its config in any Flan buffer"
|
|
(equal (plist-get flan-dape-config 'modes) '(flan-base-mode)))
|
|
(let ((buffer-file-name "/tmp/x.fln"))
|
|
(test-flan--check "and debugs the .fln file it was started from"
|
|
(equal (flan-dape--source) "/tmp/x.fln")))
|
|
|
|
;;; The objects
|
|
|
|
(defconst test-flan-fln--settle
|
|
"fn settle(row: i32, col: i32) -> ()
|
|
let vel = f32(gravity) + velocity[row, col]
|
|
while y > row
|
|
if 0 == grid[y, col]
|
|
grid[y, col] = grid[row, col]
|
|
; a comment inside the body
|
|
|
|
return
|
|
let is-left = col > 0
|
|
if is-left or is-right
|
|
let side =
|
|
if not is-left
|
|
1
|
|
elif not is-right
|
|
-1
|
|
else
|
|
if f32(rand()) < 0.5 then 1 else -1
|
|
grid[y, col + side] = grid[row, col]
|
|
y = y - 1
|
|
velocity[row, col] = 0.0
|
|
|
|
; trailing comment, not part of the function
|
|
|
|
fn step() -> ()
|
|
paint-at(i32(m.y) / cell-size,
|
|
i32(m.x) / cell-size)
|
|
if r >= 0 and r < rows - 1
|
|
and c >= 0
|
|
grid[r, c] = 1
|
|
step()
|
|
")
|
|
|
|
(defun test-flan-fln--at (text needle)
|
|
"TEXT with a `|' before the first NEEDLE."
|
|
(let ((i (string-search needle text)))
|
|
(concat (substring text 0 i) "|" (substring text i))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "if 0 == grid")
|
|
(test-flan-fln--is "a statement takes its body, through blank and comment lines"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"if 0 == grid[y, col]
|
|
grid[y, col] = grid[row, col]
|
|
; a comment inside the body
|
|
|
|
return")
|
|
(test-flan-fln--is "its body is the lines under its first"
|
|
(test-flan-fln--thing 'flan-fln-body)
|
|
"grid[y, col] = grid[row, col]
|
|
; a comment inside the body
|
|
|
|
return"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "elif not is-right")
|
|
(test-flan-fln--is "on a clause, the statement is its header's, clauses and all"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"if not is-left
|
|
1
|
|
elif not is-right
|
|
-1
|
|
else
|
|
if f32(rand()) < 0.5 then 1 else -1")
|
|
(test-flan-fln--is "and the clause is its own line and block"
|
|
(test-flan-fln--thing 'flan-fln-clause)
|
|
"elif not is-right
|
|
-1"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "1\n elif")
|
|
(test-flan-fln--is "a clause is not found from the header's own block"
|
|
(test-flan-fln--thing 'flan-fln-clause) nil))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
|
(test-flan-fln--is "from inside else's block, the clause is the else"
|
|
(test-flan-fln--thing 'flan-fln-clause)
|
|
"else
|
|
if f32(rand()) < 0.5 then 1 else -1"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "let side =")
|
|
(test-flan-fln--is "let x = with the value as a block"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"let side =
|
|
if not is-left
|
|
1
|
|
elif not is-right
|
|
-1
|
|
else
|
|
if f32(rand()) < 0.5 then 1 else -1"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "i32(m.x)")
|
|
(test-flan-fln--is "a line inside a bracket is part of its statement"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"paint-at(i32(m.y) / cell-size,
|
|
i32(m.x) / cell-size)")
|
|
(test-flan-fln--is "a term is glued, brackets and all"
|
|
(test-flan-fln--thing 'flan-fln-term) "i32(m.x)")
|
|
(test-flan-fln--is "a group is a bracket pair"
|
|
(test-flan-fln--thing 'flan-fln-group)
|
|
"(i32(m.y) / cell-size,
|
|
i32(m.x) / cell-size)"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
|
(test-flan-fln--is "an operator continuation line is part of its statement"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"if r >= 0 and r < rows - 1
|
|
and c >= 0
|
|
grid[r, c] = 1")
|
|
(test-flan-fln--is "and not the start of the body"
|
|
(test-flan-fln--thing 'flan-fln-body) "grid[r, c] = 1"))
|
|
|
|
;; The bit operators continue a line as the other spaced operators do.
|
|
;; Not through `test-flan-fln--in', whose `|' marks point and would eat one
|
|
;; half of `||'.
|
|
(dolist (op '("&&" "||" "^^"))
|
|
(with-temp-buffer
|
|
(insert "x = a " op "\n b\ny = a\n " op " b\n")
|
|
(flan-fln-mode)
|
|
(goto-char (point-min))
|
|
(forward-line 1)
|
|
(test-flan--check (concat "a line after a trailing " op " continues it")
|
|
(flan-fln--continuation-p (point)))
|
|
(forward-line 2)
|
|
(test-flan--check (concat "a line starting with " op " continues")
|
|
(flan-fln--continuation-p (point)))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "velocity[row, col] = 0.0")
|
|
(test-flan-fln--is "a top-level form ends before trailing comment lines"
|
|
(test-flan-fln--thing 'flan-fln-toplevel)
|
|
(substring test-flan-fln--settle 0
|
|
(+ (string-search "= 0.0" test-flan-fln--settle) 5))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "trailing comment")
|
|
(test-flan--check "a comment between forms belongs to the form above"
|
|
(string-prefix-p "fn settle"
|
|
(test-flan-fln--thing 'flan-fln-toplevel))))
|
|
|
|
(test-flan-fln--in "; a header comment\n|\nfn f() -> i32 = 1\n"
|
|
(test-flan-fln--is "before any form, the next one"
|
|
(test-flan-fln--thing 'flan-fln-toplevel) "fn f() -> i32 = 1"))
|
|
|
|
(test-flan-fln--in "let xs = [1 2\n3 4]\n + 1\nfn|x() -> i32 = 1\n"
|
|
(test-flan-fln--is "column 0 inside a bracket or after a leading operator is no form start"
|
|
(save-excursion (beginning-of-defun)
|
|
(buffer-substring-no-properties (point) (line-end-position)))
|
|
"fnx() -> i32 = 1"))
|
|
|
|
(test-flan-fln--in "x = 1\nhandler-case\n f()\non E(c)\n nil\n|restart y\n"
|
|
(test-flan--check "on and restart at column 0 are clauses, not forms"
|
|
(progn (beginning-of-defun)
|
|
(looking-at "handler-case"))))
|
|
|
|
(test-flan-fln--in "let on = 3\nfoo(x):|\n bar()\n"
|
|
(test-flan-fln--is "a term ends before the trailing colon of a call's block"
|
|
(test-flan-fln--text (flan-fln--term-before (point))) "foo(x)"))
|
|
|
|
(test-flan-fln--in "f(\\(, \\) , x.y)|\n"
|
|
(test-flan-fln--is "a character literal is not a bracket"
|
|
(test-flan-fln--text (flan-fln--term-before (point)))
|
|
"f(\\(, \\) , x.y)"))
|
|
|
|
;;; Top-level motion
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " y = y - 1")
|
|
(beginning-of-defun)
|
|
(test-flan--check "C-M-a goes to the form's first line" (looking-at "fn settle"))
|
|
(end-of-defun)
|
|
(test-flan--check "C-M-e goes past its last code line, not its trailing comment"
|
|
(save-excursion (forward-line -1)
|
|
(looking-at " velocity\\[row, col\\] = 0.0")))
|
|
(end-of-defun)
|
|
(test-flan--check "and the next C-M-e ends the next form"
|
|
(= (point) (point-max)))
|
|
(goto-char (point-max))
|
|
(beginning-of-defun)
|
|
(test-flan--check "C-M-a from the end reaches the last form" (looking-at "fn step"))
|
|
(mark-defun)
|
|
(test-flan--check "C-M-h marks the form"
|
|
(let ((m (buffer-substring (region-beginning) (region-end))))
|
|
(and (string-prefix-p "fn step" (string-trim-left m "\n"))
|
|
(string-suffix-p " step()\n" m)))))
|
|
|
|
;;; Statement motion
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " let is-left")
|
|
(flan-fln-backward-statement)
|
|
(test-flan--check "M-a at a statement's start goes to the one before at its level"
|
|
(looking-at "if 0 == grid"))
|
|
(flan-fln-backward-statement)
|
|
(test-flan--check "and out to the owner when there is none" (looking-at "while y"))
|
|
(flan-fln-forward-statement)
|
|
(test-flan--check "M-e goes to the end of the statement, body and all"
|
|
(looking-back "y = y - 1" (line-beginning-position)))
|
|
(flan-fln-forward-statement)
|
|
(test-flan--check "and again, to the end of the next"
|
|
(looking-back "= 0.0" (line-beginning-position))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " -1")
|
|
(flan-fln-up)
|
|
(test-flan--check "C-M-u goes to the line that owns the block"
|
|
(looking-at "elif not is-right"))
|
|
(flan-fln-up)
|
|
(test-flan--check "and from there to its owner's" (looking-at "let side")))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "m.x)")
|
|
(flan-fln-up)
|
|
(test-flan--check "C-M-u inside a bracket goes to the bracket" (looking-at "(m.x)")))
|
|
|
|
;;; What each key sends
|
|
|
|
;; The request, captured where it leaves: the daemon's answer is the live
|
|
;; test's business, and here what matters is which text went out and where
|
|
;; it said the text starts.
|
|
(defvar test-flan-fln--sent nil)
|
|
|
|
(defmacro test-flan-fln--sending (&rest body)
|
|
`(progn
|
|
(setq test-flan-fln--sent nil)
|
|
(cl-letf (((symbol-function 'flan--request)
|
|
(lambda (form) (push form test-flan-fln--sent)
|
|
(list :status "ok" :value "0")))
|
|
((symbol-function 'pulse-momentary-highlight-region) #'ignore))
|
|
,@body)
|
|
(car test-flan-fln--sent)))
|
|
|
|
(defun test-flan-fln--sent-code (req)
|
|
(plist-get req :code))
|
|
|
|
(defconst test-flan-fln--prog
|
|
"fn fib(n: i64) -> i64
|
|
if n < 2
|
|
n
|
|
else
|
|
fib(n - 1) + fib(n - 2)
|
|
|
|
comment():
|
|
twice(4)
|
|
let x = 3
|
|
if x > 2
|
|
twice(x)
|
|
else
|
|
0
|
|
|
|
fn twice(n: i64) -> i64 = n * 2
|
|
")
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "fib(n - 1)")
|
|
(test-flan--check "C-c C-s is the .fln stepper"
|
|
(eq (key-binding (kbd "C-c C-s")) 'flan-fln-step-defun))
|
|
(let ((r (test-flan-fln--sending (flan-fln-step-defun))))
|
|
(test-flan--check "which installs the fn at point to step through"
|
|
(and (equal (plist-get r :op) "eval")
|
|
(eq (plist-get r :step) t)
|
|
(string-prefix-p "fn fib" (test-flan-fln--sent-code r))
|
|
(string-suffix-p "fib(n - 2)" (test-flan-fln--sent-code r))))))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
|
(test-flan--check "and refuses what is not a declaration"
|
|
(condition-case nil
|
|
(progn (test-flan-fln--sending (flan-fln-step-defun)) nil)
|
|
(user-error t))))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "fib(n - 1)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun))))
|
|
(test-flan--check "C-c C-c inside a fn installs the whole fn"
|
|
(and (equal (plist-get r :op) "eval")
|
|
(string-suffix-p "fib(n - 1) + fib(n - 2)"
|
|
(test-flan-fln--sent-code r))
|
|
(string-prefix-p "fn fib" (test-flan-fln--sent-code r))
|
|
(equal (plist-get r :syntax) "indented")))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun))))
|
|
(test-flan--check "C-c C-c on a column-0 call evaluates it"
|
|
(equal (plist-get r :op) "eval-expr"))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n let x")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "C-x C-e at a line's end sends the statement ending there"
|
|
(and (equal (plist-get r :op) "eval-expr")
|
|
(equal (test-flan-fln--sent-code r) "twice(4)")
|
|
(equal (plist-get r :line) 8)
|
|
(equal (plist-get r :col) 3)))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n else\n 0")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "the innermost one: the last line of a block, not the if"
|
|
(equal (test-flan-fln--sent-code r) "twice(x)"))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "(4)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "C-x C-e inside a line sends the term before point"
|
|
(and (equal (test-flan-fln--sent-code r) "twice")
|
|
(equal (plist-get r :col) 3)))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n\ncomment")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "at the end of a fn's last line, the innermost statement, not the fn"
|
|
(equal (test-flan-fln--sent-code r) "fib(n - 1) + fib(n - 2)"))))
|
|
|
|
(test-flan-fln--in test-flan-fln--prog
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "\n")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "a column-0 one-line fn at its end is installed"
|
|
(and (equal (plist-get r :op) "eval")
|
|
(string-suffix-p "fn twice(n: i64) -> i64 = n * 2"
|
|
(test-flan-fln--sent-code r))))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "else\n 0")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
|
(test-flan--check "C-c C-e on a clause sends its whole statement"
|
|
(and (equal (test-flan-fln--sent-code r)
|
|
"if x > 2\n twice(x)\n else\n 0")
|
|
(equal (plist-get r :line) 10)
|
|
(equal (plist-get r :col) 3)))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "let x = 3")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
|
(test-flan--check "C-c C-e on a bare let sends it with the rest of its block"
|
|
(equal (test-flan-fln--sent-code r)
|
|
"let x = 3\n if x > 2\n twice(x)\n else\n 0"))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement-and-next))))
|
|
(test-flan--check "C-c C-n sends the statement"
|
|
(equal (test-flan-fln--sent-code r) "twice(4)"))
|
|
(test-flan--check "and moves to the next" (looking-at "let x = 3"))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
|
(transient-mark-mode 1)
|
|
(set-mark (point))
|
|
(search-forward "twice(x)")
|
|
(forward-char -3)
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
|
(test-flan--check "C-c C-e sends the region's whole lines"
|
|
(equal (test-flan-fln--sent-code r)
|
|
"twice(4)\n let x = 3\n if x > 2\n twice(x)"))))
|
|
|
|
;; The pause target. The position sent is where the reader starts the form,
|
|
;; which for a call is its name and not its parenthesis; the live test checks
|
|
;; the daemon finds a form there.
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "n - 1)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
|
(test-flan-fln--is "C-u C-c C-c in a call marks the call, from its name"
|
|
(plist-get r :pause) '(5 5))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "< 2")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
|
(test-flan-fln--is "outside a bracket, the statement on point's line"
|
|
(plist-get r :pause) '(2 3))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "n < 2")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(16)))))
|
|
(test-flan-fln--is "C-u C-u, the fn: stop on entry"
|
|
(plist-get r :pause) '(1 1))))
|
|
|
|
(test-flan-fln--in "fn f(x: i64) -> i64\n g((x| + 1), [x 2])\n"
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
|
(test-flan-fln--is "a free parenthesis marks the value inside it"
|
|
(plist-get r :pause) '(2 6))))
|
|
|
|
;;; A let's bindings on the lines under it
|
|
|
|
(defconst test-flan-fln--group
|
|
"fn f(p) -> i64
|
|
let a = 1
|
|
b = a + 1
|
|
{x .x} = p
|
|
g(a, b)
|
|
a + x
|
|
")
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--group "b = a")
|
|
(test-flan-fln--is "a binding line is part of its let's statement"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"let a = 1\n b = a + 1\n {x .x} = p"))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--group "{x .x}")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
|
(test-flan-fln--is "C-c C-e on a binding line sends the group and its scope"
|
|
(test-flan-fln--sent-code r)
|
|
"let a = 1\n b = a + 1\n {x .x} = p\n g(a, b)\n a + x")))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--group "a + 1")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
|
(test-flan-fln--is "C-u C-c C-c on a binding line marks its value"
|
|
(plist-get r :pause) '(3 11))))
|
|
(test-flan-fln--in (test-flan-fln--at "fn f()\n let a = 1\n (not) = 2\n g()\n" "(not)")
|
|
(test-flan-fln--is "a name in parentheses is a binding line"
|
|
(test-flan-fln--thing 'flan-fln-statement) "let a = 1\n (not) = 2"))
|
|
(test-flan-fln--in (test-flan-fln--at "let a: i32\n b: i64\n" "b:")
|
|
(test-flan-fln--is "a typed global with no value is one under a top-level let"
|
|
(test-flan-fln--thing 'flan-fln-statement) "let a: i32\n b: i64"))
|
|
(test-flan-fln--in (test-flan-fln--at "fn f()\n let f = fn(x) =>\n y = x\n y\n f\n" "y = x")
|
|
(test-flan-fln--is "a line of a lambda value's block is no binding"
|
|
(test-flan-fln--thing 'flan-fln-statement) "y = x"))
|
|
|
|
;;; Match arms, header lines, clauses, comments
|
|
|
|
(defconst test-flan-fln--arms
|
|
"fn pick(n: i64) -> i64
|
|
let r = match n
|
|
0 -> 10
|
|
1 ->
|
|
twice(1)
|
|
twice(2)
|
|
k -> k + 1
|
|
if n < 0
|
|
-1
|
|
elif n == 0
|
|
or n == 1
|
|
0
|
|
else
|
|
r
|
|
handler-case
|
|
f()
|
|
on Error(e)
|
|
nil
|
|
; a comment, twice(9)
|
|
r
|
|
|
|
comment:
|
|
twice(4)
|
|
")
|
|
|
|
(defun test-flan-fln--last-at (needle &optional fn)
|
|
"What FN, C-x C-e by default, sends with point at the end of NEEDLE's line."
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms needle)
|
|
(end-of-line)
|
|
(let ((r (test-flan-fln--sending (funcall (or fn #'flan-fln-eval-last)))))
|
|
(and r (list (plist-get r :op) (test-flan-fln--sent-code r))))))
|
|
|
|
(test-flan-fln--is "C-x C-e at the end of a match arm sends its value"
|
|
(test-flan-fln--last-at "0 -> 10") '("eval-expr" "10"))
|
|
(test-flan-fln--is "at the end of an arm with a block, the block"
|
|
(test-flan-fln--last-at "1 ->")
|
|
'("eval-expr" "twice(1)\n twice(2)"))
|
|
(test-flan-fln--is "an arm whose pattern binds a name sends the whole match"
|
|
(cadr (test-flan-fln--last-at "k -> k"))
|
|
(substring test-flan-fln--arms (string-search "let r" test-flan-fln--arms)
|
|
(+ (string-search "k + 1" test-flan-fln--arms) 5)))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms "twice(2)")
|
|
(test-flan-fln--is "C-c C-e on an arm's block sends the block, not the arm"
|
|
(test-flan-fln--sent-code
|
|
(test-flan-fln--sending
|
|
(search-backward "1 ->") (flan-fln-eval-statement)))
|
|
"twice(1)\n twice(2)"))
|
|
(test-flan-fln--is "C-x C-e at the end of an if line sends its condition"
|
|
(test-flan-fln--last-at "if n < 0") '("eval-expr" "n < 0"))
|
|
(test-flan-fln--is "and of an elif, all of its condition"
|
|
(test-flan-fln--last-at "or n == 1")
|
|
'("eval-expr" "n == 0\n or n == 1"))
|
|
(test-flan-fln--is "and the same from the end of the condition's first line"
|
|
(test-flan-fln--last-at "elif n == 0")
|
|
'("eval-expr" "n == 0\n or n == 1"))
|
|
|
|
(defconst test-flan-fln--wrapped
|
|
"fn f(o: Option(i64)) -> i64
|
|
match o
|
|
Some(_) -> 5
|
|
Some(n) -> n + 1
|
|
Some(m) -> 7
|
|
None -> 1 +
|
|
2
|
|
if 1 < 2 and
|
|
3 < 4
|
|
x = 1 +
|
|
2
|
|
")
|
|
|
|
(defun test-flan-fln--wrapped-at (needle fn)
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped needle)
|
|
(end-of-line)
|
|
(let ((r (test-flan-fln--sending (funcall fn))))
|
|
(and r (test-flan-fln--sent-code r)))))
|
|
|
|
(test-flan-fln--is "an arm's value wrapped onto a second line goes whole"
|
|
(test-flan-fln--wrapped-at "None" #'flan-fln-eval-last)
|
|
"1 +\n 2")
|
|
(test-flan-fln--is "from its second line too"
|
|
(test-flan-fln--wrapped-at " 2\n if" #'flan-fln-eval-last)
|
|
"1 +\n 2")
|
|
(test-flan-fln--is "and C-c C-e on it sends the same"
|
|
(test-flan-fln--wrapped-at "None" #'flan-fln-eval-statement)
|
|
"1 +\n 2")
|
|
(test-flan-fln--is "a wrapped if condition, from the end of its first line"
|
|
(test-flan-fln--wrapped-at "if 1 < 2" #'flan-fln-eval-last)
|
|
"1 < 2 and\n 3 < 4")
|
|
(test-flan-fln--is "a statement wrapped by an operator, from the end of its first line"
|
|
(test-flan-fln--wrapped-at "x = 1 +" #'flan-fln-eval-last)
|
|
"x = 1 +\n 2")
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "None")
|
|
(end-of-line)
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan-fln--is "a value cut mid-line says where its statement starts"
|
|
(list (plist-get r :line) (plist-get r :col) (plist-get r :indent))
|
|
'(6 13 5))))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "x = 1")
|
|
(end-of-line)
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "a whole statement does not" (null (plist-member r :indent)))))
|
|
(test-flan-fln--is "an arm whose pattern binds nothing sends its value"
|
|
(test-flan-fln--wrapped-at "Some(_)" #'flan-fln-eval-last) "5")
|
|
(test-flan-fln--is "nor one whose value does not use what it binds"
|
|
(test-flan-fln--wrapped-at "Some(m)" #'flan-fln-eval-last) "7")
|
|
(dolist (c '(("Some(_v) -> _v + 1" "a name starting with _")
|
|
("Some(éé) -> éé" "a name that is not ASCII")
|
|
("Some(N) -> N" "a capitalised name")
|
|
("Some(p) -> p.x" "a name used as a field's base")
|
|
("Some(n) -> -n" "a name its value negates")
|
|
("Some(p) -> -p.x" "a name whose field its value negates")))
|
|
(test-flan-fln--in (concat "fn f(o: Option(i64)) -> i64\n match o\n " (car c) "\n")
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "\n")
|
|
(test-flan--check (format "an arm binding %s its value uses sends the match" (cadr c))
|
|
(string-prefix-p "match o"
|
|
(test-flan-fln--sent-code
|
|
(test-flan-fln--sending (flan-fln-eval-last)))))))
|
|
(test-flan--check "one whose value uses its binding sends the match"
|
|
(string-prefix-p "match o"
|
|
(test-flan-fln--wrapped-at "Some(n)" #'flan-fln-eval-last)))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--wrapped "5")
|
|
(test-flan-fln--is "a match arm is a clause"
|
|
(test-flan-fln--thing 'flan-fln-clause) "Some(_) -> 5"))
|
|
(test-flan-fln--is "at the end of an else line, the whole if"
|
|
(cadr (test-flan-fln--last-at "else\n r"))
|
|
"if n < 0\n -1\n elif n == 0\n or n == 1\n 0\n else\n r")
|
|
(test-flan-fln--is "at the end of an on line, the whole handler-case"
|
|
(cadr (test-flan-fln--last-at "on Error"))
|
|
"handler-case\n f()\n on Error(e)\n nil")
|
|
(test-flan-fln--is "at the end of a fn header, the fn, installed"
|
|
(car (test-flan-fln--last-at "fn pick")) "eval")
|
|
(test-flan-fln--is "at the end of comment:, the whole block"
|
|
(test-flan-fln--last-at "comment:")
|
|
'("eval-expr" "comment:\n twice(4)"))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms "; a comment")
|
|
(end-of-line)
|
|
(let ((r (test-flan-fln--sending
|
|
(condition-case nil (flan-fln-eval-last) (user-error nil)))))
|
|
(test-flan--check "C-x C-e on a comment line sends nothing from the comment"
|
|
(null r))))
|
|
|
|
(defun test-flan-fln--pause-at (needle)
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms needle)
|
|
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause)))
|
|
|
|
(test-flan-fln--is "C-u C-c C-c on an arm's pattern stops at its value"
|
|
(test-flan-fln--pause-at "0 -> 10") '(3 10))
|
|
(test-flan-fln--is "on an arm with a block, at the block"
|
|
(test-flan-fln--pause-at "1 ->") '(5 7))
|
|
(test-flan-fln--is "on an elif line, at its condition"
|
|
(test-flan-fln--pause-at "elif") '(10 8))
|
|
(test-flan-fln--is "and from its condition's continuation line too"
|
|
(test-flan-fln--pause-at "or n == 1") '(10 8))
|
|
(test-flan-fln--is "on an else line, at its block"
|
|
(test-flan-fln--pause-at "else\n r") '(14 5))
|
|
(test-flan-fln--is "on an on line, at its block"
|
|
(test-flan-fln--pause-at "on Error") '(18 5))
|
|
|
|
;;; One-line ifs with clauses under them, typed lambdas, restarts
|
|
|
|
(defconst test-flan-fln--oneline
|
|
"fn sign(n: i64)
|
|
if n < 0 then -1
|
|
elif n == 0 then 0
|
|
else 1
|
|
|
|
fn size(n: i64) -> i64
|
|
if n < 10
|
|
1
|
|
else 2
|
|
|
|
fn k(n: i64) -> i64
|
|
let add = fn(a: i64, b) -> i64 => a + b
|
|
let dbl = fn(a: Fn(i64) -> i64, b: i64) -> i64 =>
|
|
a(b) * 2
|
|
let r = match n
|
|
0 -> 1
|
|
_ -> 2
|
|
add(r, 1)
|
|
")
|
|
|
|
(defun test-flan-fln--oneline-at (needle fn &optional at-end)
|
|
"What FN sends with point at NEEDLE in the one-line program, or at the end
|
|
of its line with AT-END."
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--oneline needle)
|
|
(when at-end (end-of-line))
|
|
(let ((r (test-flan-fln--sending (funcall fn))))
|
|
(and r (list (test-flan-fln--sent-code r) (plist-get r :pause))))))
|
|
|
|
(test-flan-fln--is "an else under a one-line if belongs to its statement"
|
|
(car (test-flan-fln--oneline-at "else 1" #'flan-fln-eval-statement))
|
|
"if n < 0 then -1\n elif n == 0 then 0\n else 1")
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--oneline "elif n == 0")
|
|
(test-flan-fln--is "and the clause is its line"
|
|
(test-flan-fln--thing 'flan-fln-clause) "elif n == 0 then 0"))
|
|
(test-flan-fln--is "C-x C-e at the end of a one-line if that goes on sends the whole if"
|
|
(car (test-flan-fln--oneline-at "if n < 0" #'flan-fln-eval-last t))
|
|
"if n < 0 then -1\n elif n == 0 then 0\n else 1")
|
|
(test-flan-fln--is "and at the end of a one-line elif"
|
|
(car (test-flan-fln--oneline-at "elif n" #'flan-fln-eval-last t))
|
|
"if n < 0 then -1\n elif n == 0 then 0\n else 1")
|
|
(test-flan-fln--is "an else x after a block if belongs to it too"
|
|
(car (test-flan-fln--oneline-at "else 2" #'flan-fln-eval-statement))
|
|
"if n < 10\n 1\n else 2")
|
|
(test-flan-fln--is "C-u C-c C-c on a one-line elif stops at its condition"
|
|
(cadr (test-flan-fln--oneline-at "elif n" (lambda () (flan-fln-eval-defun '(4)))))
|
|
'(3 8))
|
|
(test-flan-fln--is "and on a one-line else, at its value"
|
|
(cadr (test-flan-fln--oneline-at "else 1" (lambda () (flan-fln-eval-defun '(4)))))
|
|
'(4 8))
|
|
(test-flan-fln--is "an else x after a block if too"
|
|
(cadr (test-flan-fln--oneline-at "else 2" (lambda () (flan-fln-eval-defun '(4)))))
|
|
'(9 8))
|
|
(test-flan-fln--is "C-u C-c C-c on a let the let above takes in stops at its value"
|
|
(test-flan-fln--in "fn t2(n: i64) -> i64\n let a = 1\n |let b = 2\n a + b + n\n"
|
|
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause))
|
|
'(3 11))
|
|
(test-flan-fln--is "and at its block when the value is one"
|
|
(test-flan-fln--in "fn t2(n: i64) -> i64\n let a = 1\n |let b =\n n + 1\n a + b\n"
|
|
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause))
|
|
'(4 5))
|
|
(test-flan-fln--is "the first let of a run stops at the let"
|
|
(test-flan-fln--in "fn t2(n: i64) -> i64\n n + 1\n |let a = 1\n a\n"
|
|
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause))
|
|
'(3 3))
|
|
(test-flan-fln--is "C-c C-e on a let whose value is a block sends its scope with it"
|
|
(car (test-flan-fln--oneline-at "let r" #'flan-fln-eval-statement))
|
|
"let r = match n\n 0 -> 1\n _ -> 2\n add(r, 1)")
|
|
(test-flan-fln--is "and on a typed lambda's let, its body and the let's scope"
|
|
(car (test-flan-fln--oneline-at "let dbl" #'flan-fln-eval-statement))
|
|
(substring test-flan-fln--oneline
|
|
(string-search "let dbl" test-flan-fln--oneline)
|
|
(1- (length test-flan-fln--oneline))))
|
|
(test-flan-fln--is "an arm whose pattern is Dir.north binds nothing"
|
|
(test-flan-fln--in "fn f(d: Dir) -> Dir\n match d\n Dir.north -> Dir.south\n"
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "\n")
|
|
(test-flan-fln--sent-code (test-flan-fln--sending (flan-fln-eval-last))))
|
|
"Dir.south")
|
|
|
|
;;; Names and colours
|
|
|
|
(test-flan-fln--in "fn f(x: i64) -> i64\n comment:\n g(:key-r, x)\n 0x1F + 12\n"
|
|
(search-forward "x:")
|
|
(backward-char 1)
|
|
(test-flan-fln--is "a colon glued to a name is not part of it"
|
|
(thing-at-point 'symbol t) "x")
|
|
(search-forward "comment")
|
|
(test-flan-fln--is "nor to a name that takes a block"
|
|
(thing-at-point 'symbol t) "comment")
|
|
(test-flan--check "font-lock draws the buffer without an error"
|
|
(condition-case nil (progn (font-lock-ensure) t) (error nil)))
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "a number is drawn as one" (funcall face "12") 'font-lock-number-face)
|
|
(test-flan-fln--is "a keyword as a constant" (funcall face ":key-r") 'font-lock-constant-face)
|
|
(test-flan-fln--is "a header word as a keyword" (funcall face "fn") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "a type after its colon" (funcall face "i64") 'font-lock-type-face)
|
|
(test-flan--check "and the name before the colon is not a keyword"
|
|
(null (funcall face "x:")))))
|
|
|
|
(test-flan-fln--in "fn f(d: Dir) -> i64
|
|
let g = fn(a: Fn(i64) -> i64, b) -> Vec(i64) =>
|
|
a(b)
|
|
restart-case
|
|
3
|
|
restart retry(v: i32) \"Try again\"
|
|
v
|
|
match d
|
|
Dir.north -> twice(1)
|
|
Circle(r) -> r
|
|
"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "a lambda's fn is a keyword" (funcall face "fn(a") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "its parameter's function type is a type" (funcall face "Fn(i64)") 'font-lock-type-face)
|
|
(test-flan-fln--is "and its return type" (funcall face "Vec") 'font-lock-type-face)
|
|
(test-flan-fln--is "a restart's name is drawn as a name" (funcall face "retry") 'font-lock-function-name-face)
|
|
(test-flan-fln--is "its report as a string" (funcall face "\"Try") 'font-lock-string-face)
|
|
(test-flan-fln--is "an enum member as a constant" (funcall face "Dir.north") 'font-lock-constant-face)
|
|
(test-flan-fln--is "an arm's value is not a type" (funcall face "twice(1)") nil)
|
|
(test-flan-fln--is "nor after a pattern with parentheses" (funcall face "r\n") nil)))
|
|
(test-flan-fln--in "struct DiskFull :parent IoError
|
|
free: i64
|
|
|
|
type Row = Vec(i64)
|
|
|
|
macro repeat(i, n, & body)
|
|
quote
|
|
for ~i in range(~n)
|
|
~@body
|
|
|
|
fn gcd(a: i32, b: i32) -> i32
|
|
let x = a
|
|
let y = b
|
|
while y != 0
|
|
let r = x % y
|
|
x = y
|
|
y = r
|
|
x
|
|
"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "a struct's parent is a type" (funcall face "IoError") 'font-lock-type-face)
|
|
(test-flan-fln--is "and :parent a keyword" (funcall face ":parent") 'font-lock-constant-face)
|
|
(test-flan-fln--is "macro is a keyword" (funcall face "macro") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "and its name a function's" (funcall face "repeat") 'font-lock-function-name-face)
|
|
(test-flan-fln--is "type is a keyword" (funcall face "type") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "an alias's name is a type" (funcall face "Row") 'font-lock-type-face)
|
|
(test-flan-fln--is "and so is what it names" (funcall face "Vec(i64)") 'font-lock-type-face))
|
|
(goto-char (point-min))
|
|
(search-forward "Row")
|
|
(test-flan-fln--is "an alias installs as a defalias"
|
|
(flan-fln--declaration-head-at (line-beginning-position)) "defalias")
|
|
(goto-char (point-min))
|
|
(search-forward "~@body")
|
|
(test-flan-fln--is "a macro is one top-level form"
|
|
(test-flan-fln--thing 'flan-fln-toplevel)
|
|
"macro repeat(i, n, & body)
|
|
quote
|
|
for ~i in range(~n)
|
|
~@body")
|
|
(test-flan-fln--is "installed as a defmacro"
|
|
(flan-fln--declaration-head-at (car (flan-fln--toplevel-bounds (point))))
|
|
"defmacro")
|
|
(search-forward "while y")
|
|
(test-flan-fln--is "a while's statement is its header and block"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"while y != 0
|
|
let r = x % y
|
|
x = y
|
|
y = r")
|
|
(goto-char (point-min))
|
|
(test-flan-fln--is "the struct's head is defstruct"
|
|
(flan-fln--declaration-head-at (point)) "defstruct")
|
|
(let ((imenu-generic-expression flan-fln-imenu-generic-expression))
|
|
(test-flan--check "imenu lists the macro"
|
|
(assoc "repeat" (cdr (assoc "Macros" (imenu--generic-function
|
|
imenu-generic-expression)))))))
|
|
(test-flan-fln--in "defmacro(m, [x]):
|
|
quote
|
|
~x
|
|
|
|
defmethod(area, point, [p]):
|
|
0
|
|
|
|
defclass(Shape, [w dyn]):
|
|
|
|
defstruct(Io, :parent, Error, [])
|
|
|
|
defconst(k, 3)
|
|
"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(dolist (c '(("defmacro" m font-lock-function-name-face)
|
|
("defmethod" area font-lock-function-name-face)
|
|
("defclass" Shape font-lock-type-face)
|
|
("defstruct" Io font-lock-type-face)
|
|
("defconst" k font-lock-variable-name-face)))
|
|
(test-flan-fln--is (format "a fallback %s's head is a keyword" (car c))
|
|
(funcall face (concat (car c) "(")) 'font-lock-keyword-face)
|
|
(test-flan-fln--is (format "and the name it defines, %s" (cadr c))
|
|
(save-excursion
|
|
(goto-char (point-min))
|
|
(search-forward (concat (car c) "("))
|
|
(get-text-property (point) 'face))
|
|
(nth 2 c))))
|
|
(let ((index (imenu--generic-function flan-fln-imenu-generic-expression)))
|
|
(test-flan--check "imenu lists a fallback defmacro"
|
|
(assoc "m" (cdr (assoc "Macros" index))))
|
|
(test-flan--check "a fallback defmethod"
|
|
(assoc "area" (cdr (assoc "Functions" index))))
|
|
(test-flan--check "a fallback defclass and defstruct"
|
|
(and (assoc "Shape" (cdr (assoc "Types" index)))
|
|
(assoc "Io" (cdr (assoc "Types" index)))))
|
|
(test-flan--check "and a fallback defconst"
|
|
(assoc "k" (cdr (assoc "Variables" index))))))
|
|
(test-flan-fln--in "fn far(a: i64,\n b: i64) -> Point\n match a\n Some(x) -> Other\n"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "a wrapped fn header's return type is a type" (funcall face "Point") 'font-lock-type-face)
|
|
(test-flan-fln--is "an arm's value after a call pattern is not" (funcall face "Other") nil)))
|
|
|
|
;;; Indentation
|
|
|
|
(defun test-flan-fln--tabs (text n)
|
|
"The column TEXT's `|' line reaches after N TABs."
|
|
(test-flan-fln--in text
|
|
(let ((last-command nil) (this-command 'indent-for-tab-command))
|
|
(dotimes (_ n)
|
|
(indent-for-tab-command)
|
|
(setq last-command 'indent-for-tab-command)))
|
|
(current-indentation)))
|
|
|
|
(defconst test-flan-fln--nest
|
|
"fn f() -> ()
|
|
while a
|
|
if b
|
|
c()
|
|
|")
|
|
|
|
(test-flan-fln--is "the first TAB after a block goes to its column"
|
|
(test-flan-fln--tabs test-flan-fln--nest 1) 6)
|
|
(test-flan-fln--is "each TAB after that steps out one"
|
|
(list (test-flan-fln--tabs test-flan-fln--nest 2)
|
|
(test-flan-fln--tabs test-flan-fln--nest 3)
|
|
(test-flan-fln--tabs test-flan-fln--nest 4)
|
|
(test-flan-fln--tabs test-flan-fln--nest 5))
|
|
'(4 2 0 6))
|
|
(test-flan-fln--is "a line of code already at a valid column stays there"
|
|
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 1) 2)
|
|
(test-flan-fln--is "and a second TAB steps it out"
|
|
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 2) 0)
|
|
(test-flan-fln--is "a line of code at no valid column goes to the deepest"
|
|
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 1) 4)
|
|
(test-flan-fln--is "after a header, one level deeper first"
|
|
(test-flan-fln--tabs "fn f() -> ()\n while a\n|" 1) 4)
|
|
(test-flan-fln--is "after a trailing colon too"
|
|
(test-flan-fln--tabs "rl/with-drawing():\n|" 1) 2)
|
|
(test-flan-fln--is "and after let x ="
|
|
(test-flan-fln--tabs "let colors =\n|" 1) 2)
|
|
(test-flan-fln--is "but not after a one-line fn"
|
|
(test-flan-fln--tabs "fn f() -> i32 = 1\n|" 1) 0)
|
|
(test-flan-fln--is "after if let, one level deeper"
|
|
(test-flan-fln--tabs "fn f() -> ()\n if let Some(g) = o\n|" 1) 4)
|
|
(test-flan-fln--is "and after a when with a block"
|
|
(test-flan-fln--tabs "fn f() -> ()\n when a > 1\n|" 1) 4)
|
|
(test-flan-fln--is "but not after a one-line when"
|
|
(test-flan-fln--tabs "fn f() -> ()\n when a then b()\n|" 1) 2)
|
|
(test-flan-fln--in "fn f() -> ()\n if let Some(g) = o\n g\n let w = when a then 1\n when b\n c()\n"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "if let's let is a keyword" (funcall face "let Some") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "a value's when is a keyword" (funcall face "when a") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "and so is a statement's" (funcall face "when b") 'font-lock-keyword-face)))
|
|
;; Swift optionals: the marks are not part of a name, `??' continues a line,
|
|
;; and `elif let' reads as `if let' does.
|
|
(test-flan-fln--in "fn f(o: i32?) -> i32\n if o? as g\n g!\n elif let Some(h) = p?.q\n h ?? 0\n"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "elif let's let is a keyword" (funcall face "let Some(h)") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "a test's as is a keyword" (funcall face "as g") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "a type's ? is the type's" (funcall face "?)") 'font-lock-type-face)
|
|
(test-flan-fln--is "an unwrap's ! is marked" (funcall face "!\n") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "a chain's ? is marked" (funcall face "?.q") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "?? is marked" (funcall face "??") 'font-lock-keyword-face))
|
|
(goto-char (point-min))
|
|
(search-forward "g!")
|
|
(backward-char 1)
|
|
(test-flan-fln--is "the name at x! is x" (thing-at-point 'symbol t) "g"))
|
|
;; A condition's `as' with no `?' before it, twice on a line; an `as' outside
|
|
;; a condition is left alone.
|
|
(test-flan-fln--in "fn f()\n left = when get(grid, r) as g and b(g) as h then g\n x = as y\n"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "a condition's as is a keyword" (funcall face "as g") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "and a second one" (funcall face "as h") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "an as outside a condition is not" (funcall face "as y") nil)))
|
|
(test-flan-fln--is "after if x? as g, one level deeper"
|
|
(test-flan-fln--tabs "fn f() -> ()\n if o? as g\n|" 1) 4)
|
|
(with-temp-buffer
|
|
(insert "x = a ??\n b\ny = a\n ?? b\n")
|
|
(flan-fln-mode)
|
|
(goto-char (point-min))
|
|
(forward-line 1)
|
|
(test-flan--check "a line after a trailing ?? continues it"
|
|
(flan-fln--continuation-p (point)))
|
|
(forward-line 2)
|
|
(test-flan--check "a line starting with ?? continues"
|
|
(flan-fln--continuation-p (point))))
|
|
;; The pipe: a line starting with `|>' goes under the value the statement
|
|
;; binds, then under the pipe above it. The first `|' of each text is point.
|
|
(test-flan-fln--is "a first |> goes under the let's value"
|
|
(test-flan-fln--tabs "let total = get(g)\n||> f()" 1) 12)
|
|
(test-flan-fln--is "and a second TAB one level in from the let"
|
|
(test-flan-fln--tabs "let total = get(g)\n||> f()" 2) 2)
|
|
(with-temp-buffer
|
|
(insert "let total = get(g)\n |> f()\n|> g()")
|
|
(flan-fln-mode)
|
|
(flan-fln-indent-line)
|
|
(test-flan-fln--is "a |> under a |> lines up with it" (current-indentation) 12))
|
|
(test-flan-fln--is "a |> under a bare statement is one level in"
|
|
(test-flan-fln--tabs "fn f() -> ()\n get(g)\n||> f()" 1) 4)
|
|
(test-flan-fln--in "|let y = x |> f()\nz = a\n |> g\nw = b |>\n h\n"
|
|
(font-lock-ensure)
|
|
(test-flan-fln--is "a |> inside a line is marked"
|
|
(save-excursion (search-forward "x |>") (get-text-property (- (point) 2) 'face))
|
|
'font-lock-keyword-face)
|
|
(test-flan-fln--is "a |> starting a line is marked"
|
|
(save-excursion (search-forward " |>") (get-text-property (- (point) 2) 'face))
|
|
'font-lock-keyword-face)
|
|
(forward-line 2)
|
|
(test-flan--check "a line starting with |> continues" (flan-fln--continuation-p (point)))
|
|
(forward-line 2)
|
|
(test-flan--check "a line after a trailing |> continues it" (flan-fln--continuation-p (point))))
|
|
(test-flan-fln--is "else goes to its if's column, whatever the depth"
|
|
(test-flan-fln--tabs "if a\n if b\n c\n |else" 1) 2)
|
|
(test-flan-fln--is "and a second TAB to the outer if's"
|
|
(test-flan-fln--tabs "if a\n if b\n c\n |else" 2) 0)
|
|
(test-flan-fln--is "on goes to its handler-case's"
|
|
(test-flan-fln--tabs " handler-case\n f()\n |on E(c)" 1) 2)
|
|
(test-flan-fln--is "inside a call, under its first argument"
|
|
(test-flan-fln--tabs " paint-at(i32(m.y) / cell-size,\n|i32(m.x))" 1) 11)
|
|
(test-flan-fln--is "inside a bracket with nothing after it, one level in"
|
|
(test-flan-fln--tabs " let v = [\n|1 2]" 1) 4)
|
|
(test-flan-fln--is "a closing bracket, at the bracket's own column"
|
|
(test-flan-fln--tabs " let v = [\n 1 2\n|]" 1) 4)
|
|
(test-flan-fln--is "a closer after RET in an open call, under the first argument"
|
|
(test-flan-fln--tabs " if and(state.paused\n|)" 1) 9)
|
|
(test-flan-fln--in "fn f()\n if and(state.paused|)\n"
|
|
(newline-and-indent)
|
|
(test-flan-fln--is "RET before the closer puts it under the first argument"
|
|
(list (current-indentation) (char-after)) '(9 ?\))))
|
|
(test-flan-fln--is "after a line ending in an operator, deeper than its statement"
|
|
(test-flan-fln--tabs " if a and\n|b" 1) 4)
|
|
(test-flan-fln--is "never deeper after a let"
|
|
(test-flan-fln--tabs "fn f()\n let r = 3\n|" 1) 2)
|
|
(test-flan-fln--is "TAB after a let stays at its column first"
|
|
(test-flan-fln--tabs "fn f()\n let a = 1\n|" 1) 2)
|
|
(test-flan-fln--is "and offers its next binding's column, under the first name"
|
|
(test-flan-fln--tabs "fn f()\n let a = 1\n|" 2) 6)
|
|
(test-flan-fln--is "after a binding line, that column comes first"
|
|
(test-flan-fln--tabs "fn f()\n let a = 1\n b = 2\n|" 1) 6)
|
|
(test-flan-fln--is "and a binding written there stays"
|
|
(test-flan-fln--tabs "fn f()\n let a = 1\n| b = 2" 1) 6)
|
|
(test-flan-fln--is "at the top level too"
|
|
(test-flan-fln--tabs "let a = 1\n|" 2) 4)
|
|
(dolist (c '(("fn f()\n let a = 0\n g = fn(x) =>\n x + 1\n|" (8 2 0) "a lambda's block")
|
|
("fn f()\n let a = 1\n b = match a\n 1 -> 2\n|" (8 2 0) "a match's arms")
|
|
("let a = 0\n g = fn(x) =>\n x + 1\n|" (6 0) "a global's lambda block")
|
|
("fn f()\n let a = 1\n g = map(xs, fn(x) =>\n x + 1)\n|" (6 2 0)
|
|
"but a lambda's brackets closed, where the column stays")
|
|
("fn f(c)\n let a = 1\n b = if c\n 1\n else\n 2\n|" (8 2 0)
|
|
"an if's else block")
|
|
("fn f(c)\n let a = 1\n b = if c\n 1\n|" (8 6 2 0)
|
|
"but an if's block, where its else may go")
|
|
("fn f(c, d)\n let a = 1\n b = if c\n 1\n elif d\n 2\n|" (8 6 2 0)
|
|
"and an elif's block, where another clause may go")
|
|
("fn f()\n let g = map(xs, fn(x) =>\n x + 1)\n|" (2 6 0)
|
|
"a first binding's bracketed lambda offers the column")))
|
|
(test-flan-fln--is (format "no binding column after a binding's open block: %s" (nth 2 c))
|
|
(test-flan-fln--in (car c) (flan-fln--block-levels (point)))
|
|
(cadr c)))
|
|
(test-flan-fln--is "but not after a tab between let and its name"
|
|
(list (test-flan-fln--tabs "fn f()\n let\ta = 1\n|" 1)
|
|
(test-flan-fln--tabs "fn f()\n let\ta = 1\n|" 2))
|
|
'(2 0))
|
|
(dolist (c '(("let r = match n" "a let's match")
|
|
("let r = if c" "a let's if")
|
|
("x = if c" "an assignment's if")
|
|
("let r = handler-case" "a let's handler-case")
|
|
("let f = fn(a, b) =>" "a lambda header")
|
|
("let f = fn(a: i64, b) -> i64 =>" "a typed lambda header")
|
|
("let f = fn(g: Fn(i64) -> i64) -> Option(i64) =>" "one with a function type in it")
|
|
("fn(a: i64) -> i64 =>" "a typed lambda as a statement")))
|
|
(test-flan-fln--is (format "unless its value goes on under it: %s" (cadr c))
|
|
(test-flan-fln--tabs (concat "fn f()\n " (car c) "\n|") 1) 4))
|
|
(test-flan-fln--is "but not a typed lambda with its body on the line"
|
|
(test-flan-fln--tabs "fn f()\n let f = fn(a: i64) -> i64 => a\n|" 1) 2)
|
|
(test-flan-fln--is "loop is no header in .fln, and opens nothing"
|
|
(test-flan-fln--tabs "fn f()\n let r = loop i = 0\n|" 1) 2)
|
|
(test-flan-fln--is "a header word being assigned opens nothing"
|
|
(test-flan-fln--tabs "fn f()\n for = 1\n|" 1) 2)
|
|
(test-flan-fln--in "fn f()\n handler-case\n g()\n on E(c)\n h(c)\n on = 2\n data += 1\n"
|
|
(font-lock-ensure)
|
|
(goto-char (point-min))
|
|
(search-forward "on = 2")
|
|
(test-flan--check "nor is a clause word being assigned a clause"
|
|
(not (flan-fln--clause-line-p (line-beginning-position))))
|
|
(test-flan-fln--is "or drawn as a keyword"
|
|
(get-text-property (match-beginning 0) 'face) nil)
|
|
(search-forward "data")
|
|
(test-flan-fln--is "and a header word assigned is not either"
|
|
(get-text-property (match-beginning 0) 'face) nil))
|
|
(test-flan-fln--is "a macro opens a block"
|
|
(test-flan-fln--tabs "macro repeat(i, n, & body)\n|" 1) 2)
|
|
(test-flan-fln--is "and a struct with a parent"
|
|
(test-flan-fln--tabs "struct DiskFull :parent IoError\n|" 1) 2)
|
|
(test-flan-fln--in "let speed: i64 = 3\n\nfn f()\n let x = 1\n x\n"
|
|
(font-lock-ensure)
|
|
(test-flan-fln--is "a top-level let's name is a variable's"
|
|
(save-excursion (goto-char (point-min)) (search-forward "speed")
|
|
(get-text-property (match-beginning 0) 'face))
|
|
'font-lock-variable-name-face)
|
|
(test-flan-fln--is "and installs as a def" (flan-fln--declaration-head-at (point-min)) "def")
|
|
(test-flan--check "imenu lists it"
|
|
(assoc "speed" (cdr (assoc "Variables" (imenu--generic-function
|
|
flan-fln-imenu-generic-expression)))))
|
|
(test-flan--check "it is no local let" (not (flan-fln--let-p (point-min))))
|
|
(goto-char (point-min))
|
|
(search-forward "let x")
|
|
(test-flan--check "one in a fn is" (flan-fln--let-p (line-beginning-position)))
|
|
(test-flan-fln--is "and its name is not a global's"
|
|
(get-text-property (match-end 0) 'face) nil))
|
|
(test-flan-fln--is "a class with a slot per line opens a block"
|
|
(test-flan-fln--tabs "class point\n|" 1) 2)
|
|
(test-flan-fln--is "not one on one line"
|
|
(test-flan-fln--tabs "class point(x, y)\n|" 1) 0)
|
|
(test-flan-fln--is "a method opens its block"
|
|
(test-flan-fln--tabs "method area(p: point)\n|" 1) 2)
|
|
(test-flan-fln--is "but not one with its value on the line"
|
|
(test-flan-fln--tabs "method kind(v) when :int = 1\n|" 1) 0)
|
|
(test-flan-fln--is "a multi with a block opens it"
|
|
(test-flan-fln--tabs "multi kind(v) -> dyn\n|" 1) 2)
|
|
(test-flan-fln--is "a generic never does"
|
|
(test-flan-fln--tabs "generic area(p) -> dyn\n|" 1) 0)
|
|
(test-flan-fln--in "class point(x, y)\n\ngeneric area(p) -> dyn\n\nmethod area(p: point)\n 1\n\nmulti kind(v) -> dyn = type-of(v)\n\nmethod kind(v) when :int = 2\n"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "class is a keyword" (funcall face "class") 'font-lock-keyword-face)
|
|
(test-flan-fln--is "and its name a type" (funcall face "point(") 'font-lock-type-face)
|
|
(test-flan-fln--is "a generic's name is a function's" (funcall face "area(p)") 'font-lock-function-name-face)
|
|
(test-flan-fln--is "a method's class is a type" (funcall face "point)") 'font-lock-type-face)
|
|
(test-flan-fln--is "a method's when is a keyword" (funcall face "when") 'font-lock-keyword-face))
|
|
(let ((index (imenu--generic-function flan-fln-imenu-generic-expression)))
|
|
(test-flan--check "imenu lists the class, the generic and the multi"
|
|
(and (assoc "point" (cdr (assoc "Types" index)))
|
|
(assoc "area" (cdr (assoc "Functions" index)))
|
|
(assoc "kind" (cdr (assoc "Functions" index))))))
|
|
(goto-char (point-min))
|
|
(search-forward "method area")
|
|
(test-flan-fln--is "a method installs as a defmethod"
|
|
(flan-fln--declaration-head-at (line-beginning-position)) "defmethod"))
|
|
(test-flan-fln--is "but not a struct on one line"
|
|
(test-flan-fln--tabs "struct Pt(x: i32, y: i32)\n|" 1) 0)
|
|
(test-flan-fln--is "nor one with a parent"
|
|
(test-flan-fln--tabs "struct D(free: i64) :parent IoError\n|" 1) 0)
|
|
(test-flan-fln--in "struct D(free: i64) :parent IoError\n\nunion U(a: i32)\n"
|
|
(font-lock-ensure)
|
|
(let ((face (lambda (needle)
|
|
(save-excursion (goto-char (point-min)) (search-forward needle)
|
|
(get-text-property (match-beginning 0) 'face)))))
|
|
(test-flan-fln--is "a one-line struct's name is a type" (funcall face "D(") 'font-lock-type-face)
|
|
(test-flan-fln--is "its field's type too" (funcall face "i64") 'font-lock-type-face)
|
|
(test-flan-fln--is "and its parent" (funcall face "IoError") 'font-lock-type-face)
|
|
(test-flan-fln--is "a one-line union's name" (funcall face "U(") 'font-lock-type-face))
|
|
(goto-char (point-min))
|
|
(test-flan-fln--is "a one-line struct is a top-level form of one line"
|
|
(test-flan-fln--thing 'flan-fln-toplevel)
|
|
"struct D(free: i64) :parent IoError"))
|
|
(test-flan-fln--is "a one-line fn whose value is a match opens it"
|
|
(test-flan-fln--tabs "fn f(x) = match x\n|" 1) 2)
|
|
(test-flan-fln--is "no deeper after a one-line else"
|
|
(test-flan-fln--tabs "fn f()\n if a\n b\n else c\n|" 1) 2)
|
|
(test-flan-fln--is "nor after one that ends in a comment"
|
|
(test-flan-fln--tabs "fn f()\n if a then b\n else c ; c\n|" 1) 2)
|
|
(test-flan-fln--is "but deeper after an else alone with a comment"
|
|
(test-flan-fln--tabs "fn f()\n if a\n b\n else ; c\n|" 1) 4)
|
|
(test-flan-fln--is "after a one-line if, a new line stays at its column"
|
|
(test-flan-fln--tabs "fn f()\n if a then b\n|" 1) 2)
|
|
(test-flan-fln--is "else goes to a one-line if's column"
|
|
(test-flan-fln--tabs "if a\n if b then c\n |else d" 1) 2)
|
|
(test-flan-fln--is "and to a let's if"
|
|
(test-flan-fln--tabs "fn f()\n let s = if c\n 1\n |else" 1) 2)
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n while a\n b()\n |"
|
|
(flan-fln-dedent-or-delete 1)
|
|
(test-flan-fln--is "backspace in the indentation drops one level"
|
|
(current-indentation) 2)
|
|
(flan-fln-dedent-or-delete 1)
|
|
(test-flan-fln--is "and another" (current-indentation) 0))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n ab|"
|
|
(flan-fln-dedent-or-delete 1)
|
|
(test-flan-fln--is "backspace after text deletes a character"
|
|
(buffer-substring (line-beginning-position) (point)) " a"))
|
|
|
|
(test-flan-fln--in "if a\n if b\n c\n els|"
|
|
(let ((last-command-event ?e))
|
|
(insert "e")
|
|
(run-hooks 'post-self-insert-hook))
|
|
(let ((last-command-event ?\s))
|
|
(insert " ")
|
|
(run-hooks 'post-self-insert-hook))
|
|
(test-flan-fln--is "else snaps to its if as it is typed"
|
|
(current-indentation) 2))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n b\n| c\n d\n"
|
|
(indent-region (point) (point-max))
|
|
(test-flan-fln--is "indent-region moves a block rigidly"
|
|
(buffer-substring (point) (point-max))
|
|
" c\n d\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n b\n |c\n"
|
|
(indent-region (point-min) (point-max))
|
|
(test-flan-fln--is "and leaves lines at valid columns alone"
|
|
(buffer-string) "fn f() -> ()\n if a\n b\n c\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n b\n |\n"
|
|
(kill-new "if x\n y\n else\n z")
|
|
(flan-fln-yank)
|
|
(test-flan-fln--is "a statement cut from its first character yanks as one block"
|
|
(buffer-string)
|
|
"fn f() -> ()\n if a\n b\n if x\n y\n else\n z\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n |\n"
|
|
(kill-new " while x\n y\n")
|
|
(flan-fln-yank)
|
|
(test-flan-fln--is "whole lines yank at point's column"
|
|
(buffer-string)
|
|
"fn f() -> ()\n if a\n while x\n y\n\n"))
|
|
|
|
;;; A lambda's block inside brackets
|
|
|
|
(defconst test-flan-fln--lam
|
|
"fn f(xs) -> i64
|
|
let n = 1
|
|
sort-by(xs, fn(a, b) =>
|
|
let d = a - b
|
|
d < n)
|
|
map(xs, fn(x) =>
|
|
g(x)
|
|
x
|
|
)
|
|
h(n)
|
|
")
|
|
|
|
(defun test-flan-fln--lam-at (needle fn &optional at-end)
|
|
"What FN sends with point at NEEDLE in the lambda program, or at the end of
|
|
its line with AT-END."
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam needle)
|
|
(when at-end (end-of-line))
|
|
(let ((r (test-flan-fln--sending (funcall fn))))
|
|
(and r (list (test-flan-fln--sent-code r) (plist-get r :pause))))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam "sort-by")
|
|
(test-flan-fln--is "a call with a block lambda is one statement, block and closer too"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"sort-by(xs, fn(a, b) =>\n let d = a - b\n d < n)")
|
|
(test-flan-fln--is "its body is the lambda's block, less the call's closer"
|
|
(test-flan-fln--thing 'flan-fln-body)
|
|
"let d = a - b\n d < n"))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam "d < n")
|
|
(test-flan-fln--is "a line of the block is a statement of its own, less the closer"
|
|
(test-flan-fln--thing 'flan-fln-statement) "d < n"))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam " )")
|
|
(test-flan-fln--is "a closer on a line of its own belongs to the call"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"map(xs, fn(x) =>\n g(x)\n x\n )"))
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam " x\n")
|
|
(test-flan-fln--is "and not to the statement above it"
|
|
(test-flan-fln--thing 'flan-fln-statement) "x"))
|
|
(test-flan-fln--is "C-c C-e on the header sends the call, block and all"
|
|
(car (test-flan-fln--lam-at "sort-by" #'flan-fln-eval-statement))
|
|
"sort-by(xs, fn(a, b) =>\n let d = a - b\n d < n)")
|
|
(test-flan-fln--is "and C-x C-e at the header's end"
|
|
(car (test-flan-fln--lam-at "sort-by" #'flan-fln-eval-last t))
|
|
"sort-by(xs, fn(a, b) =>\n let d = a - b\n d < n)")
|
|
(test-flan-fln--is "C-x C-e at the end of the block's last line sends its statement"
|
|
(car (test-flan-fln--lam-at "d < n" #'flan-fln-eval-last t))
|
|
"d < n")
|
|
(test-flan-fln--is "C-c C-e on a line of the block sends that statement"
|
|
(car (test-flan-fln--lam-at "g(x)" #'flan-fln-eval-statement))
|
|
"g(x)")
|
|
(dolist (c '(("let d" (4 5) "a statement in the block, where the reader starts it")
|
|
("g(x)" (7 5) "one in a block with its closer on a line of its own")
|
|
("a, b)" (3 15) "the lambda, from its fn")
|
|
("xs, fn(a" (3 3) "the call, from its name")))
|
|
(test-flan-fln--is (format "C-u C-c C-c marks %s" (nth 2 c))
|
|
(cadr (test-flan-fln--lam-at (car c) (lambda () (flan-fln-eval-defun '(4)))))
|
|
(cadr c)))
|
|
(test-flan-fln--is "TAB after a => inside brackets goes one level in"
|
|
(test-flan-fln--tabs "fn f()\n sort-by(xs, fn(a, b) =>\n|" 1) 4)
|
|
(test-flan-fln--is "and a line of the block stays in it"
|
|
(test-flan-fln--tabs "fn f()\n sort-by(xs, fn(a, b) =>\n g(a)\n| a < b)" 1) 4)
|
|
(test-flan-fln--is "under a header on a wrapped argument line, in from that line"
|
|
(test-flan-fln--tabs "f(a,\n fn(b) =>\n|" 1) 4)
|
|
(test-flan-fln--is "a closer on its own line goes to the call's column"
|
|
(test-flan-fln--tabs "fn f()\n m(xs, fn(x) =>\n x\n|)" 1) 2)
|
|
(test-flan-fln--is "after the block's brackets close, its column is no longer offered"
|
|
(list (test-flan-fln--tabs "fn f()\n app(k, fn(x) =>\n x)\n|g()" 1)
|
|
(test-flan-fln--tabs "fn f()\n app(k, fn(x) =>\n x)\n|g()" 2)
|
|
(test-flan-fln--tabs "fn f()\n app(k, fn(x) =>\n x)\n|g()" 3))
|
|
'(0 2 0))
|
|
(test-flan-fln--is "inside a bracket in the block, under its first argument"
|
|
(test-flan-fln--tabs "fn f()\n m(xs, fn(x) =>\n g(x,\n|y))" 1) 6)
|
|
(test-flan-fln--in "fn f()\n m(xs, fn(x) => x)\n"
|
|
(font-lock-ensure)
|
|
(test-flan-fln--is "=> is a keyword"
|
|
(save-excursion (goto-char (point-min)) (search-forward "=>")
|
|
(get-text-property (match-beginning 0) 'face))
|
|
'font-lock-keyword-face))
|
|
|
|
(defconst test-flan-fln--lam-arm
|
|
"fn f(n: i64) -> i64
|
|
match n
|
|
1 -> app(1, fn(a) =>
|
|
a * 2)
|
|
_ -> 0
|
|
")
|
|
(test-flan-fln--is "C-x C-e at the end of an arm whose value ends in => sends the value, block and all"
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam-arm "1 ->")
|
|
(end-of-line)
|
|
(test-flan-fln--sent-code (test-flan-fln--sending (flan-fln-eval-last))))
|
|
"app(1, fn(a) =>\n a * 2)")
|
|
(test-flan-fln--is "and C-u C-c C-c on its pattern stops at the value"
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--lam-arm "1 ->")
|
|
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause))
|
|
'(3 10))
|
|
(test-flan-fln--is "an else whose value ends in => takes the block too"
|
|
(test-flan-fln--in "fn f(c)\n if c\n g()\n |else app(1, fn(a) =>\n a)\n"
|
|
(test-flan-fln--text (flan-fln--clause-value (line-beginning-position))))
|
|
"app(1, fn(a) =>\n a)")
|
|
|
|
;;; Block editing
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n |b()\n c()\n d()\n"
|
|
(flan-fln-slurp)
|
|
(test-flan-fln--is "slurp pulls the next statement into the block"
|
|
(buffer-string) "fn f() -> ()\n if a\n b()\n c()\n d()\n")
|
|
(flan-fln-barf)
|
|
(test-flan-fln--is "barf pushes the last one out again"
|
|
(buffer-string) "fn f() -> ()\n if a\n b()\n c()\n d()\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n |a()\n if x\n y\n b()\n"
|
|
(flan-fln-move-statement-down)
|
|
(test-flan-fln--is "a statement moves down past its sibling's whole block"
|
|
(buffer-string) "fn f() -> ()\n if x\n y\n a()\n b()\n")
|
|
(test-flan--check "and point moves with it" (looking-at "a()"))
|
|
(flan-fln-move-statement-up)
|
|
(test-flan-fln--is "and back up"
|
|
(buffer-string) "fn f() -> ()\n a()\n if x\n y\n b()\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n when(c):\n if x\n |y\n"
|
|
(flan-fln-raise-statement)
|
|
(test-flan-fln--is "raise replaces the owner with the statement"
|
|
(buffer-string) "fn f() -> ()\n when(c):\n y\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n |if x\n y\n else\n z\n b()\n"
|
|
(flan-fln-kill-statement)
|
|
(test-flan-fln--is "kill takes the whole statement's lines"
|
|
(buffer-string) "fn f() -> ()\n b()\n")
|
|
(test-flan-fln--is "into the kill ring" (current-kill 0)
|
|
" if x\n y\n else\n z\n"))
|
|
|
|
;;; expand-region, where it is installed
|
|
|
|
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/expand-region-[0-9]*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/expand-region-[0-9]*")))
|
|
(load-path (append dirs load-path)))
|
|
(if (not (require 'expand-region nil t))
|
|
(message " skip expand-region (not installed)")
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "is-right\n -1")
|
|
(transient-mark-mode 1)
|
|
(let ((steps nil))
|
|
(dotimes (_ 6)
|
|
(er/expand-region 1)
|
|
(push (buffer-substring-no-properties (region-beginning) (region-end)) steps))
|
|
(setq steps (nreverse steps))
|
|
(test-flan-fln--is "term, then statement's clause, then statement, then out"
|
|
(mapcar (lambda (s) (car (split-string s "\n"))) steps)
|
|
'("is-right" "elif not is-right" "if not is-left" "let side ="
|
|
"if is-left or is-right" "let is-left = col > 0"))))))
|
|
|
|
;;; smartparens, where it is installed
|
|
|
|
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/smartparens-[0-9]*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/smartparens-[0-9]*")
|
|
(file-expand-wildcards "~/.config/emacs/elpa/dash-[0-9]*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/dash-[0-9]*")))
|
|
(load-path (append dirs load-path)))
|
|
(if (not (require 'smartparens nil t))
|
|
(message " skip smartparens (not installed)")
|
|
;; A setup that puts sexp commands on the top-level keys, as the
|
|
;; author's does.
|
|
(define-key smartparens-mode-map (kbd "C-M-a") 'sp-backward-down-sexp)
|
|
(define-key smartparens-mode-map (kbd "C-M-u") 'sp-backward-up-sexp)
|
|
(let ((b (generate-new-buffer "sp.fln")))
|
|
(switch-to-buffer b)
|
|
(flan-fln-mode)
|
|
(test-flan--check "smartparens is on in a .fln buffer" smartparens-mode)
|
|
(test-flan--check "and C-M-a and C-M-u stay the mode's"
|
|
(and (eq (key-binding (kbd "C-M-a")) 'beginning-of-defun)
|
|
(eq (key-binding (kbd "C-M-u")) 'flan-fln-up)))
|
|
(execute-kbd-macro "f(")
|
|
(test-flan-fln--is "it pairs a bracket" (buffer-string) "f()")
|
|
(erase-buffer)
|
|
(execute-kbd-macro "'a")
|
|
(test-flan-fln--is "and not a quote" (buffer-string) "'a")
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer b))
|
|
(define-key smartparens-mode-map (kbd "C-M-a") nil)
|
|
(define-key smartparens-mode-map (kbd "C-M-u") nil)))
|
|
|
|
;;; Under Evil
|
|
|
|
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/evil-[0-9]*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/evil-[0-9]*")
|
|
(file-expand-wildcards "~/.config/emacs/elpa/goto-chg-*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/goto-chg-*")))
|
|
(load-path (append dirs load-path)))
|
|
(if (not (require 'evil nil t))
|
|
(message " skip the .fln text objects (Evil is not installed)")
|
|
(evil-mode 1)
|
|
(unwind-protect
|
|
(let ((yanked
|
|
(lambda (text keys)
|
|
(let ((b (generate-new-buffer "objects.fln")))
|
|
(switch-to-buffer b)
|
|
(insert text)
|
|
(flan-fln-mode)
|
|
(evil-initialize-state)
|
|
(evil-normal-state)
|
|
(goto-char (point-min))
|
|
(search-forward "|")
|
|
(delete-char -1)
|
|
(execute-kbd-macro keys)
|
|
(prog1 (substring-no-properties (current-kill 0))
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer b))))))
|
|
(dolist (c `(("yiw" ,(test-flan-fln--at test-flan-fln--settle "settle(")
|
|
"settle")
|
|
("yie" ,(test-flan-fln--at test-flan-fln--settle "i32(m.x)")
|
|
"i32(m.x)")
|
|
("yis" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
|
"if r >= 0 and r < rows - 1\n and c >= 0\n grid[r, c] = 1")
|
|
("yas" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
|
" if r >= 0 and r < rows - 1\n and c >= 0\n grid[r, c] = 1\n")
|
|
("yii" ,(test-flan-fln--at test-flan-fln--settle "if not is-left")
|
|
" 1\n")
|
|
("yik" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
|
" if f32(rand()) < 0.5 then 1 else -1\n")
|
|
("yak" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
|
" else\n if f32(rand()) < 0.5 then 1 else -1\n")
|
|
("yik" ,(test-flan-fln--at test-flan-fln--wrapped "Some(_)")
|
|
"5")
|
|
("yak" ,(test-flan-fln--at test-flan-fln--wrapped "Some(_)")
|
|
" Some(_) -> 5\n")
|
|
("yik" ,(test-flan-fln--at test-flan-fln--oneline "else 1")
|
|
"1")
|
|
("yik" ,(test-flan-fln--at test-flan-fln--oneline "elif n")
|
|
"0")
|
|
("yik" ,(test-flan-fln--at test-flan-fln--oneline "else 2")
|
|
"2")
|
|
("yid" ,(test-flan-fln--at test-flan-fln--settle "paint-at")
|
|
,(substring test-flan-fln--settle
|
|
(string-search "fn step" test-flan-fln--settle)))))
|
|
(test-flan-fln--is (format "under Evil, %s" (car c))
|
|
(funcall yanked (nth 1 c) (car c)) (nth 2 c)))
|
|
(let ((deleted
|
|
(lambda (keys needle)
|
|
(let ((b (generate-new-buffer "delete.fln")))
|
|
(switch-to-buffer b)
|
|
(insert "fn f(x: i64) -> i64\n if x > 0\n a\n else\n 3\n x\n\nfn g() -> i32 = 1\n")
|
|
(flan-fln-mode)
|
|
(evil-initialize-state)
|
|
(evil-normal-state)
|
|
(goto-char (point-min))
|
|
(search-forward needle)
|
|
(goto-char (match-beginning 0))
|
|
(execute-kbd-macro keys)
|
|
(prog1 (buffer-string)
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer b))))))
|
|
(dolist (c '(("dak" "else"
|
|
"fn f(x: i64) -> i64\n if x > 0\n a\n x\n\nfn g() -> i32 = 1\n")
|
|
("das" "else"
|
|
"fn f(x: i64) -> i64\n x\n\nfn g() -> i32 = 1\n")
|
|
("dii" "if x"
|
|
"fn f(x: i64) -> i64\n if x > 0\n else\n 3\n x\n\nfn g() -> i32 = 1\n")
|
|
("dad" "else" "fn g() -> i32 = 1\n")
|
|
("dad" "fn g" "fn f(x: i64) -> i64\n if x > 0\n a\n else\n 3\n x\n")))
|
|
(test-flan-fln--is (format "under Evil, %s leaves no blank line" (car c))
|
|
(funcall deleted (car c) (nth 1 c)) (nth 2 c))))
|
|
;; Comments: a block directly on a form is the form's; one a
|
|
;; blank line away, or below it, is not.
|
|
(let ((deleted
|
|
(lambda (keys needle)
|
|
(let ((b (generate-new-buffer "comments.fln")))
|
|
(switch-to-buffer b)
|
|
(insert "; loose\n\n; on f\nfn f() -> ()\n a()\n; after f\n\n"
|
|
"; on g\nfn g() -> ()\n ; on b\n b()\n")
|
|
(flan-fln-mode)
|
|
(evil-initialize-state)
|
|
(evil-normal-state)
|
|
(goto-char (point-min))
|
|
(search-forward needle)
|
|
(goto-char (match-beginning 0))
|
|
(execute-kbd-macro keys)
|
|
(prog1 (buffer-string)
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer b))))))
|
|
(dolist (c '(("dad" "a()"
|
|
"; loose\n\n; after f\n\n; on g\nfn g() -> ()\n ; on b\n b()\n")
|
|
("dad" "b()"
|
|
"; loose\n\n; on f\nfn f() -> ()\n a()\n; after f\n")
|
|
("did" "on g"
|
|
"; loose\n\n; on f\nfn f() -> ()\n a()\n; after f\n\n")
|
|
("das" "b()"
|
|
"; loose\n\n; on f\nfn f() -> ()\n a()\n; after f\n\n; on g\nfn g() -> ()\n")))
|
|
(test-flan-fln--is (format "under Evil, %s on %s keeps comments with their forms"
|
|
(car c) (nth 1 c))
|
|
(funcall deleted (car c) (nth 1 c)) (nth 2 c)))
|
|
;; A lone comment belongs to no form: id and ad find nothing.
|
|
(dolist (text '("fn a() -> i64\n 1\n\n; lone\n\nfn b() -> i64\n 2\n"
|
|
"fn a() -> i64\n 1\n\n; lone\n"))
|
|
(dolist (keys '("did" "dad"))
|
|
(let ((b (generate-new-buffer "lone.fln")))
|
|
(switch-to-buffer b)
|
|
(insert text)
|
|
(flan-fln-mode)
|
|
(evil-initialize-state)
|
|
(evil-normal-state)
|
|
(goto-char (point-min))
|
|
(search-forward "; lone")
|
|
(goto-char (match-beginning 0))
|
|
(ignore-errors (execute-kbd-macro keys))
|
|
(test-flan-fln--is (format "under Evil, %s on a lone comment%s changes nothing"
|
|
keys (if (string-suffix-p "lone\n" text) " at the end" ""))
|
|
(buffer-string) text)
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer b))))
|
|
;; A comment deeper than a form, at the end of its block, is
|
|
;; that block's, not the next form's.
|
|
(dolist (c '(("dad" "fn a" "fn a() -> i64\n 1\n ; end of a\nfn b() -> i64\n 2\n"
|
|
"fn b() -> i64\n 2\n")
|
|
("dad" "fn b" "fn a() -> i64\n 1\n ; end of a\nfn b() -> i64\n 2\n"
|
|
"fn a() -> i64\n 1\n ; end of a\n")
|
|
("das" "let y"
|
|
"fn a(x: i64) -> i64\n if x > 0\n 1\n ; end of the if\n let y = 2\n y\n"
|
|
"fn a(x: i64) -> i64\n if x > 0\n 1\n ; end of the if\n y\n")))
|
|
(let ((b (generate-new-buffer "owned.fln")))
|
|
(switch-to-buffer b)
|
|
(insert (nth 2 c))
|
|
(flan-fln-mode)
|
|
(evil-initialize-state)
|
|
(evil-normal-state)
|
|
(goto-char (point-min))
|
|
(search-forward (nth 1 c))
|
|
(goto-char (match-beginning 0))
|
|
(execute-kbd-macro (car c))
|
|
(test-flan-fln--is (format "under Evil, %s on %s: a deeper comment stays with the block above"
|
|
(car c) (nth 1 c))
|
|
(buffer-string) (nth 3 c))
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer b))))
|
|
(let ((b (generate-new-buffer "keys.fln")))
|
|
(switch-to-buffer b)
|
|
(insert "fn f() -> i32 = 1\n")
|
|
(flan-fln-mode)
|
|
(evil-initialize-state)
|
|
(test-flan--check "under Evil, C-x C-e is still the mode's"
|
|
(eq (key-binding (kbd "C-x C-e")) 'flan-fln-eval-last))
|
|
(goto-char (point-min))
|
|
(end-of-line)
|
|
(backward-char)
|
|
(test-flan--check "under Evil, C-x C-e counts the cursor's character"
|
|
(= (flan-fln--point-for-last) (line-end-position)))
|
|
(kill-buffer b)))
|
|
(evil-mode -1))))
|
|
|
|
;;; test-flan-fln.el ends here
|