diff --git a/lib/emit.ml b/lib/emit.ml index fe4af43..d2460e9 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -1480,8 +1480,18 @@ let redefinition ?(checks = true) ?(dev = false) ?(known = fun _ -> true) returned — no cell holds an address in its text, the registry has no slot for it, and the value it produced was copied out. So it says so, and the agent unloads it. A module that publishes a body can never say - this: its whole purpose is to leave a pointer behind. *) - if fns = [ fn ] && consts = [] then + this: its whole purpose is to leave a pointer behind. + + [m.nstr = 0] is the third condition and it is about *data*, not text. + A string literal is emitted into this module's own image, and an + expression may store one anywhere it likes — [(set msg "tuned")] on a + string global leaves that global pointing into the mapping the agent + is about to drop. The next thunk can be mapped at the same address, so + the result is silent garbage rather than a fault. A module with no + string constants has nothing in its image anyone could still be + pointing at; one with any keeps its mapping, which costs a page and is + the same bargain every redefinition already makes. *) + if fns = [ fn ] && consts = [] && m.nstr = 0 then Buffer.add_string m.out "\n@flan_reload_transient = global i8 1\n" | None -> () end; diff --git a/test/test_session.ml b/test/test_session.ml index 5a6ba7f..b2b8281 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -208,6 +208,18 @@ let () = if has c.Session.ir "@flan_reload_transient" then fail "a module that publishes a body claimed to be unloadable"; + (* And a third condition, about data rather than text. A string literal lives + in the evaluating module's own image, and an expression may store one + anywhere: [(set msg "x")] on a string global would leave that global + pointing into a mapping the agent then drops — and since the next thunk can + be mapped at the same address, the result is silent garbage rather than a + fault. A module carrying any string constant keeps its mapping. *) + let str = Session.eval_expr t "(print-line \"tuned\")" in + if not (has str.Session.ir ".str.0") then + fail "the fixture stopped carrying a string constant, so it proves nothing"; + if has str.Session.ir "@flan_reload_transient" then + fail "an expression holding a string claimed to be unloadable"; + if !failures = 0 then print_endline "session: all tests passed" else begin Printf.printf "\n%d failure(s)\n" !failures;