An expression at a stop that destroys the program's temp arena leaves context/temp empty rather than restoring the destroyed record

runtime/flan_rt.c

@@ -1639,6 +1639,9 @@ static flan_allocator *flan_ctx_tmp = NULL;
 /* The agent's scratch temp arenas; see flan_temp_scratch_begin. */
 #define FLAN_SCRATCH_LEVELS 16
 static flan_allocator *flan_scratch[FLAN_SCRATCH_LEVELS];
+/* The incarnation of the temp arena each level displaced, so the end puts it
+ * back only if the expression did not destroy it. */
+static uint64_t flan_scratch_prev_inc[FLAN_SCRATCH_LEVELS];
 static int flan_scratch_depth;
 
 flan_allocator *flan_arena_new(int64_t cap);
@@ -1713,6 +1716,7 @@ void *flan_temp_scratch_begin(void) {
     flan_scratch[d] = flan_arena_new(FLAN_TEMP_DEFAULT);
     if (flan_scratch[d]) ((flan_arena *)flan_scratch[d]->data)->grow = 1;
   }
+  flan_scratch_prev_inc[d] = prev ? prev->incarnation : 0;
   flan_scratch_depth++;
   if (flan_scratch[d]) flan_ctx_tmp = flan_scratch[d];
   return prev;
@@ -1727,7 +1731,15 @@ void flan_temp_scratch_end(void *prev) {
     flan_scratch[d]->proc(flan_scratch[d], FLAN_ALLOC_FREE_ALL, NULL, 0, 0, 0);
     flan_scratch[d]->epoch++;
   }
-  flan_ctx_tmp = (flan_allocator *)prev;
+  /* An expression that destroyed the program's temp arena through an
+   * Allocator value it kept has retired its record, and a later arena-new may
+   * have taken it; putting it back would make context/temp that other arena.
+   * The context is then left without one, as the destroy left it, and the
+   * next use makes a new one. */
+  {
+    flan_allocator *p = (flan_allocator *)prev;
+    flan_ctx_tmp = p && p->incarnation == flan_scratch_prev_inc[d] ? p : NULL;
+  }
 }
 
 /* with-allocator hands in two values in its own frame: [0] the one to install

test/programs/dev-temp-destroy.flan

@@ -0,0 +1,36 @@
+;;;; A program that keeps its own temp arena as an Allocator value and stops.
+;;;; test_dev.ml destroys that arena from an expression at the stop, makes a
+;;;; new arena — which takes the destroyed one's record — and a Vec in it, then
+;;;; resumes. The expression's scratch temp arena must not put the destroyed
+;;;; record back as context/temp, or the next frame boundary would wipe the new
+;;;; arena as the temp one and the Vec made there would trap.
+(import agent "vendor:agent")
+
+(defstruct Missing [id i32])
+
+(defonce ar Allocator)
+(defonce tv Allocator)
+(defonce av (Vec u8))
+
+(defn fetch [] i32
+  (restart-case
+    (do (error (Missing {.id 1})) 0)
+    (retry [] 7)))
+
+(defn hold [] i32
+  (set tv context/temp)
+  (let [r (fetch)]
+    (println (string (i64->bytes 31)))
+    r))
+
+(defn main [] i32
+  (agent/start)
+  (println (hold))
+  ;; A frame boundary, which in a dev build wipes context/temp — the new
+  ;; arena, had the destroyed record been put back as it.
+  (agent/poll)
+  (println (length av))
+  (println (at av 0))
+  (dotimes [i 4000]
+    (agent/wait 5))
+  0)

test/test_dev.ml

@@ -7532,6 +7532,72 @@ let () =
          (try Sys.remove tsock with Sys_error _ -> ()))
       [ ("--llvm", 20); ("--x86", 20); ("--llvm", 3000000); ("--x86", 3000000) ];
 
+    (* ── The program's temp arena destroyed from a stop ────────────
+       The scratch arena's end must not put back a temp arena the expression
+       destroyed: a later arena-new takes its record, and context/temp would
+       then be that other arena. *)
+    List.iter
+      (fun mode ->
+         let dsock = tmp ("tdestroy" ^ mode ^ ".sock") in
+         (try Sys.remove dsock with Sys_error _ -> ());
+         let dpid =
+           Unix.create_process flan
+             [| flan; "dev"; "programs/dev-temp-destroy.flan"; "-s"; dsock; mode |]
+             Unix.stdin Unix.stdout Unix.stderr
+         in
+         if not (listening ~pid:dpid dsock) then begin
+           fail "the %s temp-destroy daemon %s" mode !listen_why;
+           (try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ())
+         end
+         else begin
+           let c = connect dsock in
+           let out = Buffer.create 64 in
+           let ask sexp =
+             let r = Wire.parse (Wire.send c sexp; Wire.recv c) in
+             (match Wire.string_field r "output" with
+              | Some t -> Buffer.add_string out t
+              | None -> ());
+             r
+           in
+           let stopped r =
+             match Wire.field r "stopped" with
+             | Some { Form.v = Form.Sym "t"; _ } -> true
+             | _ -> false
+           in
+           let eval code =
+             ask
+               (Printf.sprintf
+                  "(:op \"eval-expr\" :code %S :file \"programs/dev-temp-destroy.flan\")"
+                  code)
+           in
+           if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then
+             fail "%s: the temp-destroy program never stopped" mode
+           else begin
+             List.iter
+               (fun code ->
+                  let r = eval code in
+                  if status r <> "ok" then
+                    fail "%s: %s at the stop: %s" mode code
+                      (Option.value ~default:(status r)
+                         (Wire.string_field r "message")))
+               [ "(arena-destroy tv)"; "(set ar (arena-new 4096))";
+                 "(set av (vec-new u8 ar))"; "(push av (u8 7))" ];
+             ignore (ask "(:op \"restart\" :name \"retry\")");
+             if not
+                 (await (fun () ->
+                    (try ignore (ask "(:op \"describe\")") with _ -> ());
+                    contains_sub (Buffer.contents out) "31\n7\n1\n7\n"))
+             then
+               fail "%s: after destroying the temp arena at a stop: %S" mode
+                 (Buffer.contents out)
+           end;
+           (try Unix.close c with Unix.Unix_error _ -> ());
+           (try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ());
+           (try ignore (Unix.waitpid [] dpid) with Unix.Unix_error _ -> ())
+         end;
+         (try Sys.remove dsock with Sys_error _ -> ()))
+      [ "--llvm"; "--x86" ];
+
     (* ══ The agent socket is not the editor protocol ══════════════════
 
        Two daemons of their own, both about what a session owes an editor