A (Vec T), a slice or a fixed array crossing into dyn no longer refuses; it is a view, one word in the box, over the container's own storage. Reads box the element on the way out; writes tag-check the dyn value's tag against the element type on the way in and trap, by name, on a mismatch, never coercing or silently storing. The open question the decision left — whether the descriptor points at the container or snapshots pointer and length beside it — is settled by kind. A Vec view holds the address of the Vec's own header (flan_rt.c's flan_vec, restated in flan_dyn.c under the file's standing "if either table changes, change both" rule) and reads ptr and len live on every operation, so a push that reallocates cannot leave it stale: flan_vec_grow overwrites that same header in place, and there is nothing captured at the crossing for the growth to invalidate. A slice and a fixed array cannot grow, so a flat view snapshots data and length once; pointing it at the value's own slot instead would be worse, since a slot's lifetime is not the slice's. The element set is i64, f64 and bool, not everything box already handles typed-to-dyn. A string element's dyn form is a pointer into the collector's heap, and a typed container's storage is arena or stack memory the collector never scans — a wider set would let a write plant a live reference nothing ever traces, which no care at the write site closes. (Vec string) and a typed (Map K V) keep the "does not cross into dyn yet" refusal, now for that reason. flan_dyn.c gains a fourth object kind, OBJ_VIEW, and flan_dyn_len/at/set_at/ push and the printer each grow one branch for it beside the existing vec one. A view's own stale-container check is the runtime's own spelling (flan_trap, park-and-inspect) rather than flan_rt.c's rt_die, per the duplicity doctrine; growing a Vec through a view calls flan_rt.c's own flan_vec_push rather than re-implementing doubling and allocator adoption a second time. (set (at target i) x) against a dyn target — a plain dyn vec or a view alike — was a hole in the base dyn milestone rather than something item 3 introduced; it is wired to flan_dyn_set_at here because a view's writes needed it to exist at all. Both backends: emit.ml and x86.ml both already passed a Vec or a Map to a runtime call by address rather than by value; a fixed array crossing into a view needed the same arm added in both, for the same reason — a copy would view the copy and never see a write to the caller's own array. test/dyn_ops.c drives the runtime directly with a hand-built Vec header and a plain C array, ahead of any compiler involvement: reads, writes on both element kinds, the tag-check refusal on every element kind, the range refusal, and the push that grows and moves a hand-built header out from under the view watching it. test_flan.ml turns the old "does not cross into dyn yet" refusal into acceptances for Vec/slice/array, keeps it for a string element and for Map, and adds the element-restriction refusal by name. test/programs/dyn-view.flan is the compiler-level survey: a Vec view mutated through both sides including the grow-and-move case, a fixed array's and a slice's views, a bool Vec's view, and its own two trapping modes for the acceptance rows to run against. test_sanitize.ml carries the survey's happy path; test_dyn.ml's new refusals are the runtime's own.
443 lines
23 KiB
OCaml
443 lines
23 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", [];
|
|
(* nil <-> None at (Option T), M2 queue item 4: an Option's tag is read
|
|
with a raw [Field] the surface language never writes (check.ml's
|
|
[box_option]/[unbox_option], the same access Render's structural
|
|
printer uses), so this is where a wrong tag offset or a wrong
|
|
direction of the comparison shows up as a read past the struct rather
|
|
than as a wrong answer. Both trap, by design — [nil-option] on a bare
|
|
T meeting a dyn nil, [some-nil] on (Some nil) built from a value the
|
|
checker could not see was nil — and the two-sided check above is what
|
|
ASan's build being asked to trap the same way the plain build does. *)
|
|
"programs/nil-option.flan", [];
|
|
"programs/some-nil.flan", [];
|
|
(* M2 item 3: a typed container's view. Mode 0, the survey — the modes
|
|
that trap are exercised as C refusals in test_dyn.ml's [refuseview:*]
|
|
instead, the same split [bounds.flan]'s "0" argument makes above. A
|
|
view's storage is a plain array or a Vec's own malloc block, neither
|
|
one this collector allocates, so there is nothing here for ASan to
|
|
catch that the runtime tests above did not already exercise directly
|
|
— this row is about the *compiler* lane: the address the checker
|
|
hands the runtime at the crossing, and whether a push through the
|
|
view that grows and moves the Vec leaves anything for ASan's
|
|
use-after-free detection to find. *)
|
|
"programs/dyn-view.flan", [ "0" ];
|
|
"../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"
|