JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A call through a failed local is not reported and a miscounted call's arguments are, eval-in-frame answers slotless frames and ended stops, flan dev links its own agent, and the daemon buffer colours only file:line:col diagnostics

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-25 16:47:46 +07:00
parent f32f88413e
commit 37938db7c2
9 changed files with 284 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
TODO.org
View File

@ -2015,6 +2015,11 @@ because =locals= and the inspector are asked by it. The innermost frame is
shown even when it is the prelude's, unless the stop is =(pause)=, because it
is where the program stopped. Rules out renumbering the visible frames.
** DONE C-c C-c reports one error, not every error in the form
CLOSED: [2026-09-25]
Every error at any depth: a refused subexpression stands as a Never that fits
any want, and what it causes is left unsaid. Rules out stopping at a statement boundary.
** DONE There is no stepper
CLOSED: [2026-09-25]
C-c C-s instruments a defn with a step point before each body form; no step

1
emacs/MANUAL.md
View File

@ -1195,6 +1195,7 @@ Use `C-c C-g` if you need frames.
| `C-u C-c C-c` | ...and stop at the form point is inside (`C-u C-u`: on entry) |
| `C-M-x` | the same as `C-c C-c`, on the binding SLIME and CIDER use |
| `C-c C-k` | load the whole buffer, as one module; what does not compile is listed |
| `C-c C-s` | install the defn at point to stop before each form of its body |
| `C-x C-e` | the form before point, evaluated — or installed, if it is a declaration |
| `C-u C-x C-e` | ...and stop at it instead of showing its value |
| `C-c C-z` | connect (finds `.flan-dev.sock` upward) |

9
emacs/flan.el
View File

@ -428,6 +428,15 @@ is switched on here, first, or the rules would never be drawn."
(font-lock-mode 1)
;; A log, not source: a quote the program printed opens no string.
(setq-local font-lock-keywords-only t)
;; Only the compiler's own shape, `file:line:col:', is a diagnostic here.
;; compile.el's other rules are for a build log: one of them draws any
;; line starting `word:' as a program name, which is every `score: 10'
;; the program prints.
(setq-local compilation-mode-font-lock-keywords nil)
(setq-local compilation-error-regexp-alist
'(("^\\([^ \t\n:][^\t\n:]*\\):\\([0-9]+\\):\\([0-9]+\\): \
\\(?:\\(warning\\)\\|\\(note\\|info\\)\\)?"
1 2 3 (4 . 5))))
(compilation-minor-mode 1)
(flan--navigable-notes))

24
emacs/test-flan-cider.el
View File

@ -1540,6 +1540,30 @@ would be overwritten. Look again and re-do the edit")
(and (eq (lookup-key flan-cnr-mode-map "s") #'flan-cnr-step)
(eq (lookup-key flan-cnr-mode-map "c") #'flan-cnr-continue))))
;; Every key flan-mode binds has a row in the manual's key reference.
(let ((text (with-temp-buffer
(insert-file-contents
(expand-file-name "MANUAL.md"
(file-name-directory (locate-library "flan-mode"))))
(buffer-string)))
(missing nil))
(map-keymap
(lambda (k d)
(when (and (eq k ?\C-c) (keymapp d))
(map-keymap
(lambda (k2 d2)
(when (commandp d2)
(let ((desc (replace-regexp-in-string
"RET" "C-m"
(replace-regexp-in-string
"TAB" "C-i" (key-description (vector k k2))))))
(unless (string-match-p (regexp-quote (format "| `%s` |" desc)) text)
(push desc missing)))))
d)))
flan-mode-map)
(test-flan--check (format "every C-c key has a row in the manual (missing %s)" missing)
(null missing)))
;; C-c C-s sends the defn at point for stepping and marks it.
(let ((sent nil))
(with-temp-buffer

8
emacs/test-flan.el
View File

@ -545,7 +545,7 @@ already rely on it — so nothing here is a stand-in for the real thing."
"/tmp/a.flan:3:1: warning: w\n"
"/tmp/a.flan:4:1: note: n\n")
(flan--daemon-buffer-setup)
(flan--append-output "said hi\n")
(flan--append-output "said hi\nscore: 10\n")
(font-lock-ensure)
(let ((face-on (lambda (text)
(goto-char (point-min))
@ -559,6 +559,12 @@ already rely on it — so nothing here is a stand-in for the real thing."
(test-flan--check
"the program's output takes its own face"
(eq (funcall face-on "said") 'flan-output-face))
(test-flan--check
"a line of output shaped `word:' is not drawn as a program name"
(progn (goto-char (point-min)) (search-forward "score")
(and (null (get-text-property (match-beginning 0) 'face))
(eq (get-text-property (match-beginning 0) 'font-lock-face)
'flan-output-face))))
(test-flan--check
"the daemon's own line is left plain"
(null (funcall face-on "flan dev:")))))

36
lib/check.ml
View File

@ -4252,7 +4252,17 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
if is_poison r then env.poison <- env.poison + 1;
r
| exception Loc.Error d ->
if not (caused ()) then record_recovered env d;
if not (caused ()) then begin
record_recovered env d;
(* A call refused as a whole — the wrong number of arguments, say —
never checked its arguments, and a mistake inside one is still a
mistake. They are checked on their own, with no expectation, so
only what no expectation could change is kept: a name that is not
there. *)
match e.Ast.e with
| Ast.Call (_, args) -> recheck_args ctx args
| _ -> ()
end;
env.poison <- env.poison + 1;
poison e.Ast.loc
(* A checker arm that was never written for a [Never] operand may fail
@ -4263,6 +4273,20 @@ let rec check ctx ?want (e : Ast.expr) : Tast.expr =
poison e.Ast.loc
end
and recheck_args ctx (args : Ast.expr list) =
let env = ctx.env in
let before = env.recovered in
List.iter (fun a -> ignore (check ctx a)) args;
let rec fresh l = if l == before then [] else match l with [] -> [] | d :: r -> d :: fresh r in
let kept =
List.filter
(fun (d : Loc.diag) ->
String.starts_with ~prefix:"check/unknown-" d.Loc.kind
|| String.equal d.Loc.kind "check/private")
(fresh env.recovered)
in
env.recovered <- kept @ before
and check_plain ctx ?want (e : Ast.expr) : Tast.expr =
let place = ctx.place_ok in
ctx.place_ok <- false;
@ -10861,6 +10885,16 @@ and ordinary_call ctx ~want loc name args =
lifted body captures it by value and then calls the copy. [peek_outer]
rather than [capture] in the guard, because a guard must not take a copy
on its way to deciding what a form means. *)
(* A local bound to a refused initialiser's stand-in, called: the refusal
is already reported, so the call stands in too, its arguments still
checked. *)
| _ when ctx.env.recovering
&& (match lookup ctx name with
| Some b -> Types.equal b.bty Types.Never
| None -> false) ->
List.iter (fun a -> ignore (check ctx a)) args;
ctx.env.poison <- ctx.env.poison + 1;
poison loc
| _ when (match lookup ctx name with
| Some b -> callable_ty b.bty
| None ->

57
lib/dev.ml
View File

@ -1246,6 +1246,18 @@ let eval_expr_at t ~code ~origin ~pause ~at =
TODO.org, "Whose break it is, which no counter answers" has it. *)
let entered = state t in
let entered_gen = stop_gen t in
(* In a frame the thunk is addressed to one stop, and the agent drops it,
and counts the drop, if that stop has ended by the time it is
claimed. Read before the build, which is when that usually happens. *)
let refused_before = if at = None then None else refusals t in
let dropped () =
match refused_before with
| None -> None
| Some (before, _) ->
(match refusals t with
| Some (now, why) when now > before -> Some why
| _ -> None)
in
t.n <- t.n + 1;
let out = Filename.concat t.dir (Printf.sprintf "e%d.so" t.n) in
(* A generic called at a new type makes a copy that is defined in this
@ -1417,6 +1429,9 @@ let eval_expr_at t ~code ~origin ~pause ~at =
| Some answer ->
(match value () with Some v -> `Value v | None -> answer)
| None ->
match dropped () with
| Some why -> `Dropped why
| None ->
if ms <= 0 then `Timeout
else begin
ignore (Unix.select [] [] [] 0.005);
@ -1481,6 +1496,7 @@ let eval_expr_at t ~code ~origin ~pause ~at =
left over, which is the shape it was always about: a program
that is running, is not parked, and produced nothing in five
seconds. *)
| `Dropped why -> error why
| `Timeout ->
if liveness t = Parked then
error
@ -2425,7 +2441,7 @@ let stopped_frame t ~frame ~what : (string * Tast.fn, string) result =
that stopped frame's locals — see [Session.in_frame]. The frame is checked
the way [locals] and [inspect] check it, and the thunk is delivered at this
stop only. *)
let eval_expr ?frame t ~code ~origin ~pause =
let eval_expr ?frame ?at_stop t ~code ~origin ~pause =
match frame with
| None -> eval_expr_at t ~code ~origin ~pause ~at:None
| Some index ->
@ -2438,7 +2454,17 @@ let eval_expr ?frame t ~code ~origin ~pause =
"the program resumed while this was being asked; there is no frame \
to evaluate in any more"
| Some gen ->
(match bound_slots t ~frame:index with
(* A frame with no slots has no locals to bind, and the program
has no table to answer for it: the expression sees globals. *)
let bound =
if Array.length fn.Tast.slots = 0 then Ok []
else bound_slots t ~frame:index
in
(* [at_stop] is the stop the editor drew the frame at. It is not
checked here: the agent refuses a thunk addressed to a stop that
is over, and says so. *)
let gen = Option.value ~default:gen at_stop in
(match bound with
| Error m ->
error ("the program refused to say which slots are bound: " ^ m)
| Ok bound ->
@ -4444,7 +4470,8 @@ and handle_op t req =
| Some { Form.v = Form.Sym "nil"; _ } | None -> false
| Some _ -> true
in
eval_expr ?frame:(Wire.int_field req "frame") t ~code ~origin ~pause
eval_expr ?frame:(Wire.int_field req "frame")
?at_stop:(Wire.int_field req "at-stop") t ~code ~origin ~pause
| None -> error "eval-expr needs :code")
(* [:all], absent or [nil] being false and anything else true — the spelling
[:pause], [:on] and [:reset] already use. One step is the default because
@ -5229,19 +5256,21 @@ let need_main ~file (session : Session.t) =
(* The agent's C, in every program [flan dev] builds, whether or not the source
imports the package: its constructor binds the socket before [main], so a
file that never mentions the agent can still be reached from the editor. A
program that imports it already has it, and is left alone — two copies
would collide at the link. A release build is not built here and is not
affected. *)
file that never mentions the agent can still be reached from the editor.
Always this compiler's own copy, in place of any the program vendors. The
agent is the daemon's other half — the stack it snapshots and the verbs it
answers are what this file reads — and a program outside this repository
carries whatever copy of vendor/agent it was given, however old. An old one
builds and answers, and then puts every frame at its function's own line,
because it predates the call-site record, so the stepper never moves. One
copy and not two: two would collide at the link. A release build is not
built here. *)
let with_agent ~dir csrcs lflags =
let c = Filename.concat dir "flan_agent.c" in
write_file c Runtime_src.agent_source;
let csrcs =
if List.exists (fun c -> Filename.basename c = "flan_agent.c") csrcs then
csrcs
else begin
let c = Filename.concat dir "flan_agent.c" in
write_file c Runtime_src.agent_source;
csrcs @ [ c ]
end
List.filter (fun x -> Filename.basename x <> "flan_agent.c") csrcs @ [ c ]
in
let lflags =
lflags

275
test/test_dev.ml
View File

@ -127,6 +127,111 @@ let status r =
let contains_sub = Test_support.contains
(* The stepper, against a running program whose [step] is dev-pause.flan's
and dev-repl.flan's: sent with [:step t], a call stops before each form of
its body — the (set ...), then after [next] the [ticks] it answers.
[continue] runs the rest of the call and the next call steps again, and a
plain evaluation takes it out. Run in a daemon of each backend that another
block already started, so it costs no build of its own. *)
let stepper_checks ~what ask =
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
let body = "(defn step [] i64 (set ticks (+ ticks 1)) ticks)" in
let col sub =
let n = String.length sub in
let rec find i =
if String.equal (String.sub body i n) sub then i + 1 else find (i + 1)
in
find 0
in
(* Where the stepped frame is: the frame of [step], whose location is
the step point's, which is the form about to run. *)
let at () =
match Wire.field (ask "(:op \"backtrace\")") "frames" with
| Some { Form.v = Form.List l; _ } ->
List.find_map
(fun (f : Form.t) ->
match f.Form.v with
| Form.List ({ Form.v = Form.Str "step"; _ }
:: { Form.v = Form.Str loc; _ } :: _) -> Some loc
| _ -> None)
l
| _ -> None
in
let stops_at sub =
let want = Printf.sprintf ":1:%d" (col sub) in
await (fun () ->
stopped (ask "(:op \"describe\")")
&& (match at () with Some l -> contains_sub l want | None -> false))
in
let r =
ask
(Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/step.flan\" :step t)"
(Wire.quote body))
in
if status r <> "ok" then
fail "%sinstrumenting for the stepper: %s" what
(Option.value ~default:"" (Wire.string_field r "message"))
else begin
if Wire.field r "step" = None then
fail "%san instrumented defn did not echo :step" what;
if not (stops_at "(set ticks") then
fail "%sthe stepper did not stop before the first form (at %s)" what
(Option.value ~default:"<none>" (at ()))
else begin
(match Wire.string_field (ask "(:op \"describe\")") "condition" with
| Some "StepPoint" -> ()
| c -> fail "%sa step stopped on %s" what (Option.value ~default:"<none>" c));
(* The stepper's own local is not one of the frame's. *)
let fr = ask "(:op \"locals\" :frame 1)" in
(match Wire.string_field fr "frame" with
| Some "step" ->
(match Wire.field fr "locals" with
| Some { Form.v = Form.List []; _ } | None -> ()
| _ -> fail "%sthe stepper's flag is listed as a local" what)
| f -> fail "%sframe 1 at a step is %s" what (Option.value ~default:"<none>" f));
let r = ask "(:op \"restart\" :name \"next\")" in
if status r <> "ok" then
fail "%snext at a step: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
if not (stops_at "ticks)") then
fail "%snext did not stop before the second form (at %s)" what
(Option.value ~default:"<none>" (at ()));
let r = ask "(:op \"restart\" :name \"continue\")" in
if status r <> "ok" then
fail "%scontinue at a step: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
(* The next call, 5ms on, steps again from the top. *)
if not (stops_at "(set ticks") then
fail "%sthe next call did not step again" what;
let r =
ask
(Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/step.flan\")"
(Wire.quote body))
in
if status r <> "ok" then
fail "%sinstalling the plain defn: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
ignore (ask "(:op \"restart\" :name \"continue\")");
if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then
fail "%sthe program did not resume from the last step" what;
let deadline = Unix.gettimeofday () +. 0.5 in
let rec run_on () =
if Unix.gettimeofday () > deadline then ()
else if stopped (ask "(:op \"describe\")") then
fail "%sthe plain defn still steps" what
else begin
ignore (Unix.select [] [] [] 0.01);
run_on ()
end
in
run_on ()
end
end
(* Eval-in-frame against dev-locals.flan's [look], stopped at its (error ...):
the expression sees that frame's locals, the inner of two [label]s wins, a
[set] writes the frame's own storage, and a local not bound yet is refused
@ -168,9 +273,19 @@ let eval_in_frame_checks ~backend ask =
| Error m when contains_sub m "after is not bound yet" -> ()
| Error m -> fail "%s eval-in-frame of an unbound local said %s" backend m
| Ok v -> fail "%s eval-in-frame read an unbound local as %s" backend v);
match value "(+ n \"x\")" with
| Error _ -> ()
| Ok v -> fail "%s eval-in-frame accepted a type error: %s" backend v
(match value "(+ n \"x\")" with
| Error _ -> ()
| Ok v -> fail "%s eval-in-frame accepted a type error: %s" backend v);
(* Addressed to a stop that is over: the agent drops it, and the reply says
why at once rather than timing out. *)
let t0 = Unix.gettimeofday () in
let r = ask "(:op \"eval-expr\" :frame 0 :at-stop 999999 :code \"n\")" in
let m = Option.value ~default:"" (Wire.string_field r "message") in
if status r = "ok" then fail "%s eval-in-frame ran at a stop that is over" backend
else if not (contains_sub m "resumed" || contains_sub m "stopped again") then
fail "%s eval-in-frame at a stop that is over said %s" backend m
else if Unix.gettimeofday () -. t0 > 4.0 then
fail "%s eval-in-frame at a stop that is over waited out the clock" backend
(* ── The one verb whose reply races the process it ends ─────────────── *)
@ -239,7 +354,21 @@ let () =
explain and is quoted as it stands. *)
let other = Dev.refusal ~parked:true "err flan.abi.x86: the module is x86" in
if not (contains_sub other "flan.abi.x86") then
fail "a parked program's other refusals were rewritten too: %S" other
fail "a parked program's other refusals were rewritten too: %S" other;
(* The agent is always this compiler's, never the copy a program vendors:
an old copy answers every frame at its function's own line. *)
let dir = tmp "agent-dir" in
(try Unix.mkdir dir 0o700 with Unix.Unix_error _ -> ());
let csrcs, _ =
Dev.with_agent ~dir [ "/far/vendor/agent/flan_agent.c"; "/far/x.c" ] []
in
let own = Filename.concat dir "flan_agent.c" in
if csrcs <> [ "/far/x.c"; own ] then
fail "a vendored agent was linked in place of the compiler's: %s"
(String.concat " " csrcs)
else if In_channel.with_open_bin own In_channel.input_all
<> Runtime_src.agent_source then
fail "the agent linked is not the compiler's own"
(* A daemon's death is reported by the signal's name. [WSIGNALED] carries
OCaml's own numbering, in which SIGTERM is -11, and a SIGTERM printed as
@ -4418,6 +4547,7 @@ let () =
end
else begin
let c = connect sigsock in
stepper_checks ~what:"llvm " (request c);
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
@ -4882,6 +5012,13 @@ let () =
if not (List.exists (String.equal "continue") names) then
fail "a break at (pause) offers %s, wanted continue among them"
(String.concat ", " names);
(* [step] has no slots at all, so there is nothing to bind and no
table for the program to answer from: an expression evaluated
in its frame sees the globals. Frame 0 is [pause]'s own. *)
(let r = ask "(:op \"eval-expr\" :frame 1 :code \"(+ ticks 0)\")" in
if status r <> "ok" then
fail "eval-in-frame of a frame with no slots: %s"
(Option.value ~default:(status r) (Wire.string_field r "message")));
(* The second claim, and the one this block exists for. A plain
re-evaluation of the same form replaces the stored declaration
@ -4927,6 +5064,7 @@ let () =
end
end
end;
stepper_checks ~what:"x86 " ask;
(* The other way a thunk reaches a [(pause)], and the one no flag asks
for: an ordinary [C-x C-e] over an expression that calls a body
@ -8799,135 +8937,6 @@ let () =
hook_block ~llvm:false;
hook_block ~llvm:true;
(* ── The stepper ─────────────────────────────────────────────────
[dev-pause.flan] calls [step] every 5ms. Sent with [:step t], a call
stops before each form of its body: first the (set ...), then, after
[next], the [ticks] it answers. [continue] runs the rest of the call,
and the next call steps again. A plain evaluation takes it out. Under
both backends, each with its own daemon. *)
let stepper ~llvm =
let what = if llvm then "llvm " else "x86 " in
let ssock = tmp (what ^ "step.sock") and sout = tmp (what ^ "step.out") in
(try Sys.remove ssock with Sys_error _ -> ());
let sfd = Unix.openfile sout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let spid =
Unix.create_process flan
(Array.append
[| flan; "dev"; "programs/dev-pause.flan"; "-s"; ssock |]
(if llvm then [| "--llvm" |] else [||]))
Unix.stdin sfd Unix.stderr
in
Unix.close sfd;
if not (listening ~pid:spid ssock) then
fail "%sstepper daemon %s" what !listen_why
else begin
let c = connect ssock in
let ask = request c in
let stopped r =
match Wire.field r "stopped" with
| Some { Form.v = Form.Sym "t"; _ } -> true
| _ -> false
in
let body = "(defn step [] i64 (set ticks (+ ticks 1)) ticks)" in
let col sub =
let n = String.length sub in
let rec find i =
if String.equal (String.sub body i n) sub then i + 1 else find (i + 1)
in
find 0
in
(* Where the stepped frame is: the frame of [step], whose location is
the step point's, which is the form about to run. *)
let at () =
match Wire.field (ask "(:op \"backtrace\")") "frames" with
| Some { Form.v = Form.List l; _ } ->
List.find_map
(fun (f : Form.t) ->
match f.Form.v with
| Form.List ({ Form.v = Form.Str "step"; _ }
:: { Form.v = Form.Str loc; _ } :: _) -> Some loc
| _ -> None)
l
| _ -> None
in
let stops_at sub =
let want = Printf.sprintf ":1:%d" (col sub) in
await (fun () ->
stopped (ask "(:op \"describe\")")
&& (match at () with Some l -> contains_sub l want | None -> false))
in
let r =
ask
(Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/step.flan\" :step t)"
(Wire.quote body))
in
if status r <> "ok" then
fail "%sinstrumenting for the stepper: %s" what
(Option.value ~default:"" (Wire.string_field r "message"))
else begin
if Wire.field r "step" = None then
fail "%san instrumented defn did not echo :step" what;
if not (stops_at "(set ticks") then
fail "%sthe stepper did not stop before the first form (at %s)" what
(Option.value ~default:"<none>" (at ()))
else begin
(match Wire.string_field (ask "(:op \"describe\")") "condition" with
| Some "StepPoint" -> ()
| c -> fail "%sa step stopped on %s" what (Option.value ~default:"<none>" c));
(* The stepper's own local is not one of the frame's. *)
let fr = ask "(:op \"locals\" :frame 1)" in
(match Wire.string_field fr "frame" with
| Some "step" ->
(match Wire.field fr "locals" with
| Some { Form.v = Form.List []; _ } | None -> ()
| _ -> fail "%sthe stepper's flag is listed as a local" what)
| f -> fail "%sframe 1 at a step is %s" what (Option.value ~default:"<none>" f));
let r = ask "(:op \"restart\" :name \"next\")" in
if status r <> "ok" then
fail "%snext at a step: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
if not (stops_at "ticks)") then
fail "%snext did not stop before the second form (at %s)" what
(Option.value ~default:"<none>" (at ()));
let r = ask "(:op \"restart\" :name \"continue\")" in
if status r <> "ok" then
fail "%scontinue at a step: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
(* The next call, 5ms on, steps again from the top. *)
if not (stops_at "(set ticks") then
fail "%sthe next call did not step again" what;
let r =
ask
(Printf.sprintf "(:op \"eval\" :code %s :file \"/tmp/step.flan\")"
(Wire.quote body))
in
if status r <> "ok" then
fail "%sinstalling the plain defn: %s" what
(Option.value ~default:"" (Wire.string_field r "message"));
ignore (ask "(:op \"restart\" :name \"continue\")");
if not (await (fun () -> not (stopped (ask "(:op \"describe\")")))) then
fail "%sthe program did not resume from the last step" what;
let deadline = Unix.gettimeofday () +. 0.5 in
let rec run_on () =
if Unix.gettimeofday () > deadline then ()
else if stopped (ask "(:op \"describe\")") then
fail "%sthe plain defn still steps" what
else begin
ignore (Unix.select [] [] [] 0.01);
run_on ()
end
in
run_on ()
end
end;
(try Unix.close c with Unix.Unix_error _ -> ())
end;
(try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] spid) with Unix.Unix_error _ -> ());
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ ssock; sout ]
in
stepper ~llvm:false;
stepper ~llvm:true;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ sock; out; bsock; bout ];

18
test/test_session.ml
View File

@ -1795,6 +1795,24 @@ let () =
in
if List.length caused <> 1 || not (has (msgs caused) "nope") then
fail "a failure's consequences were reported: %s" (msgs caused);
(* A local bound to a refused initialiser and then called is the same
consequence: no "unknown function p". *)
let called = errors "(defn called [] i64 (let [p (nope 1)] (p 3)))" in
if List.length called <> 1 then
fail "calling a local bound to a failure was reported: %s" (msgs called);
(* A call refused for its argument count still has its arguments checked. *)
let arity =
errors "(defn arity [] i64 (bump (nope2) 7 8))"
in
if List.length arity <> 2 || not (has (msgs arity) "nope2") then
fail "an error inside a miscounted call was not reported: %s" (msgs arity);
(* And the whole-file path: fn-no-type.flan has one mistake, reported once. *)
(match Front.checked ~all:true "programs/fn-no-type.flan" with
| _ -> fail "fn-no-type.flan checked"
| exception Loc.Error _ -> ()
| exception Loc.Errors ds ->
if List.length ds <> 1 then
fail "fn-no-type.flan gave %d errors: %s" (List.length ds) (msgs ds));
(* One error is the [Loc.Error] every caller of one form expects. *)
let t, _ = Session.create ~file:"programs/reload.flan" () in
(match Session.eval t "(defn one [] i64 (nope 1))" with