A dev eval prints the compiler's warnings for the forms it sent and not again for forms sent earlier.

lib/check.ml

@@ -20806,6 +20806,30 @@ let prelude_alias = "prelude~"
    the dev program re-creating the session its launcher built and warned for. *)
 let print_warnings = ref true
 
+(* Where a dev eval's own forms are, so its warnings are said for those and
+   not again, on every later eval, for everything the session holds. [None]
+   is a build or a check, which says everything. *)
+let warn_within : Loc.t list option ref = ref None
+
+let say_warnings (ds : Loc.diag list) =
+  let within (at : Loc.t) =
+    match !warn_within with
+    | None -> true
+    | Some spans ->
+      List.exists
+        (fun (s : Loc.t) ->
+           String.equal s.Loc.file at.Loc.file
+           && s.Loc.line <= at.Loc.line && at.Loc.line <= max s.Loc.line s.Loc.eline)
+        spans
+  in
+  if !print_warnings then
+    List.iter
+      (fun (d : Loc.diag) ->
+         if within d.Loc.dloc then
+           prerr_endline
+             (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
+      ds
+
 (* A name the renaming above made, which nobody wrote: left out of every
    listing a person reads, and shown as whose it is where a frame has to be. *)
 let internal_name n = String.starts_with ~prefix:(prelude_alias ^ "/") n
@@ -21060,12 +21084,7 @@ let build_program ~keep_going ?tolerate ?previous (decls : Ast.decl list) :
      reload, which is where a defn is most likely to be written. Printed in
      the shape [Loc] gives an error, so a checker in an editor parses it the
      same way. *)
-  if !print_warnings then
+  say_warnings (shadowed_builtins decls @ prelude_warnings);
-  List.iter
-    (fun (d : Loc.diag) ->
-       prerr_endline
-         (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
-    (shadowed_builtins decls @ prelude_warnings);
   (* Pass one, and it stops at the first thing it refuses. That is not
      laziness: every name, type and signature in the file comes from here, so a
      declaration this pass could not make sense of leaves a hole that pass two
@@ -21079,22 +21098,12 @@ let build_program ~keep_going ?tolerate ?previous (decls : Ast.decl list) :
   if keep_going then env.deferred <- Some [];
   grow_warnings := [];
   let decls = collect env decls in
-  if !print_warnings then
+  say_warnings (List.rev !pairing_warnings);
-    List.iter
-      (fun (d : Loc.diag) ->
-         prerr_endline
-           (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
-      (List.rev !pairing_warnings);
   check_finite env;
   check_union_members env;
   infer_returns ~keep_going ?tolerate ?previous env decls;
   recursion_warnings := unconditional_recursion env decls;
-  if !print_warnings then
+  say_warnings !recursion_warnings;
-    List.iter
-      (fun (d : Loc.diag) ->
-         prerr_endline
-           (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
-      !recursion_warnings;
   (let late = !consts_after_infer in
    consts_after_infer := [];
    settle_consts env late);
@@ -21155,12 +21164,7 @@ let build_program ~keep_going ?tolerate ?previous (decls : Ast.decl list) :
          | _ -> None)
       decls
   in
-  if !print_warnings then
+  say_warnings (List.rev !grow_warnings);
-    List.iter
-      (fun (d : Loc.diag) ->
-         prerr_endline
-           (Loc.entry ~mark:'~' ~label:"warning: " d.Loc.dloc d.Loc.dmsg))
-      (List.rev !grow_warnings);
   Loc.finish s;
   (* The placeholder a [_] body is read against is never a type anything
      downstream may see; a signature carrying it would be emitted as a

lib/session.ml

@@ -1105,9 +1105,15 @@ let eval ?(origin = "<eval>") ?base ?forms ?pause ?(step = false) ?(running = tr
            else None)
         t.program.Tast.fns
     in
+    (* The whole session is checked again, and only the forms sent are warned
+       about: a warning said at the eval that wrote it is not said again at
+       every eval after. *)
+    let was = !Check.warn_within in
+    Check.warn_within := Some (List.map (fun (f : Form.t) -> f.Form.loc) forms);
     match
-      Check.program_tolerant ~keep_going:true ~tolerate:stale_owner ~previous
+      Fun.protect ~finally:(fun () -> Check.warn_within := was) (fun () ->
-        decls
+        Check.program_tolerant ~keep_going:true ~tolerate:stale_owner ~previous
+          decls)
     with
     | r -> r
     | exception Loc.Errors [ d ] -> raise (Loc.Error d)

test/test_session.ml

@@ -2237,32 +2237,50 @@ let () =
 
   (* A fn sent to the session that calls itself on every path is warned at
      (decision 142) on the daemon's stderr, which is the daemon's buffer in
-     the editor. *)
+     the editor — once, at the eval that sent it. Every eval checks the whole
+     session again, and a warning about a form sent earlier is not said
+     again; nor is a builtin-shadow warning. *)
   (let t, _ = Session.create ~file:"programs/reload.flan" () in
-   let path = Test_support.tmp "recursion-" "stderr.txt" in
+   let stderr_of f =
-   let fd = Unix.openfile path [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
+     let path = Test_support.tmp "recursion-" "stderr.txt" in
-   let saved = Unix.dup Unix.stderr in
+     let fd = Unix.openfile path [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
-   flush stderr;
+     let saved = Unix.dup Unix.stderr in
-   Unix.dup2 fd Unix.stderr;
+     flush stderr;
-   let r =
+     Unix.dup2 fd Unix.stderr;
-     Fun.protect
+     let r =
-       ~finally:(fun () -> flush stderr; Unix.dup2 saved Unix.stderr; Unix.close saved; Unix.close fd)
+       Fun.protect
-       (fun () ->
+         ~finally:(fun () ->
-          Source.with_code ~syntax:Source.Indented ~at:None (fun () ->
+           flush stderr; Unix.dup2 saved Unix.stderr; Unix.close saved; Unix.close fd)
-            Session.eval ~origin:"handshakes.fln" t
+         (fun () -> Source.with_code ~syntax:Source.Indented ~at:None f)
-              "fn count-handshakes(people)\n  for p in range(people)\n    \
+     in
-               println(p)\n  count-handshakes(5)\n"))
+     let said = In_channel.with_open_bin path In_channel.input_all in
+     Sys.remove path;
+     (r, said)
    in
-   let said = In_channel.with_open_bin path In_channel.input_all in
+   let warnings said =
-   Sys.remove path;
+     List.length
-   (match r with
+       (List.filter (fun l -> has l ": warning: ") (String.split_on_char '\n' said))
-    | c when not (List.mem "count-handshakes" c.Session.fns) ->
+   in
-      fail "a fn that calls itself on every path was not installed"
+   let r, said =
-    | _ -> ());
+     stderr_of (fun () ->
+       Session.eval ~origin:"handshakes.fln" t
+         "fn count-handshakes(people)\n  for p in range(people)\n    \
+          println(p)\n  count-handshakes(5)\n\nfn get(p: i64) -> i64\n  p\n")
+   in
+   if not (List.mem "count-handshakes" r.Session.fns) then
+     fail "a fn that calls itself on every path was not installed";
    (match !Check.recursion_warnings with
     | [ d ] when d.Loc.kind = "check/unconditional-recursion" && d.Loc.dloc.Loc.line = 4 -> ()
-    | ds -> fail "a dev eval of count-handshakes warned %d times" (List.length ds));
+    | ds -> fail "a dev eval of count-handshakes found %d recursions" (List.length ds));
    if not (has said "warning: count-handshakes calls itself on line 4 on every path")
-   then fail "a dev eval printed no recursion warning: %S" said);
+   then fail "a dev eval printed no recursion warning: %S" said;
+   if warnings said <> 2 then
+     fail "the eval that sent them printed %d warnings, not 2: %S" (warnings said) said;
+   let _, again =
+     stderr_of (fun () ->
+       Session.eval ~origin:"other.fln" t "fn other-thing(x: i64) -> i64\n  x + 1\n")
+   in
+   if warnings again <> 0 then
+     fail "an unrelated eval said an earlier form's warnings again: %S" again);
 
   Test_support.report ~label:"session" ()