flan/test/test_sanitize.ml
Joseph Ferano f6ab3b62fc A struct's dyn fields become markable, so the refusal comes off
The crux was never where to put a descriptor; it was how an instance finds
one.  A bare struct on the stack has no header to hang a pointer off, and
giving it one would change the layout C interop agrees on, change the stride
of an array and change what embedding a struct in another costs.  So it has
none.  The instance never carries a pointer to its type and the collector
never derives one from the bytes: the pairing of an address with a descriptor
is made at the *push*, by the code that put the value there and therefore
knows its static type.  That is the same trick the shadow stack has always
used, and it makes the stack case the easy one rather than the impossible one.

A descriptor is the size of an instance, a count, and a table of byte offsets,
emitted once per type as private static data.  Flattened, not a graph — a
struct held by value contributes its offsets shifted by where it sits, and a
fixed array contributes its element's once per element — so nesting costs
nothing at run time and there is no recursion in the marker.  The offsets of a
big array would be a big table, and that is capped with a sentence rather than
half of the repeat form item 3 will bring.

Four places a value of such a type can live, and all four are rooted: a frame
slot, a global, the temporary a call's by-value return is spilled into, and
the slot a condition that is not a place is evaluated into.  The last two are
new and are the ones that were not obvious.  A callee roots its dyn words and
pops them in its epilogue, so between the return and the caller's store the
only copy is a register, which a collector that finds its roots by address
cannot see; the same hole was open for a Flan call answering a bare dyn and is
closed here too.  And a condition crosses as a pointer into the signalling
frame while a handler allocates, which is exactly what the original refusal
said could not be made safe.

dyn_roots grows into root_plan and both backends read it, which is what the
older note about one counter deciding both ends was always for.  The aggregate
temporaries are pooled by type rather than handed out in mint order: a
positional supply that drifted would pair an address with another type's
descriptor, and marking arbitrary offsets off a base is corruption where a
missed root is only a bug.  Pooled, the worst a drift can do is run out.

What is still refused is a dyn no static offset can reach — inside a typed
container, in a data type's payload or a union's members where the cases
overlay, or under an Option where the payload exists only beneath the tag.
A (Ptr S) and a [S] are deliberately not on that list: neither owns storage,
and the only storage this compiler hands out for such a type is a frame slot,
a global or a fixed array in one, all of them already rooted.  That is what
lets a handler clause take its (Ptr Cond) and read a dyn payload.

test/programs/dyn-struct.flan is the evidence.  It runs forty thousand rows
past flan_dyn.c's one-megabyte floor, so marks and sweeps really happen, and
it holds live values through them in all four places at once.  It has teeth:
with the descriptor walk stubbed out of the marker, the kept vector's length
comes back 24 instead of 628 and its first element is a stale word.  Clean
under ASan and UBSan, same output at -O2, -O0 and --x86.  dyn_ops.c grows an
aggregate-root mode so the runtime half can be wrong on its own, with a
header word holding a bit pattern that looks boxed and is not a dyn slot.

--no-gc still refuses, and had to be told how: a struct with a dyn field is a
collected value even when no expression in the program ever has the type dyn,
because a zeroed one still has a word the collector is asked to mark.

dune test --force: green, 0 failures across every suite.
2026-09-19 22:53:16 +07:00

421 lines
21 KiB
OCaml

(* The corpus a second time, under AddressSanitizer and
UndefinedBehaviorSanitizer.
Not part of [dune test] and deliberately so: a sanitized build of one
program is a 1.8MB statically linked binary and takes ten to twenty seconds
to produce, so the sweep is minutes where the whole existing suite is
seconds. It has its own alias.
dune build --root . @sanitize
What this can and cannot see is written down in [Build.opts] and in
[Emit]'s [sanitize] comment, and it is not symmetric:
- ASan reaches Flan code, but only because [Emit] puts [sanitize_address]
on every function it defines; the attribute is what the pass selects on
and hand-written IR has none by default. The positive control for that is
[oob], below, which must report.
- UBSan reaches the runtime's C and nothing else. Its checks are branches
clang's *frontend* emits, and no attribute asks an LLVM pass to produce
them, so the shift-past-the-width and float-cast questions this sweep was
partly meant to answer are not answerable this way. [shift] records that
as a test rather than as a paragraph: it is a program with unambiguous
shift UB in it, and it is expected *not* to be caught.
The check is two-sided. A marker in the sanitized run's output is a
failure, and so is any divergence from the unsanitized run — same output,
same exit status. The second half is not redundant: UBSan recovers by
default, so a program can trip a check, carry on with a different value and
still exit 0, and several of these programs exit nonzero by design, so
"exit status 0" is not available as a pass condition. *)
open Flan
(* The watchdog first: a hang is the one failure mode that reports
nothing at all. See watchdog.ml. *)
let () = Watchdog.arm ~seconds:3600 "test_sanitize"
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 ()
(* Leaks are off. Every allocation in the runtime is allocate-once-never-free
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.
[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} \
UBSAN_OPTIONS=${UBSAN_OPTIONS:-print_stacktrace=1} "
let run exe args =
let out = Filename.concat scratch "flan-sanitize.out" in
let cmd =
Printf.sprintf "%s%s %s > %s 2>&1" env (Filename.quote exe)
(String.concat " " (List.map Filename.quote args))
(Filename.quote out)
in
let code = Sys.command cmd in
let text = In_channel.with_open_bin out In_channel.input_all in
(try Sys.remove out with Sys_error _ -> ());
(code, text)
let compile ~sanitize ~checks path =
let exe =
Filename.concat scratch
(Printf.sprintf "flan-san-%s-%s"
(if sanitize then "s" else "p")
(Filename.remove_extension (Filename.basename path)))
in
let l = Load.program ~file:path (Reader.read_file path) in
let p = Check.program l.Load.decls in
let p, csrcs, lflags = Reach.link ~dev:false l p in
ignore
(Build.executable
~opts:{ Build.default with checks; sanitize } ~csrcs ~lflags p ~out:exe);
exe
let contains 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
(* What a report looks like, whichever sanitizer wrote it. *)
let markers =
[ "ERROR: AddressSanitizer"; "runtime error:"; "ERROR: LeakSanitizer";
"SUMMARY: UndefinedBehaviorSanitizer" ]
let reported text = List.exists (contains text) markers
(* The corpus. Excluded, with the reason, rather than quietly absent:
- raylib-*, and the windowed examples, because raylib and libm are not
instrumented and every report through them would be about somebody
else's code.
- break.flan and agent.flan, which stop in the break loop and wait for an
editor to connect. They are covered by test_agent against a real daemon.
- the dev-* and reload-* programs, which need a host process or a dlopen
harness. The reload path is half-covered at best in any case: a
redefinition module is built by llc and ld, not by clang, so nothing
instruments it — one more thing this sweep does not prove.
- nth-gone, pkg-hidden-main, pkg-two-aliases, pkg-two-mains, pkg-cycle,
which are negative cases and are expected not to compile.
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. *)
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
fixed array, a slice ending exactly at len, an empty slice at len —
which is the one the sweep has something to say about. The trapping
cases are where the ASan-without-bounds-checks question lives and they
are run separately; see [unchecked_controls]. Running this program with
*no* argument reads args[1] of a one-element argv, which is a bug in
the harness rather than in anything under test. *)
"programs/bounds.flan", [ "0" ];
"programs/arena-value.flan", [];
(* Here for what it would catch rather than for what it prints: the three
number conversions render into a frame slot the checker allocates per
call site, and a slot that ended up as a reclaimed temporary instead
would be a stack-use-after-scope — which is exactly what ASan sees and
an output comparison does not. *)
"programs/two-numbers.flan", [];
"programs/bytes2.flan", [];
"programs/cleanup.flan", [];
"programs/conditions.flan", [];
"programs/debug.flan", [];
"programs/debug-permuted.flan", [];
"programs/destructure.flan", [];
"programs/edn.flan", [];
(* The copy edn/read makes of every string: the document is read out of a
(Vec u8) that is then overwritten in place, so a reader still holding
views is reading a buffer it does not own and ASan is what says so. *)
"programs/edn-read.flan", [];
"programs/enum-compare.flan", [];
"programs/error.flan", [];
(* Makes and removes its own tree, so the two runs of the sweep see the
same directory; the new C here is three more path buffers, which is
exactly what this tool is for. *)
"programs/files.flan", [];
(* The unwinding handler, and here for the frames rather than for the heap:
every path it takes leaves a function through the transfer exit, where
a handler frame or a restart frame left on its stack is a pointer into
an alloca that has gone. An output comparison cannot see that until
something later calls through it; ASan sees it at the store. The
with-allocator case is the one that reaches the heap — the region it
rebound is released after the unwind has carried a value out of it. *)
"programs/handler-case.flan", [];
(* The same transfer exit, asked about the defers rather than the frames.
The bug this program was written for was a defer running over a binding
the form that would have written it had transferred out of, and the
cleanup was a free: the second run of that path frees a pointer nobody
stored. ASan is the regression guard and not the detector — an
uninitialised stack slot is not its bug class, and it reported nothing
on the broken binary; what named it was valgrind, and test_valgrind.ml
runs this program for that reason. *)
"programs/init-conditions.flan", [];
(* The JSON reader, which is the corpus's densest allocator: every string
in the document is a (Vec u8) grown a byte at a time and then handed
out as a view of its own block, and the block is never freed because
the view IS the answer. ASan is what says the view still points at the
block after the growth that moved it. *)
"programs/json.flan", [];
"programs/machine.flan", [];
"programs/math.flan", [];
"programs/math3.flan", [];
"programs/pkg-diamond.flan", [];
"programs/pkg-return.flan", [];
"programs/pkg-shared.flan", [];
"programs/pkg-unused.flan", [];
"programs/printers.flan", [];
"programs/println.flan", [];
"programs/restarts.flan", [];
(* The dyn programs, which reach flan_dyn.c from Flan rather than from the
hand-written C below — and the difference is the whole reason they are
here. [dyn_sweep] checks the collector against roots dyn_ops.c pushes
by hand; these check it against the roots the *compiler* emits, which
is the half no C test can reach. A root the emitter forgot is a live
object swept, and that is a use-after-free with the collector's own
hands on it.
[dyn-vec] is the one that builds objects of three kinds; [dyn-defer]
is the one whose roots come off on a transfer's path out rather than a
return's, which is where a pop written on one path only would show.
[p13] and [dyn-map] are the programs that allocate past flan_dyn.c's
one-megabyte floor, so they are where a mark and a sweep
actually run — everything else in this list agrees with ASan by never
collecting at all. [dyn-map] is also the one whose live set is a map,
so its keys and values are what the marker has to trace to be right,
and the interned keywords are what the sweep has to leave alone. *)
"programs/dyn-vec.flan", [];
"programs/dyn-defer.flan", [];
(* The per-type descriptors' own program, and the one in this list whose
roots are aggregates rather than dyn words: a struct with a dyn field
in a frame slot, in a global, in the temporary a by-value return lands
in, and as a condition's payload across a handler transfer. It runs
past the one-megabyte floor like [p13], so a mark and a sweep really
happen, and what a wrong descriptor offset looks like is a read of a
freed object — which is exactly what ASan is here to see and what no
amount of reading the offsets can. *)
"programs/dyn-struct.flan", [];
"programs/dyn-map.flan", [];
"../spike/x86/p13-dyn-collect.flan", [];
"programs/sand-headless.flan", [];
"programs/signedness.flan", [];
"programs/slices.flan", [];
"programs/string-of-bytes.flan", [];
"programs/text.flan", [];
(* The clock and getenv. getenv hands back a slice viewing the process
environment and never a copy, so a report here would be the one that
matters. *)
"programs/time.flan", [];
"programs/unit-main.flan", [];
"programs/utf8.flan", [];
"programs/values.flan", [];
"programs/virtual-controls-headless.flan", [];
"../calc-me.flan", [ "1 + 2 * (3 - 0.5) / 2" ] ]
let sweep ~checks label =
List.iter
(fun (path, args) ->
match compile ~sanitize:false ~checks path with
| exception Failure m -> fail "%s %s: unsanitized build: %s" label path m
| plain ->
(match compile ~sanitize:true ~checks path with
| exception Failure m -> fail "%s %s: sanitized build: %s" label path m
| san ->
let c1, t1 = run plain args in
let c2, t2 = run san args in
if reported t2 then
fail "%s %s: sanitizer report\n%s" label path t2
else if c1 <> c2 || t1 <> t2 then
fail "%s %s: diverged from the unsanitized run\n \
plain (exit %d): %S\n sanitized (exit %d): %S"
label path c1 t1 c2 t2;
(try Sys.remove plain with Sys_error _ -> ());
(try Sys.remove san with Sys_error _ -> ())))
corpus
(* The dyn runtime, under the same two sanitizers, driven from C. There are
Flan programs that reach flan_dyn.c now and three of them are in [corpus]
above — this used to say there were none — but they are a different
question and not a replacement for this one. They exercise the roots the
*compiler* emits, over the handful of operations a program happens to
write; this exercises every entry point in the header, with the roots
pushed by hand so that the runtime can be wrong on its own. The thing to
build is test/dyn_ops.c against programs/dyn-host.flan — the same pair
test_dyn.ml builds, with [sanitize] on.
This is the case the sweep is most likely to have something to say about.
Every other program in the corpus allocates and never frees, which is a
policy ASan can only agree with; this one frees, and a mark-sweep collector
is precisely a machine for freeing something that is still reachable. A
use-after-free here is what a wrong marker looks like from the outside, and
it is invisible to the assertions in test_dyn.ml — the freed bytes are
usually still the bytes that were there.
The leak question is not asked, for the reason [env] gives: leaks are off
across this file because the runtime's allocations are allocate-once by
design. It would be the wrong question here anyway — the temporaries ring
holds the last sixty-four objects alive on purpose and at exit, and every
one of them would be reported.
Only the modes that return are run. The refusals end in [_exit(134)], which
skips ASan's exit-time checks entirely, so running them would prove nothing
the checked build has not already proved. *)
let dyn_sweep () =
let exe = Filename.concat scratch "flan-san-dyn" in
let path = "programs/dyn-host.flan" in
let l = Load.program ~file:path (Reader.read_file path) in
let p = Check.program l.Load.decls in
let p, csrcs, lflags = Reach.link ~dev:false l p in
match
Build.executable
~opts:{ Build.default with Build.sanitize = true }
~csrcs:(csrcs @ [ "dyn_ops.c" ]) ~lflags p ~out:exe
with
| exception Failure m -> fail "dyn: sanitized build: %s" m
| _ ->
List.iter
(fun mode ->
let code, text = run exe [ mode ] in
if reported text then fail "dyn %s: sanitizer report\n%s" mode text
else if code <> 0 then
fail "dyn %s: exit %d under the sanitizers\n%s" mode code text)
[ "ops"; "gc"; "unrooted"; "desc"; "nested"; "sharing" ];
(try Sys.remove exe with Sys_error _ -> ())
(* The positive controls, which are the only evidence that a clean sweep means
anything. Both are written here rather than kept in test/programs because
neither is a program anybody should build: one reads off the end of an
array and the other shifts an i32 by 32. *)
let control ~expect_report ?(args = []) ~why name src =
let path = Filename.concat scratch (name ^ ".flan") in
Out_channel.with_open_bin path (fun ch -> Out_channel.output_string ch src);
let exe = compile ~sanitize:true ~checks:false path in
let _, text = run exe args in
(match expect_report, reported text with
| true, false -> fail "control %s: nothing reported. %s\n%s" name why text
| false, true -> fail "control %s: reported. %s\n%s" name why text
| _ -> ());
(try Sys.remove exe with Sys_error _ -> ());
(try Sys.remove path with Sys_error _ -> ())
(* The variant the checked build cannot ask for: with Flan's own bounds checks
off, is ASan enough on its own? bounds.flan is the program to ask it with —
every one of its selectors is a deliberate out-of-bounds access, and in a
checked build every one of them traps.
The answer is no, and it is worth having the shape of the no. [reports]
holds the cases ASan catches; the rest are listed with why it does not, and
they are printed rather than asserted, because a future LLVM that folds
differently would change them and that is information, not a regression.
[9] is the one that is not about ASan at all: at -O2 the access never
happens. The index is out of bounds on an [inbounds] getelementptr into a
string constant, so the whole load folds to zero and the program prints a
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. *)
let unchecked_controls () =
let reports = [ "3"; "7"; "4" ] in
let silent =
[ "-1", "a negative index into a global. Not a property of the access: \
ASan lays a global out as {data, redzone}, so an underflow is \
caught when something redzoned precedes it and not when nothing \
does — measured both ways, and here nothing does. Whether \
reading before an array is seen at all is therefore up to what \
the linker put in front of it";
"9", "at -O2 the load is folded away — an out-of-bounds inbounds GEP \
into a string constant is poison, so nothing is read and a wrong \
value is printed. Reported at -O0.";
"2", "a reversed slice (lo 2, hi 1), which this build traps on before \
anything is read. It is in this list rather than out of it \
because it used to be here for the opposite reason: the length \
came out negative, nothing was read, and ASan had nothing to \
see, which made a slice with a negative length reaching user \
code a checker question and not a sanitizer one. The checker \
answered it — lo <= hi is a representation invariant and no \
longer sits behind --no-bounds-checks — so ASan is still silent \
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
| exception Failure m -> fail "unchecked bounds.flan: build: %s" m
| exe ->
List.iter
(fun a ->
let _, t = run exe [ a ] in
if not (reported t) then
fail "unchecked bounds.flan %s: nothing reported, and this is the \
case that says ASan sees an unchecked build at all\n%s" a t)
reports;
List.iter
(fun (a, why) ->
let _, t = run exe [ a ] in
if reported t then
Printf.printf
"note unchecked bounds.flan %s now reports; it did not, on the \
grounds that %s\n" a why
else
Printf.printf "note unchecked bounds.flan %s: silent — %s\n" a why)
silent;
(try Sys.remove exe with Sys_error _ -> ())
let () =
match Sys.command "command -v clang > /dev/null 2>&1" with
| 0 ->
(* A read one past the end of a four-element global. Index 5 and not 9,
and the difference is worth knowing: ASan registers this array as
"16 bytes in a 32-byte slot", so the poisoned redzone is bytes 16..31.
Index 5 is byte 20 and is caught; index 9 is byte 36, past the
registration entirely, and is silent. Overrunning a small object by
enough lands back in ordinary memory. *)
control ~expect_report:true "flan-san-ctl-oob"
~why:"This sweep is not instrumenting Flan code at all — check that \
Emit still puts every define in the sanitize_address attribute \
group, without which -fsanitize=address covers the runtime's C \
and nothing else."
"(defvar arr [4 i32])\n\
(defn main [] i32\n\
\ (set (at arr 0) 1)\n\
\ (let [i 5] (print (at arr i)) (println \"\"))\n\
\ 0)\n";
(* Shift by the full width of the type: undefined in C, poison in LLVM,
and invisible to UBSan here because nothing emitted a check for it. If
this ever starts reporting, the note above is stale. *)
control ~expect_report:false "flan-san-ctl-shift"
~why:"UBSan has started seeing Flan code, which contradicts what this \
file and Build.opts both say it reaches. Good news; rewrite them."
"(defn main [] i32\n\
\ (let [x 1] (let [n 32] (print (<< x n)) (println \"\")))\n\
\ 0)\n";
(* A regression case, and the one defect this exercise found: a slice's
length is signed, (slice s 2 1) is -1, and flan_bytes_to_i64 cast that
to size_t before comparing it against its buffer — so the memcpy copied
63 bytes out of whatever the slice pointed at. Every other (ptr, len)
entry point in the runtime already guarded the negative case; these two
were the exceptions. A checked build traps on the reversed slice long
before this, which is why it needs an unchecked build to show. *)
control ~expect_report:false ~args:[ "2" ] "flan-san-ctl-negslice"
~why:"flan_bytes_to_i64 or flan_bytes_to_f64 is reading off the end of \
a negative-length slice again — see clamp_len in flan_rt.c."
"(defn main [args [string]] i32\n\
\ (let [s (bytes \"42\")\n\
\ n (i32 (bytes->i64 (bytes (at args 1))))]\n\
\ (print (bytes->i64 (slice s n 1)))\n\
\ (println \"\"))\n\
\ 0)\n";
sweep ~checks:true "checked";
dyn_sweep ();
unchecked_controls ();
if !failures = 0 then print_endline "sanitizer sweep: clean"
else Printf.printf "%d sanitizer failure(s)\n" !failures;
exit (if !failures = 0 then 0 else 1)
| _ ->
print_endline "no clang on PATH; sanitizer sweep skipped"