Joseph Ferano
3f7c42257f
Relocation was proved sound and stayed sound — a Vec view holding the header's own address survives a push that grows and moves it, because there is no snapshot to invalidate. That was never the whole of the hazard. Refusing every container into dyn outright, before this lane, meant a dangling view was unreachable; the moment box stopped refusing, three routes opened at once — a view returned from the function whose frame the Vec lived in, one stashed in a dyn global and read after that frame is gone, and one left behind when a condition transfer unwinds it. All three are stack-use-after-return, reachable for the first time. The rule: a typed container crosses into dyn as a view only when its own storage is permanent — a global's. On the dynamic side Flan follows Clojure and Common Lisp, where holding a value can never hand you garbage; treating a view as a bare pointer and calling the lifetime the programmer's problem is the Odin answer, and it is the wrong trade on this side of the language. check.ml's permanent_root walks the checked expression back to its root: a global is permanent, a field or an array element of one is permanent at the same fixed offset, and a slice cut directly from one at the call site inherits it — the trace is what a slice carries, and it is lost the moment the slice is bound to a name first, so that case is refused too rather than guessed at. Everything else answers false: a local, a parameter, a temporary, and anything reached through a (Ptr T), because a heap-durable pointer and a frame's own are the same type and the checker cannot tell them apart — admitting one admits the other, which is the whole hazard this closes. An arena-held header turns out not to be a separate case at all: an arena changes where a Vec's elements live, never where its own header — the binding — lives, so it is already covered by the storage-class check above. Both directions of the F1 escape were reproduced before the fix (a genuine ASan stack-use-after-return, reproduced by building the pre-fix tree) and confirmed refused at check time after it, for all three routes. Three more findings, all in the runtime rather than the boundary: view_vec_check, on finding a stale container, rendered the very view it had just declared unsafe to read — which called back into the same check, unconditionally, an infinite recursion rather than the intended trap. Fixed by never rendering the container in the stale message at all; the sentence names the two epochs and nothing else, which is everything a reader needs and the one thing that was safe to read. dyn_equal's VEC arm read x->len and x->u.v.items regardless of kind, which for a view answers 0 and the union's other member reinterpreted as dyn words: two views with different contents compared equal, a view and an equal heap vec compared unequal, and a map keyed by any view collided with every other view, silently. vecish_len and vecish_at read either shape correctly and the arm now goes through them. obj_words gets the same explicit OBJ_VIEW case on the same reasoning, unreachable today only because mark_push's own gate already excludes the kind — this is the belt next to that brace. The three restatements of flan_vec's layout — flan_rt.c's real struct, flan_dyn.c's mirror, and dyn_ops.c's hand-built one — had a comment claiming a reorder would not compile or link, which was never true of a void*-typed forward declaration. flan_vec_layout and flan_dyn_vec_hdr_layout each report their struct's size and field offsets; dyn_ops.c's new "layout" mode compares both against offsetof on its own hand_vec, so a disagreement is a FAIL line in dune test instead of a silent corruption at whichever view reads through the wrong offset next. Also: the survey program's comment excusing a by-value parameter's view as "value semantics, not a hole" was wrong on its own terms — a write through such a view does reach the caller's storage, only growth diverges — but the question is moot now: every container the program views is a global, and the file was rewritten around that rather than patched. And an i32 element does not cross into a view either, but the refusal used to say why in words that were true only of a string element; it now says what i32 actually is and what the restriction is actually for. Rebased onto dev-loop's item-4 landing (221df5a).
248 lines
12 KiB
OCaml
248 lines
12 KiB
OCaml
(* The dynamic-value runtime, driven from C.
|
|
|
|
runtime/flan_dyn.c is a C ABI with no Flan spelling yet — the compiler lane
|
|
is what gives it one — so the only way to reach every operation, and every
|
|
way each one refuses, is a C main. test/dyn_ops.c is that main and
|
|
programs/dyn-host.flan is the program it is linked against, which has no
|
|
[main] of its own for the same reason programs/reload.flan does not.
|
|
|
|
What is asserted here, and why each is its own thing:
|
|
|
|
ops every operation's happy path, the tags, the printed form of
|
|
each, text identity against text equality, and a vec that
|
|
contains itself
|
|
gc a million allocations against a hundred live, and the heap's
|
|
high-water mark bounded
|
|
unrooted the positive control: an object nothing points at is reclaimed.
|
|
desc an aggregate root: a struct whose dyn fields are named by a
|
|
descriptor rather than pushed one at a time.
|
|
Without it a collector that never freed would pass everything
|
|
nested a chain of vecs sixty-four deep, traced through one root
|
|
sharing one object held three times — written through one path and read
|
|
through another, and swept once when the last goes
|
|
view M2 item 3: a typed container's view, driven directly over a
|
|
hand-built flan_vec header and a plain C array — the runtime
|
|
half of "typed containers into dyn as views", with no
|
|
compiler in the loop. Also carries the view-aware equality
|
|
review's third finding asked for: two views, a view against
|
|
a heap vec, equal contents and differing ones
|
|
layout the three restatements of flan_vec's layout — flan_rt.c's
|
|
real one, flan_dyn.c's mirror, and this file's [hand_vec] —
|
|
compared field by field, which is what turns a struct any one
|
|
of the three reorders into a FAIL line here instead of a
|
|
silent corruption at whichever view next reads through it
|
|
refuse:* twenty-four refusals, one process each, asserted on the sentence
|
|
as well as on the status: a process that died some other way is
|
|
not the guard firing, and the exit code cannot tell them apart
|
|
refuseview:* five more refusals, the view's own: out of range and a
|
|
mismatched write on each of the three element kinds, and a
|
|
push against a flat (slice or array) view
|
|
|
|
One binary, built once, run thirty-six times. The build is the expensive
|
|
part and the runs are milliseconds, which is what keeps this inside
|
|
`dune test` rather than behind an alias. *)
|
|
|
|
open Flan
|
|
|
|
(* The watchdog first: a hang is the one failure mode that reports nothing at
|
|
all. See watchdog.ml. *)
|
|
let () = Watchdog.arm ~seconds:600 "test_dyn"
|
|
|
|
let failures = ref 0
|
|
let fail fmt =
|
|
Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt
|
|
|
|
let scratch = Filename.get_temp_dir_name ()
|
|
let tmp name = Filename.concat scratch ("flan-dyn-" ^ name)
|
|
|
|
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
|
|
go 0
|
|
|
|
let () =
|
|
match Sys.command "command -v clang > /dev/null 2>&1" with
|
|
| 0 ->
|
|
let p =
|
|
Check.program
|
|
(Load.program ~file:"programs/dyn-host.flan"
|
|
(Reader.read_file "programs/dyn-host.flan")).Load.decls
|
|
in
|
|
let exe = tmp "ops" in
|
|
ignore (Build.executable ~csrcs:[ "dyn_ops.c" ] p ~out:exe);
|
|
|
|
let run mode =
|
|
let o = tmp (mode ^ ".out") and e = tmp (mode ^ ".err") in
|
|
let code =
|
|
Sys.command
|
|
(Printf.sprintf "%s %s > %s 2> %s" (Filename.quote exe)
|
|
(Filename.quote mode) (Filename.quote o) (Filename.quote e))
|
|
in
|
|
let out = In_channel.with_open_bin o In_channel.input_all in
|
|
let err = In_channel.with_open_bin e In_channel.input_all in
|
|
List.iter (fun x -> try Sys.remove x with Sys_error _ -> ()) [ o; e ];
|
|
(code, out, err)
|
|
in
|
|
|
|
(* The happy paths. Each assertion inside prints its own FAIL line, so the
|
|
output is the report and this only has to notice that there was one. *)
|
|
let code, out, err = run "ops" in
|
|
if code <> 0 || out <> "ops ok\n" then
|
|
fail "the operations\n got: %S (exit %d, err %S)" out code err;
|
|
|
|
(* The collector. Four sentences, each a yes: the high-water mark stayed
|
|
under half a megabyte across forty megabytes of allocation, the heap
|
|
settled small, the object count stayed bounded, and the hundred rooted
|
|
values were all still what they were set to. *)
|
|
let code, out, err = run "gc" in
|
|
let want_gc =
|
|
"peak under 512K: yes\nsettled under 32K: yes\n\
|
|
live objects bounded: yes\nlive set intact: yes\n"
|
|
in
|
|
if code <> 0 || out <> want_gc then
|
|
fail "a million allocations against a hundred live\n\
|
|
\ got: %S (exit %d, err %S)\n wanted: %S"
|
|
out code err want_gc;
|
|
|
|
(* And the control. A collector that never freed anything would pass every
|
|
other case in this file; this is the one it cannot. *)
|
|
let code, out, _ = run "unrooted" in
|
|
let want_un = "allocated: yes\nreclaimed all but the ring: yes\n" in
|
|
if code <> 0 || out <> want_un then
|
|
fail "an unrooted object\n got: %S (exit %d)\n wanted: %S"
|
|
out code want_un;
|
|
|
|
(* The aggregate roots the per-type descriptors added: a struct with dyn
|
|
fields at three offsets, one of them inside a nested struct, rooted by
|
|
address and descriptor rather than word by word.
|
|
|
|
The second line is the one that discriminates, and the first on its own
|
|
does not: a marker that walked every word of the struct would keep the
|
|
named fields too. So the struct also holds five hundred objects behind a
|
|
dyn word at an offset the descriptor leaves out, and the claim is that
|
|
they are *not* kept. *)
|
|
let code, out, _ = run "desc" in
|
|
let want_desc =
|
|
"aggregate root survives collection: yes\n\
|
|
a dyn at an offset the descriptor omits is not marked: yes\n\
|
|
and is reclaimed once dropped: yes\n"
|
|
in
|
|
if code <> 0 || out <> want_desc then
|
|
fail "an aggregate root\n got: %S (exit %d)\n wanted: %S"
|
|
out code want_desc;
|
|
|
|
let code, out, _ = run "nested" in
|
|
if code <> 0 || out <> "chain of 64 intact: yes\n" then
|
|
fail "a chain of nested vecs\n got: %S (exit %d)" out code;
|
|
|
|
let code, out, _ = run "sharing" in
|
|
let want_sh =
|
|
"three slots hold one object: yes\n\
|
|
write through one path is seen through another: yes\n\
|
|
shared object survives on the holder alone: yes\n\
|
|
still reachable: yes\n\
|
|
live bytes after dropping everything: ok\n"
|
|
in
|
|
if code <> 0 || out <> want_sh then
|
|
fail "interior sharing\n got: %S (exit %d)\n wanted: %S"
|
|
out code want_sh;
|
|
|
|
(* M2 item 3, the runtime's half: a flat view over a fixed C array (reads
|
|
box, writes tag-check, and a write through the view is the array's own
|
|
write and vice versa — proving it is a view and not a copy), a Vec
|
|
view over a hand-built header, pushed through twenty times so the
|
|
header's own [ptr] moves under it — the case that says the descriptor
|
|
pointing AT the header rather than snapshotting it is what survives a
|
|
growth — a bool view and a float view, so the element dispatch is
|
|
exercised on all three kinds dyn_ops.c's [view] carries, and
|
|
[dyn_equal] made view-aware: two views over equal bytes, two views
|
|
over different bytes, a view against an equal heap vec and against a
|
|
differing one. *)
|
|
let code, out, err = run "view" in
|
|
if code <> 0 || out <> "view ok\n" then
|
|
fail "a typed container's view\n got: %S (exit %d, err %S)"
|
|
out code err;
|
|
|
|
(* The three restatements of flan_vec's layout, compared field by field —
|
|
see dyn_ops.c's [layout] and [hand_vec]'s comment for what ties them
|
|
together and why nothing at compile time otherwise does. *)
|
|
let code, out, err = run "layout" in
|
|
if code <> 0 || out <> "layout ok\n" then
|
|
fail "flan_vec's three restatements\n got: %S (exit %d, err %S)"
|
|
out code err;
|
|
|
|
(* Every refusal. The pair is (mode, a phrase the sentence must contain);
|
|
the phrase is chosen to be the part that says *which* mistake it was,
|
|
so a message that named the wrong operation or the wrong tag would not
|
|
pass by accident.
|
|
|
|
The tag names are asserted here too, as words: "int" and "text" and not
|
|
2 and 4. A message with a number in it is a puzzle, and the rule is
|
|
written down in flan_dyn.c beside the table the words come from. *)
|
|
let refusals =
|
|
[ ("add", "dyn +: int and text");
|
|
("sub", "dyn -: nil and int");
|
|
("mul", "dyn *: bool and int");
|
|
("div", "dyn /: vec and int");
|
|
("rem", "dyn %: int and nil");
|
|
("divzero", "does not divide by zero");
|
|
("remzero", "does not divide by zero");
|
|
("divover", "one past the largest i64");
|
|
("lt", "dyn <: int and text");
|
|
("le", "dyn <=: text and nil");
|
|
("gt", "dyn >: vec and vec");
|
|
("ge", "dyn >=: bool and bool");
|
|
("len", "dyn len: int");
|
|
("at", "dyn at: int and int");
|
|
("atindex", "an index must be an int");
|
|
("atrange", "index 9 is out of bounds for text of length 2");
|
|
("atnegative", "index -1 is out of bounds");
|
|
("setattext", "a text is immutable");
|
|
("setatnotvec", "only a vec is assigned into");
|
|
("setatrange", "index 0 is out of bounds for vec of length 0");
|
|
("push", "only a vec is pushed to");
|
|
("needi64", "dyn i64: text");
|
|
("needf64", "dyn f64: int");
|
|
("needbool", "dyn bool: nil") ]
|
|
in
|
|
List.iter
|
|
(fun (mode, phrase) ->
|
|
let code, out, err = run ("refuse:" ^ mode) in
|
|
if code = 0 then
|
|
fail "%s returned rather than trapping: %S" mode out
|
|
else if not (has err phrase) then
|
|
fail "%s did not say %S; it said %S" mode phrase err)
|
|
refusals;
|
|
|
|
(* The view's own refusals: an index outside it, a write whose dyn tag
|
|
does not match the element the view holds — once per element kind, so
|
|
the tag-check is asserted on int, on float and on bool separately and
|
|
not only on the one this file happens to build first — and a push
|
|
against a flat (slice or array) view, which cannot grow by
|
|
construction and says so rather than corrupting whatever follows it
|
|
in memory. *)
|
|
let view_refusals =
|
|
[ ("range", "index 2 is out of bounds for vec of length 2");
|
|
("wrongwrite", "this view's elements are int");
|
|
("wrongbool", "this view's elements are bool");
|
|
("wrongfloat", "this view's elements are float");
|
|
("flatpush", "this view is a slice or an array and cannot grow") ]
|
|
in
|
|
List.iter
|
|
(fun (mode, phrase) ->
|
|
let code, out, err = run ("refuseview:" ^ mode) in
|
|
if code = 0 then
|
|
fail "%s returned rather than trapping: %S" mode out
|
|
else if not (has err phrase) then
|
|
fail "%s did not say %S; it said %S" mode phrase err)
|
|
view_refusals;
|
|
|
|
(try Sys.remove exe with Sys_error _ -> ());
|
|
(* A line on the way out, because a test that says nothing when it passes
|
|
is a test nobody can tell from a test that did not run. *)
|
|
if !failures = 0 then
|
|
Printf.printf " ok the dyn runtime: %d refusals and eight runs\n"
|
|
(List.length refusals + List.length view_refusals)
|
|
else exit 1
|
|
| _ -> print_endline "SKIP test_dyn: no clang"
|