diff --git a/TODO.org b/TODO.org index de91143d..4cc97b73 100644 --- a/TODO.org +++ b/TODO.org @@ -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 diff --git a/emacs/MANUAL.md b/emacs/MANUAL.md index 0cc330e0..be05ee23 100644 --- a/emacs/MANUAL.md +++ b/emacs/MANUAL.md @@ -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) | diff --git a/emacs/flan.el b/emacs/flan.el index 3fbcdd24..ad175078 100644 --- a/emacs/flan.el +++ b/emacs/flan.el @@ -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)) diff --git a/emacs/test-flan-cider.el b/emacs/test-flan-cider.el index 31407150..16f65fc8 100644 --- a/emacs/test-flan-cider.el +++ b/emacs/test-flan-cider.el @@ -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 diff --git a/emacs/test-flan.el b/emacs/test-flan.el index 5fa5cd5d..952cb01f 100644 --- a/emacs/test-flan.el +++ b/emacs/test-flan.el @@ -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:"))))) diff --git a/lib/check.ml b/lib/check.ml index e75979b1..d601138c 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -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 -> diff --git a/lib/dev.ml b/lib/dev.ml index 1570302c..c71660f7 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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 diff --git a/test/test_dev.ml b/test/test_dev.ml index ba666e10..1dada954 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -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:"" (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:"" 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:"" 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:"" (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:"" (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:"" 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:"" 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:"" (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 ]; diff --git a/test/test_session.ml b/test/test_session.ml index e152b4c5..8fe132ae 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -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