Two ways the disassembly said more than it knew

A stopped program was said not to have installed what was delivered. The
commonest way to stop is to install a body and have it error, so that
asserted non-installation in precisely the case where the body is running;
the daemon cannot read a cell back either way, and now says that. What is
certain is only that nothing further installs until it resumes.

And the source location came from the session rather than from the build it
was showing. Session.eval replaces the checked program the moment a form
checks — before the build, before delivery — so an evaluation that checked
and then failed to build left a reply showing the host's code, saying
nothing had been delivered, and pointing at a buffer whose code never
landed. A daemon whose llc is [false] is the whole test.

lib/dev.ml

@@ -238,6 +238,23 @@ let fn_loc t name =
   | Some f -> Loc.to_string f.Tast.floc
   | None -> ""
 
+(* Where the *running process* has this function written, which is not where
+   the session has it. [Session.eval] replaces the checked program as soon as a
+   form checks — before the build, before delivery — so a body that checked and
+   then failed to build leaves the session holding a location in a buffer whose
+   code never landed. [host] is the program the process was launched from and
+   nothing mutates it, so it is the only honest answer for a name no module has
+   been accepted for. *)
+let host_loc t name =
+  match
+    List.find_opt
+      (fun (f : Tast.fn) ->
+         String.equal f.Tast.name name && f.Tast.fparent = None)
+      t.session.Session.host.Tast.fns
+  with
+  | Some f -> Loc.to_string f.Tast.floc
+  | None -> ""
+
 (* ── Ops ───────────────────────────────────────────────────────────── *)
 
 (* Every reply is a plist with a :status, so an editor can dispatch on one key
@@ -699,7 +716,7 @@ let basis t name =
   match Hashtbl.find_opt t.owners name with
   | None ->
     ( { ogen = 0; oso = Filename.concat t.dir "program"; oll = t.host_ll;
-        oloc = fn_loc t name },
+        oloc = host_loc t name },
       "the host executable — nothing defining this name has been delivered in \
        this session, so the program's cell still holds this body" )
   | Some o ->
@@ -707,9 +724,17 @@ let basis t name =
     ( o,
       match state t with
       | Stopped c ->
+        (* Not "so it is not installed yet". The commonest way to stop is to
+           install a body and have it error, so a stopped program is more
+           likely to be running this code than not — the daemon simply cannot
+           read the cell back to find out, and saying otherwise would be the
+           [ok]-means-probably failure in the one field that exists to prevent
+           it. What is certain is only the second half. *)
         Printf.sprintf
-          "%s — delivered and accepted, but the program is stopped on %s and \
+          "%s — the last module delivered for this name, accepted for install; \
-           has not reached a frame boundary since, so this is not installed yet"
+           the program is stopped on %s and the daemon cannot read the cell \
+           back to say whether it installed this before stopping. Nothing \
+           further installs until it resumes"
           m c
       | Running ->
         Printf.sprintf
@@ -755,7 +780,10 @@ let disassemble t ~name ~form =
         [ ":name " ^ Wire.quote name; ":form " ^ Wire.quote form;
           ":generation " ^ string_of_int o.ogen;
           ":signature " ^ Wire.quote (signature_of_fn f);
-          ":loc " ^ Wire.quote (Loc.to_string f.Tast.floc);
+          (* [o.oloc], not the session's: the session moves on as soon as a
+             form checks, and this has to name the source the code being shown
+             was built from. *)
+          ":loc " ^ Wire.quote o.oloc;
           ":basis " ^ Wire.quote why ]
       in
       if form = "ir" then

test/test_dev.ml

@@ -582,6 +582,38 @@ let () =
       refused "a request with no name" "(:op \"disassemble\" :form \"asm\")"
         "needs :name";
 
+      (* A stopped program has not thereby failed to install. The commonest way
+         to stop is to install a body and have it error, so the one thing the
+         basis must not say here is "not installed yet" — it would be asserting
+         non-installation in exactly the case where the body is running. *)
+      let stopped r =
+        match Wire.field r "stopped" with
+        | Some { Form.v = Form.Sym "t"; _ } -> true
+        | _ -> false
+      in
+      let r =
+        request c
+          "(:op \"eval\" :code \"(defn step [] i64 (error (Missing {:id 3})))\" :file \"/tmp/disasm.flan\")"
+      in
+      if status r <> "ok" then
+        fail "installing a body that errors: %s"
+          (Option.value ~default:"" (Wire.string_field r "message"))
+      else if
+        not (await (fun () -> stopped (request c "(:op \"describe\")")))
+      then fail "the program never stopped on the body that errors"
+      else begin
+        let r = request c "(:op \"disassemble\" :name \"step\" :form \"ir\")" in
+        if status r <> "ok" then
+          fail "disassembling while the program is stopped: %s"
+            (Option.value ~default:"" (Wire.string_field r "message"))
+        else begin
+          if not (has (basis r) "stopped on Missing") then
+            fail "a stopped program is not mentioned in the basis: %S" (basis r);
+          if has (basis r) "not installed" then
+            fail "a stopped program is said not to have installed: %S" (basis r)
+        end
+      end;
+
       ignore (request c "(:op \"close\")");
       Unix.close c;
       if not
@@ -597,6 +629,74 @@ let () =
     end;
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ dsock; dout ];
 
+    (* ── A location that survives an evaluation that did not land ───── *)
+
+    (* [Session.eval] replaces the checked program the moment a form checks,
+       which is before the build and before delivery. So there is a window in
+       which the session holds a body the running process has never seen, and a
+       disassembly that took its source location from the session would point
+       into the buffer of code that never landed — while showing the host's
+       code and saying, correctly, that nothing had been delivered. One reply
+       contradicting itself in two fields.
+
+       A daemon whose [llc] is [false] reproduces it exactly and cheaply: the
+       host is built by clang and runs, every redefinition checks and then
+       fails to build, and nothing is ever delivered. *)
+    let ssock = tmp "stale.sock" and sout = tmp "stale.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 env =
+      Array.append (Unix.environment ()) [| "FLAN_LLC=false" |]
+    in
+    let spid =
+      Unix.create_process_env flan
+        [| flan; "dev"; "programs/dev-repl.flan"; "-s"; ssock |]
+        env Unix.stdin sfd Unix.stderr
+    in
+    Unix.close sfd;
+    if not (await (fun () -> Sys.file_exists ssock)) then begin
+      fail "the daemon with no working llc never listened";
+      (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ())
+    end
+    else begin
+      let c = connect ssock in
+      let has hay needle =
+        let n = String.length needle and h = String.length hay in
+        let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
+        n > 0 && go 0
+      in
+      let r =
+        request c
+          "(:op \"eval\" :code \"(defn step [] i64 (set ticks (+ ticks 9)) ticks)\" :file \"/tmp/never-landed.flan\")"
+      in
+      if status r <> "error" then
+        fail "an evaluation that cannot be built was reported as installed";
+      let r = request c "(:op \"disassemble\" :name \"step\" :form \"ir\")" in
+      if status r <> "ok" then
+        fail "disassembling after a build that failed: %s"
+          (Option.value ~default:"" (Wire.string_field r "message"))
+      else begin
+        let loc = Option.value ~default:"" (Wire.string_field r "loc") in
+        if has loc "never-landed" then
+          fail "the location is a buffer whose code was never delivered: %s" loc;
+        if not (has loc "dev-repl.flan") then
+          fail "the location is not the source the process was built from: %s" loc
+      end;
+      ignore (request c "(:op \"close\")");
+      Unix.close c;
+      if not
+           (await ~ms:5000 (fun () ->
+              match Unix.waitpid [ Unix.WNOHANG ] spid with
+              | 0, _ -> false
+              | _ -> true
+              | exception Unix.Unix_error _ -> true))
+      then begin
+        (try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ());
+        (try ignore (Unix.waitpid [] spid) with Unix.Unix_error _ -> ())
+      end
+    end;
+    List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ ssock; sout ];
+
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ sock; out; bsock; bout ];
     if !failures = 0 then print_endline "dev: all tests passed"