A function cannot return or store in a global the address of its own frame, and a dev build poisons every arena's bytes on free-all

TODO.org

@@ -870,13 +870,12 @@ correct code, so any per-push flag is a false positive by the language's own
 semantics; the refined version needs liveness across control flow, which is the
 flow tracking that was repealed.
 
-** NEXT Catching a use-after-release statically
+** DONE Catching a use-after-release statically
-Decided 2026-09-25 (91): build (A) Odin's unsafe-return refusal — returning (addr local), (slice local-array …) or (addr (at local-array i)); (B) the same test on a set into a global; (C) dev fills a fixed arena's freed bytes with poison on free-all; (D) detect_stack_use_after_return=1 for @sanitize. Rules out a with-allocator escape check: the runtime epoch check catches it and a static rule flags building into the caller's arena. Probes: p1-p16 of the study.
+CLOSED: [2026-09-25]
-Decided 2026-09-25: a study, not a build — how arena memory escapes in real Flan code, and whether a sound lexical check would catch most of it. The result goes in docs/BUILT.md; nothing is built on it without the author.
+Studied (p1-p16); the compile-time checks that fit are returning, or storing into a global, an address or slice of the function's own frame. Rules out lexical tracking of arena and heap releases: the rest of the escapes the study found are the runtime epoch check's and the dev poison's.
-Open, and for the first time with evidence available: the epoch trap is built, and
+
-there is a =Vec= to write real arena programs with, so whether the escapes that
+** CANCELLED A with-allocator escape check
-actually occur are lexical can now be answered. The next thing to look at, not the
+The runtime epoch check already catches it, and a static rule flags the normal idiom of building into the caller's arena.
-next thing to build.
 
 ** DONE (vec-new [u8]) is refused
 CLOSED: [2026-09-25]
@@ -1170,6 +1169,9 @@ dev build wipes it at a top-level agent poll; an expression run at a stop gets a
 
 * Runtime
 
+** TODO Heap quarantine in dev
+A dev build could hold freed heap blocks back from reuse for a while (Zig's debug allocator), so a read after a free sees poison rather than a new owner's data.
+
 ** DONE An index out of range is a condition
 CLOSED: [2026-09-13]
 A failed bounds check signals =BoundsError=; a handler can answer it, a

lib/check.ml

@@ -3554,6 +3554,278 @@ let view_not_permanent loc (container : Types.t) =
      the other"
     (Types.to_string container) (Types.to_string container)
 
+(* A value handed out of [f] that points into [f]'s own frame: returned (the
+   last form's tails, or a [return]), or stored into a global or a field or
+   array element of one. Both read a dead frame the moment [f] returns, so
+   both are refused.
+
+   Deliberately narrow — the exact spellings that can only be wrong, so
+   nothing that could be valid is ever refused:
+   - [(addr p)] where [p] is a local, a field of one, or an element of a
+     local *array* (an array's elements are the frame's bytes; a Vec's or a
+     slice's are not);
+   - [(slice a …)] where [a] is such a place of array type;
+   - a local bound by [let] to one of those and never assigned or addressed
+     afterwards, which is also how a [return] under a [defer] arrives here.
+   A parameter is a local: its value is copied into the frame (an array
+   parameter too), so its address dies with the frame as well. Anything
+   reached through a [Ptr] is not the frame's, and a struct literal holding
+   such an address is not looked into.
+
+   The store is let through in [main], whose frame outlives everything the
+   program runs.
+
+   A lifted [fn] literal or handler clause is checked as a function of its
+   own: its parameters, its locals and its copies of what it captured are its
+   frame. What this does not see is the enclosing function's frame escaping
+   *through* one — a closure over a pointer to a local, handed out — because
+   that is a value holding an address, not one of the spellings above. *)
+let refuse_frame_escapes (f : Tast.fn) =
+  (* Keyed by slot alone: [fresh_slot] never reuses one, so a slot has at
+     most one binding [Let] in the function. *)
+  let binds = Hashtbl.create 16 in
+  let unstable = Hashtbl.create 16 in
+  (* A place a global owns, and so one that outlives every frame: the global,
+     a field or array element of it, or an element of a Vec it holds — the
+     Vec's block is the global's for as long as the global keeps it. A slice
+     is not stepped through: its storage may be anyone's. *)
+  let rec place_global = function
+    | Tast.Pglobal g -> Some g
+    | Tast.Pfield (t, _) -> expr_global t
+    | Tast.Pindex (t, idx) when owned_levels t.Tast.ty idx -> expr_global t
+    (* [(set (at v i) x)] on a Vec is a store through the checked element
+       address [vec_at] builds. Any other pointer's target is not known to
+       be the global's. *)
+    | Tast.Pderef { Tast.e = Tast.Prim (Tast.Rt "flan_vec_at", t :: _); _ } ->
+      expr_global t
+    | _ -> None
+  and expr_global (e : Tast.expr) =
+    match e.Tast.e with
+    | Tast.Global g -> Some g
+    | Tast.Field (t, _) -> expr_global t
+    | Tast.Prim (Tast.At, t :: idx) when owned_levels t.Tast.ty idx ->
+      expr_global t
+    | _ -> None
+  and owned_levels ty = function
+    | [] -> true
+    | _ :: rest ->
+      (match ty with
+       | Types.Array (_, el) | Types.Vec el -> owned_levels el rest
+       | _ -> false)
+  (* [(at a i j)] is one node carrying every index; each level stepped must
+     be an array for the element to be inside [a]'s own bytes. *)
+  and all_array ty = function
+    | [] -> true
+    | _ :: rest ->
+      (match ty with Types.Array (_, el) -> all_array el rest | _ -> false)
+  in
+  List.iter
+    (Tast.walk (fun (e : Tast.expr) ->
+         match e.Tast.e with
+         | Tast.Let (bs, _) -> List.iter (fun (s, v) -> Hashtbl.replace binds s v) bs
+         | Tast.Set (Tast.Plocal s, _) | Tast.Addr (Tast.Plocal s) ->
+           Hashtbl.replace unstable s ()
+         | _ -> ()))
+    f.Tast.body;
+  (* The local at the root of a place inside this frame, if it is one. *)
+  let rec root_expr (e : Tast.expr) =
+    match e.Tast.e with
+    | Tast.Local s -> Some s
+    | Tast.Field (t, _) -> root_expr t
+    | Tast.Prim (Tast.At, t :: idx) when all_array t.Tast.ty idx -> root_expr t
+    | _ -> None
+  in
+  let root_place = function
+    | Tast.Plocal s -> Some s
+    | Tast.Pfield (t, _) -> root_expr t
+    | Tast.Pindex (t, idx) when all_array t.Tast.ty idx -> root_expr t
+    | _ -> None
+  in
+  (* What escapes: the root local, whether it is a slice (else an address),
+     and whether the place is the bare local rather than a path into it —
+     only then can the fix be spelled with its name alone. *)
+  let rec escapes depth (e : Tast.expr) =
+    match e.Tast.e with
+    | Tast.Addr p ->
+      Option.map
+        (fun s ->
+           (e, (s, `Addr, (match p with Tast.Plocal _ -> true | _ -> false))))
+        (root_place p)
+    | Tast.Prim (Tast.Slice, [ t; _; _ ]) ->
+      (match t.Tast.ty with
+       | Types.Array _ ->
+         Option.map
+           (fun s ->
+              ( e,
+                (s, `Slice,
+                 (match t.Tast.e with Tast.Local _ -> true | _ -> false)) ))
+           (root_expr t)
+       | _ -> None)
+    | Tast.Local s when depth < 32 && not (Hashtbl.mem unstable s) ->
+      Option.bind (Hashtbl.find_opt binds s) (escapes (depth + 1))
+    | _ -> None
+  in
+  (* A slot with no name is a value the function made for itself, such as
+     the array a literal like [(slice [7 8 9])] is stored in. *)
+  (* What a lifted body is called in a message: its symbol is the compiler's. *)
+  let who =
+    let starts p =
+      String.length f.Tast.name >= String.length p
+      && String.sub f.Tast.name 0 (String.length p) = p
+    in
+    if starts "fn/" then "this fn"
+    else if starts "handler/" then "this handler"
+    else f.Tast.name
+  in
+  let what (s, kind, exact) =
+    match f.Tast.snames.(s), kind, exact with
+    | Some n, `Slice, true -> "a slice of " ^ n
+    | Some n, `Slice, false -> "a slice of an array inside " ^ n
+    | Some n, `Addr, true -> "the address of " ^ n
+    | Some n, `Addr, false -> "an address inside " ^ n
+    | None, `Slice, _ -> "a slice of a temporary array"
+    | None, `Addr, _ -> "the address of a temporary"
+  in
+  (* Reported at the addr or slice itself: a [return] under a [defer], or a
+     local bound to one, reaches here as a read of a slot, and the caret
+     belongs on the form that took the address. *)
+  let fail ~verb ~target ~fix_slice ~fix_addr
+      ((e : Tast.expr), ((s, kind, exact) as hit)) =
+    let fix =
+      (* The slice as written, bounds and all, when the source can be read
+         back; its root's name otherwise. *)
+      let rec bound (b : Tast.expr) =
+        match b.Tast.e with
+        | Tast.Int (v, _) -> Some (Int64.to_string v)
+        | Tast.Local i -> f.Tast.snames.(i)
+        | Tast.Prim (Tast.Cast _, [ x ]) -> bound x
+        | _ -> None
+      in
+      let rebuilt =
+        match e.Tast.e, f.Tast.snames.(s), exact with
+        | Tast.Prim (Tast.Slice, [ t; lo; hi ]), Some n, true ->
+          (match t.Tast.ty, bound lo, bound hi with
+           | Types.Array (len, _), Some "0", Some h
+             when h = Int64.to_string len ->
+             Some ("(slice " ^ n ^ ")")
+           | _, Some l, Some h -> Some ("(slice " ^ n ^ " " ^ l ^ " " ^ h ^ ")")
+           | _ -> None)
+        | _ -> None
+      in
+      let written =
+        match rebuilt, Loc.snippet ~lim:120 e.Tast.loc with
+        | Some t, _ -> Some t
+        | None, Some t
+          when String.length t > 7 && String.sub t 0 7 = "(slice "
+               && not (String.contains t '\n')
+               && not (String.ends_with ~suffix:"\xe2\x80\xa6" t) -> Some t
+        | _ -> None
+      in
+      match written, f.Tast.snames.(s), kind, exact with
+      | Some t, _, `Slice, _ ->
+        fix_slice ("wrap the slice in clone, as in (clone " ^ t ^ ")")
+      | None, Some n, `Slice, true ->
+        fix_slice ("wrap the slice in clone, as in (clone (slice " ^ n ^ "))")
+      | _, _, `Slice, _ -> fix_slice "wrap the slice in (clone ...)"
+      | _, _, `Addr, _ ->
+        let pointee =
+          match e.Tast.ty with
+          | Types.Ptr (_, t) -> Types.to_string t
+          | t -> Types.to_string t
+        in
+        fix_addr pointee
+    in
+    let whose =
+      match f.Tast.snames.(s) with
+      | Some n -> Printf.sprintf "%s is a local of %s" n who
+      | None -> "That value lives in the frame of " ^ who
+    in
+    Loc.failk "check/frame-escape" e.Tast.loc
+      "%s %s %s%s. %s, and its storage is gone once %s returns, so every \
+       later read through it reads whatever the next call leaves there. %s"
+      (if String.equal who f.Tast.name then who
+       else String.capitalize_ascii who)
+      verb (what hit) target whose who fix
+  in
+  let rec tails (e : Tast.expr) =
+    match e.Tast.e with
+    | Tast.Do es | Tast.Let (_, es) | Tast.WithAlloc (_, es)
+    | Tast.Handled (_, es) ->
+      (match List.rev es with x :: _ -> tails x | [] -> ())
+    (* A restart clause is a branch of this function whose value is the
+       form's value when that restart is taken. *)
+    | Tast.RestartCase (cs, body) ->
+      List.iter
+        (fun (c : Tast.rclause) ->
+           match List.rev c.Tast.rbody with x :: _ -> tails x | [] -> ())
+        cs;
+      tails body
+    | Tast.If (_, a, b) -> tails a; tails b
+    | Tast.Match (_, arms) ->
+      List.iter
+        (fun (a : Tast.arm) ->
+           match List.rev a.Tast.abody with x :: _ -> tails x | [] -> ())
+        arms
+    | _ ->
+      Option.iter
+        (fail ~verb:"returns" ~target:""
+           ~fix_slice:(fun c ->
+               "Return a copy the caller owns: " ^ c
+               ^ ", which puts the elements in the context allocator")
+           ~fix_addr:(fun t ->
+               if String.equal who f.Tast.name then
+                 "Return the value instead: declare " ^ who
+                 ^ " to return " ^ t ^ " and drop the addr"
+               else
+                 "Return the value, of type " ^ t
+                 ^ ", instead of its address: drop the addr"))
+        (escapes 0 e)
+  in
+  (* Only a store into the global itself can be fixed by changing the
+     global's type; for a field, an element or a push, the value's type
+     belongs to something else. *)
+  let stored ~bare g v =
+    Option.iter
+      (fail ~verb:"stores" ~target:(" into the global " ^ g)
+         ~fix_slice:(fun c ->
+             "Store a copy that outlives the frame: " ^ c
+             ^ ", which puts the elements in the context allocator")
+         ~fix_addr:(fun t ->
+             if bare then
+               "Store the value instead: declare " ^ g ^ " as " ^ t
+               ^ " and drop the addr"
+             else "Store the value instead of its address"))
+      (escapes 0 v)
+  in
+  let returns = not (Types.equal f.Tast.ret Types.Unit) in
+  List.iter
+    (Tast.walk (fun (e : Tast.expr) ->
+         match e.Tast.e with
+         | Tast.Return (Some v) when returns -> tails v
+         | Tast.Set (p, v) when not (String.equal f.Tast.name "main") ->
+           Option.iter
+             (fun g ->
+                stored ~bare:(match p with Tast.Pglobal _ -> true | _ -> false)
+                  g v)
+             (place_global p)
+         (* A push or put into a container a global owns: the element was
+            bound to a slot first, and its address is what the call takes. *)
+         | Tast.Prim (Tast.Rt ("flan_vec_push" | "flan_map_put"), target :: rest)
+           when not (String.equal f.Tast.name "main") ->
+           Option.iter
+             (fun g ->
+                List.iter
+                  (fun (a : Tast.expr) ->
+                     match a.Tast.e with
+                     | Tast.Prim (Tast.AddrOf, [ v ]) -> stored ~bare:false g v
+                     | _ -> ())
+                  rest)
+             (expr_global target)
+         | _ -> ()))
+    f.Tast.body;
+  if returns then
+    match List.rev f.Tast.body with x :: _ -> tails x | [] -> ()
+
 let box loc (e : Tast.expr) : Tast.expr =
   let dyn sym args = rt loc Types.Dyn sym args in
   match e.Tast.ty with
@@ -5943,13 +6215,15 @@ and check_fn ctx ~want ?gen loc (params : string list) body =
      one must not — it is reached by calls that pass none, and a parameter
      nobody supplies is read off whatever the register held. *)
   let fenv = if bare then fenv else declare_env fctx fenv in
-  ctx.env.lifted <-
+  let lifted =
     { Tast.name = fname; params = pts;
       slots = Array.of_list (List.rev fctx.slot_tys);
       snames = Array.of_list (List.rev fctx.slot_names);
       ret; body = prefix fbody; fdefers = [];
       fenv; fparent = Some ctx.owner; floc = loc }
-    :: ctx.env.lifted;
+  in
+  refuse_frame_escapes lifted;
+  ctx.env.lifted <- lifted :: ctx.env.lifted;
   let fty = if bare then Types.CFn (pts, ret) else Types.Fn (pts, ret) in
   (* [Flanfn] and not [Fnval], which is the handler clause's choice and is the
      same choice for the same reason. [Fnval] exists so that a *name* taken as
@@ -6064,13 +6338,15 @@ and check_handler_bind ctx ?want ?(what = "handler-bind") loc clauses body =
             [flan_signal] reads it off the frame and passes it to whichever
             clause matched, and it cannot know which of them captured. *)
          let fenv = declare_env hctx fenv in
-         ctx.env.lifted <-
+         let lifted =
            { Tast.name = fname; params = [ Types.Ptr (Types.Mut, ty) ];
              slots = Array.of_list (List.rev hctx.slot_tys);
              snames = Array.of_list (List.rev hctx.slot_names);
              ret = Types.Unit; body = prefix hbody; fdefers = [];
              fenv; fparent = Some ctx.owner; floc = c.Ast.hloc }
-           :: ctx.env.lifted;
+         in
+         refuse_frame_escapes lifted;
+         ctx.env.lifted <- lifted :: ctx.env.lifted;
          { Tast.htype = type_id name; hfn = fname; henv = addr }, bind)
       clauses
   in
@@ -14540,6 +14816,7 @@ let rec check_fn env (fn : Ast.fn) : Tast.fn =
     | None -> body
     | Some s -> defer_counter_zero s fn.Ast.nloc :: body
   in
+  let checked =
   { Tast.name = fn.Ast.name; params;
     slots = Array.of_list (List.rev ctx.slot_tys);
     snames = Array.of_list (List.rev ctx.slot_names);
@@ -14553,6 +14830,9 @@ let rec check_fn env (fn : Ast.fn) : Tast.fn =
        | None -> ctx.defers
        | Some s -> guarded_defers s ctx.defers);
     fenv = None; fparent = None; floc = fn.Ast.nloc }
+  in
+  refuse_frame_escapes checked;
+  checked
 
 (* The generic body, checked once with its variables abstract. Nothing is kept
    — the [Tast.fn] it produces is thrown away, and so is anything it lifted —

runtime/flan_rt.c

@@ -1858,6 +1858,30 @@ static flan_allocator flan_heap = {
 #define FLAN_VG_MAKE_MEM_UNDEFINED(p, n) ((void)(p), (void)(n))
 #endif
 
+/* The same fact told to AddressSanitizer: an arena's released bytes are
+ * poisoned at free-all, so a read through a slice kept past it reports under
+ * --sanitize instead of printing what is there. Every path that hands arena
+ * bytes back out — the bump, a resize in place, the temp arena's text fast
+ * path — unpoisons exactly what it hands out, and every path that writes
+ * over released bytes itself (the dev fill, a chunk dropped or freed)
+ * unpoisons first. */
+#if defined(__SANITIZE_ADDRESS__)
+#define FLAN_ASAN 1
+#elif defined(__has_feature)
+#if __has_feature(address_sanitizer)
+#define FLAN_ASAN 1
+#endif
+#endif
+#ifdef FLAN_ASAN
+void __asan_poison_memory_region(void const volatile *addr, size_t size);
+void __asan_unpoison_memory_region(void const volatile *addr, size_t size);
+#define FLAN_ASAN_POISON(p, n) __asan_poison_memory_region((p), (size_t)(n))
+#define FLAN_ASAN_UNPOISON(p, n) __asan_unpoison_memory_region((p), (size_t)(n))
+#else
+#define FLAN_ASAN_POISON(p, n) ((void)(p), (void)(n))
+#define FLAN_ASAN_UNPOISON(p, n) ((void)(p), (void)(n))
+#endif
+
 /* -- The arena: one fixed backing buffer and a bump offset. ----------
  *
  * `free-all` is retain-capacity: offset = 0, the pages stay. That is an
@@ -1923,6 +1947,7 @@ static void flan_arena_drop_old(flan_arena *ar) {
     flan_chunk *c = ar->old;
     ar->old = c->next;
     flan_dev_reg_dead_range(c->base, c->cap);
+    FLAN_ASAN_UNPOISON(c->base, c->cap);
     flan_dev_poison(c->base, c->cap);
     free(c->base);
     free(c);
@@ -1955,6 +1980,7 @@ static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p,
     if (end > ar->peak) ar->peak = end;
     a->live_blocks++;
     a->live_bytes += size;
+    FLAN_ASAN_UNPOISON(ar->base + start, size);
     return ar->base + start;
   }
   case FLAN_ALLOC_RESIZE: {
@@ -1974,6 +2000,7 @@ static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p,
       ar->offset = end;
       if (end > ar->peak) ar->peak = end;
       a->live_bytes += size - old_size;
+      FLAN_ASAN_UNPOISON(p, size);
       return p;
     }
     q = flan_arena_proc(a, FLAN_ALLOC_ALLOC, NULL, 0, size, align);
@@ -2005,11 +2032,14 @@ static void *flan_arena_proc(flan_allocator *a, int32_t mode, void *p,
        cheaper if the second could be skipped. */
     flan_arena_drop_old(ar);
     flan_dev_reg_dead_range(ar->base, ar->cap);
-    /* The temp arena's wipe, in a dev build, fills what was handed out with
+    /* A dev build fills what was handed out with the pattern a moved Vec's
-       the pattern a moved Vec's old buffer gets, so text kept past its frame
+       old buffer gets, so a slice or text kept past the free-all reads as
-       without a clone reads as garbage rather than as last frame's value. */
+       garbage rather than as the last round's values — the temp arena and a
-    if (ar->grow) flan_dev_poison(ar->base, ar->offset);
+       program's own arena alike. A release build leaves the bytes. */
+    FLAN_ASAN_UNPOISON(ar->base, ar->offset);
+    flan_dev_poison(ar->base, ar->offset);
     FLAN_VG_MAKE_MEM_UNDEFINED(ar->base, ar->cap);
+    FLAN_ASAN_POISON(ar->base, ar->cap);
     ar->offset = 0;
     a->live_blocks = 0;
     a->live_bytes = 0;
@@ -2259,6 +2289,7 @@ void flan_arena_destroy(flan_allocator *a) {
   a->epoch++;
   flan_arena_drop_old(ar);
   flan_dev_reg_dead_range(ar->base, ar->cap);
+  FLAN_ASAN_UNPOISON(ar->base, ar->cap);
   free(ar->base);
   free(ar);
   flan_header_retire(a);
@@ -2519,7 +2550,10 @@ static int8_t flan_temp_text(flan_render render, const void *x,
   ar = (flan_arena *)a->data;
   if (a->budget <= 0 && ar->cap - ar->offset >= FLAN_NUM_BYTES) {
     q = ar->base + ar->offset;
+    FLAN_ASAN_UNPOISON(q, FLAN_NUM_BYTES);
     len = fit(render(x, (char *)q, FLAN_NUM_BYTES));
+    /* The tail the text did not use goes back to released. */
+    FLAN_ASAN_POISON(q + len, FLAN_NUM_BYTES - len);
     ar->offset += len;
     if (ar->offset > ar->peak) ar->peak = ar->offset;
     a->live_blocks++;
@@ -2752,9 +2786,9 @@ void flan_vec_as_slice(flan_vec *v, void *out, int32_t lo, int32_t hi,
 }
 
 /* spec-memory.md's first release point. The Vec is left zeroed rather than
- * dangling — the checker has already made using it afterwards a compile error,
+ * dangling: a later use of it is then a null deref rather than a
- * and zeroing costs nothing and makes a bug that slips past the checker a null
+ * use-after-free, and a slice taken of it before the free is the dev
- * deref rather than a use-after-free. An allocator without can-free keeps the
+ * registry's to catch. An allocator without can-free keeps the
  * block: releasing it is free-all's job, and pretending otherwise here is the
  * silent-no-op this file refuses elsewhere. */
 void flan_vec_free(flan_vec *v, int64_t size, int64_t align,

test/dune

@@ -134,7 +134,8 @@
  (deps
   (alias corpus)
   test_sanitize.exe
-  ; ASAN_OPTIONS=detect_leaks=1 asks the leak question; see test_sanitize.ml.
+  ; ASAN_OPTIONS=detect_leaks=1:detect_stack_use_after_return=1 asks the leak
+  ; question and keeps the frame check; see test_sanitize.ml.
   (env_var ASAN_OPTIONS)
   ; The dyn runtime's C main, which is the one thing in this sweep that is not
   ; a Flan program: flan_dyn.c has no Flan spelling yet. It is also the one

test/programs/arena-free-all-poison.flan

@@ -0,0 +1,8 @@
+;;;; A slice kept past its arena's free-all. A dev build fills the released
+;;;; bytes with 0xDEADBEEF, so the element reads -559038737; a release build
+;;;; leaves the old value, 7.
+(defn main [] i32
+  (let [a (arena-new 4096) v (vec-new i32 a)]
+    (push v 7)
+    (let [s (slice v)] (free-all a) (println (at s 0))))
+  0)

test/test_acceptance.ml

@@ -1100,6 +1100,14 @@ let () =
     outputs ~dev:true "a dev free-temp poisons the wiped text" tg (tg_out "239");
     outputs ~dev:true ~x86:true "a dev free-temp poisons the wiped text, --x86"
       tg (tg_out "239");
+    let fp = "programs/arena-free-all-poison.flan" in
+    outputs "a release free-all leaves the arena's bytes" fp "7\n";
+    outputs ~dev:true "a dev free-all poisons a program's own arena" fp
+      "-559038737\n";
+    outputs ~dev:true ~opt:"-O0" "a dev free-all poisons a program's own arena, -O0"
+      fp "-559038737\n";
+    outputs ~dev:true ~x86:true
+      "a dev free-all poisons a program's own arena, --x86" fp "-559038737\n";
     (* A dev build's agent poll is a frame boundary and wipes the temp
        allocator itself: a loop that polls and never calls free-temp does not
        fill the registry. *)

test/test_flan.ml

@@ -2203,7 +2203,10 @@ let () =
     "(defn mk [] [3 i32] [7 8 9]) (defn f [] [i32] (slice (mk) 0 3))"
     ~needle:"a temporary the slice would outlive";
   accepts "slice of an array literal"
-    "(defn f [] [i32] (slice [7 8 9]))";
+    "(defn f [] i32 (at (slice [7 8 9]) 0))";
+  rejects_check "returning a slice of an array literal"
+    "(defn f [] [i32] (slice [7 8 9]))"
+    ~needle:"f returns a slice of a temporary array";
   (* One builtin, one answer about a bound. A slice bound is a subscript and
      goes through [index_expr] like every other one, so a u32 is admitted on
      an array exactly as it always was on a Vec, and an i64 is refused by name
@@ -3354,6 +3357,104 @@ let () =
   rejects_check "a dead-beef pattern out of u32 range"
     "(defn f [] () (let [a (array 4 u8)] (set a (dead-beef 0x1DEADBEEF))))"
     ~needle:"does not fit in u32";
+  (* A pointer or slice into the frame, handed out of it. *)
+  rejects_check "returning the address of a local"
+    "(defn mk [] (Ptr i32) (let [x (i32 42)] (addr x)))"
+    ~needle:"mk returns the address of x";
+  rejects_check "returning the address of a local with return"
+    "(defn mk [] (Ptr i32) (let [x (i32 42)] (return (addr x))))"
+    ~needle:"mk returns the address of x";
+  rejects_check "returning the address of a local under a defer"
+    "(defn mk [] (Ptr i32) (let [x (i32 42)] (defer (println 1)) \
+     (return (addr x))))"
+    ~needle:"mk returns the address of x";
+  rejects_check "returning a slice of a local array"
+    "(defn mk [] [i32] (let [a [1 2 3 4]] (slice a)))"
+    ~needle:"mk returns a slice of a";
+  rejects_check "returning a local bound to a slice of a local array"
+    "(defn mk [] [i32] (let [a [1 2 3 4] s (slice a 1 3)] s))"
+    ~needle:"(clone (slice a 1 3))";
+  rejects_check "returning a slice of an array parameter"
+    "(defn mk [a [4 i32]] [i32] (slice a))"
+    ~needle:"mk returns a slice of a";
+  rejects_check "returning the address of a local array's element"
+    "(defn mk [] (Ptr i32) (let [a [1 2 3 4]] (addr (at a 2))))"
+    ~needle:"mk returns an address inside a";
+  rejects_check "returning the address of a local from one if arm"
+    "(defn mk [c bool] (Ptr i32) (let [x (i32 1)] (if c (addr x) (addr x))))"
+    ~needle:"declare mk to return i32";
+  rejects_check "storing a slice of a local array into a global"
+    "(defonce g [i32]) (defn stash [] () (let [a [5 6 7]] (set g (slice a))))"
+    ~needle:"stash stores a slice of a into the global g";
+  rejects_check "storing a local field's address into a global"
+    "(defstruct P [x i32 y i32]) (defonce g (Ptr i32)) \
+     (defn stash [] () (let [p (P 1 2)] (set g (addr (.y p)))))"
+    ~needle:"declare g as i32";
+  (* And what is left alone: storage that outlives the frame, a slice of a
+     Vec, a pointer passed in, a stash the function restores, and main. *)
+  accepts "a slice of a Vec is returned"
+    "(defn mk [] [i32] (let [v (vec-new i32)] (push v 1) (slice v)))";
+  accepts "an element of a slice parameter is returned"
+    "(defn mk [s [i32]] (Ptr i32) (addr (at s 0)))";
+  accepts "a slice of a global array is returned"
+    "(defonce k [3 i32]) (defn mk [] [i32] (slice k))";
+  accepts "a local reassigned before it is returned"
+    "(defonce k [3 i32]) \
+     (defn mk [] [i32] (let [a [1 2 3] s (slice a)] (set s (slice k)) s))";
+  rejects_check "two slices of locals stored into one global"
+    "(defonce g [i32]) \
+     (defn f [] () (let [a [1 2 3] b [4 5]] (set g (slice a)) (set g (slice b))))"
+    ~needle:"f stores a slice of a into the global g";
+  rejects_check "a local's address into a global array's element"
+    "(defonce gs [2 (Ptr i32)]) \
+     (defn f [] () (let [x (i32 1)] (set (at gs 0) (addr x))))"
+    ~needle:"Store the value instead of its address";
+  rejects_check "a local's address into a global struct's field"
+    "(defstruct Q [p (Ptr i32)]) (defonce gq Q) \
+     (defn f [] () (let [x (i32 1)] (set (.p gq) (addr x))))"
+    ~needle:"f stores the address of x into the global gq";
+  rejects_check "a local's address into a global Vec's element"
+    "(defonce gv (Vec (Ptr i32))) \
+     (defn f [] () (let [x (i32 1)] (set (at gv 0) (addr x))))"
+    ~needle:"f stores the address of x into the global gv";
+  rejects_check "a local's address pushed onto a global Vec"
+    "(defonce gv (Vec (Ptr i32))) \
+     (defn f [] () (let [x (i32 1)] (push gv (addr x))))"
+    ~needle:"f stores the address of x into the global gv";
+  rejects_check "a local's address put into a global Map"
+    "(defonce gm (Map i32 (Ptr i32))) \
+     (defn f [] () (let [x (i32 1)] (put gm 1 (addr x))))"
+    ~needle:"f stores the address of x into the global gm";
+  accepts "a pointer parameter pushed onto a global Vec"
+    "(defonce gv (Vec (Ptr i32))) \
+     (defn f [p (Ptr i32)] () (push gv p))";
+  rejects_check "the fix keeps the slice's bounds"
+    "(defn mk [a [4 i32]] [i32] (slice a 1 3))"
+    ~needle:"(clone (slice a 1 3))";
+  rejects_check "an fn returning the address of its own local"
+    "(defn call [f (Fn [] (Ptr i32))] (Ptr i32) (f)) \
+     (defn g [] (Ptr i32) (call (fn [] (let [x (i32 4)] (addr x)))))"
+    ~needle:"This fn returns the address of x";
+  rejects_check "an fn returning a slice of its copy of a captured array"
+    "(defn call [f (Fn [] [i32])] [i32] (f)) \
+     (defn g [] i32 (let [a [1 2 3]] (at (call (fn [] (slice a))) 0)))"
+    ~needle:"This fn returns a slice of a";
+  rejects_check "a handler storing a slice of its local into a global"
+    "(defstruct Oops [code i32]) (defonce g [i32]) \
+     (defn main [] i32 \
+       (handler-bind [(Oops [c] (let [a [1 2 3]] (set g (slice a))))] \
+         (signal (Oops {.code 1}))) 0)"
+    ~needle:"This handler stores a slice of a into the global g";
+  rejects_check "a restart clause answering the address of a local"
+    "(defstruct Oops [code i32]) \
+     (defn mk [p (Ptr i32)] (Ptr i32) (let [x (i32 4)] \
+       (restart-case (do (signal (Oops {.code 1})) p) \
+         (use-it [] (addr x)))))"
+    ~needle:"mk returns the address of x";
+  accepts "main stores its own local into a global"
+    "(defonce g (Ptr i32)) (defn main [] i32 (let [x (i32 5)] (set g (addr x))) 0)";
+  accepts "a unit function's last form is not returned"
+    "(defn f [] () (let [x (i32 4)] (addr x)))";
   (* A fill is never a value the linker can write into the image, so a
      defconst of one is refused by the constant rule rather than by anything
      of this feature's own. A defonce is fine: its initialiser runs at

test/test_sanitize.ml

@@ -43,10 +43,13 @@ let scratch = Test_support.scratch
    by design — [rt_args] says so in its own comment — so LeakSanitizer here
    produces a suppression list and no information. Set in the environment
    rather than baked in, so a session asking the leak question can ask it.
+   [detect_stack_use_after_return] moves frames to a fake stack that is
+   poisoned when the function returns, so a pointer or slice into a frame that
+   has returned reports rather than reading whatever the next call left.
    [print_stacktrace] is what turns a UBSan report from a source line into
    something with a caller in it, and it is off by default. *)
 let env =
-  "ASAN_OPTIONS=${ASAN_OPTIONS:-detect_leaks=0} \
+  "ASAN_OPTIONS=${ASAN_OPTIONS:-detect_leaks=0:detect_stack_use_after_return=1} \
    UBSAN_OPTIONS=${UBSAN_OPTIONS:-print_stacktrace=1} "
 
 let run exe args =
@@ -61,7 +64,7 @@ let run exe args =
   (try Sys.remove out with Sys_error _ -> ());
   (code, text)
 
-let compile ?(dev = false) ~sanitize ~checks path =
+let compile ?(dev = false) ?(opt = "-O0") ~sanitize ~checks path =
   let exe =
     Filename.concat scratch
       (Printf.sprintf "flan-san-%s%s-%s"
@@ -70,10 +73,15 @@ let compile ?(dev = false) ~sanitize ~checks path =
          (Filename.remove_extension (Filename.basename path)))
   in
   let p, csrcs, lflags = Test_support.linked ~dev path in
+  (* -O0 by default, both builds: detect_stack_use_after_return (see [env]) can only
+     report a read of a frame's variable that still has a stack slot. At -O2
+     the local is promoted to a register and the read folded to the value it
+     held, so a pointer into a returned frame reads nothing the fake stack
+     can poison. *)
   ignore
     (Build.executable
-       ~opts:{ Build.default with checks; sanitize; dev } ~csrcs ~lflags p
+       ~opts:{ Build.default with checks; sanitize; dev; opt }
-       ~out:exe);
+       ~csrcs ~lflags p ~out:exe);
   exe
 
 let contains = Test_support.contains
@@ -104,6 +112,9 @@ let reported text = List.exists (contains text) markers
    calc-me is here and is not in test/programs: it is the one string parser in
    the corpus, which makes it the likeliest to push [scratch] or [escaped]
    anywhere near their bounds. *)
+(* temp-grow and condition-temp read text after a (free-temp) on purpose, to
+   show the dev poison, and a sanitized build reports exactly that read: they
+   stay out of this list. *)
 let corpus =
   [ (* bounds.flan selects its case from argv, and every case but 0 is one
        that traps. Argument 0 is the in-bounds path — the last index of a
@@ -324,7 +335,7 @@ let dyn_sweep () =
   let p, csrcs, lflags = Test_support.linked path in
   match
     Build.executable
-      ~opts:{ Build.default with Build.sanitize = true }
+      ~opts:{ Build.default with Build.sanitize = true; opt = "-O0" }
       ~csrcs:(csrcs @ [ "dyn_ops.c" ]) ~lflags p ~out:exe
   with
   | exception Failure m -> fail "dyn: sanitized build: %s" m
@@ -436,8 +447,8 @@ let dev_sweep () =
    sanitized run must produce ASan's report and must NOT produce the
    handler's line, and that is the assertion.
 
-   And it has to be built at -O0. At the sweep's -O2 a store through a null
+   And it has to be built at -O0, as the sweep now is. At -O2 a store through
-   pointer is undefined and need not fault — so a case that is about what happens
+   a null pointer is undefined and need not fault — so a case that is about what happens
    on a fault has to be compiled where the fault happens. Same family as the
    -O0/-O2 split [unchecked_controls] records for bounds.flan.
 
@@ -486,7 +497,8 @@ let dev_session () =
   let fd = Unix.openfile log [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
   let env =
     Array.append (Unix.environment ())
-      [| "ASAN_OPTIONS=detect_leaks=0"; "UBSAN_OPTIONS=print_stacktrace=1" |]
+      [| "ASAN_OPTIONS=detect_leaks=0:detect_stack_use_after_return=1";
+         "UBSAN_OPTIONS=print_stacktrace=1" |]
   in
   let pid =
     Unix.create_process_env flan
@@ -588,7 +600,8 @@ let control ~expect_report ?(args = []) ~why name src =
    wrong answer instead of touching a redzone. At -O0, with the load still in
    the program, ASan reports it. That divergence is why [--sanitize] does not
    force -O0 the way [--debug] does — the optimiser is half of what is being
-   measured. *)
+   measured — and why this one control is built at -O2 while the sweep is
+   not. *)
 let unchecked_controls () =
   let reports = [ "3"; "7"; "4" ] in
   let silent =
@@ -612,7 +625,7 @@ let unchecked_controls () =
              here and now for a better reason. The trap itself is asserted in \
              test_acceptance.ml" ]
   in
-  match compile ~sanitize:true ~checks:false "programs/bounds.flan" with
+  match compile ~opt:"-O2" ~sanitize:true ~checks:false "programs/bounds.flan" with
   | exception Failure m -> fail "unchecked bounds.flan: build: %s" m
   | exe ->
     List.iter