Joseph Ferano
4fe2f36d98
Finishing the text family the previous lane started. All three are over [u8] and none of them allocates, which is what decides their shapes. trim answers a slice of its input. That is the only shape available without an allocator, and it is also the better one: there is no new storage, only a narrower view of the caller's, so the result dies with its owner and trimming modifies nothing. Both loops test (< lo hi), because an all-whitespace input otherwise walks lo past hi and (slice s lo hi) traps on a reversed range - the same trap the bounds table already asserts on. That input is in the case list. index-of-bytes is naive and stays naive. Boyer-Moore wants a skip table sized by the needle, which is an array, which is an allocation. The empty needle answers Some 0 so that index-of-bytes and starts-with? agree on every needle, and the length test returns before the loop so a needle longer than the haystack cannot build a window off the end. parse-f64 splits the work where the two halves actually differ: the grammar is Flan's and the rounding is libc's. parse-i64 is entirely Flan because strtoll's answers are wrong for a caller - 0 for "", 0 for "abc", 12 for "12x" - and not because decimal-to-binary conversion is suspect. Reimplementing correctly rounded conversion is a different and much larger problem than rejecting junk, and IEEE-754 already guarantees strtod gives the same bits everywhere. So this validates the whole slice and only a slice that is entirely a number reaches bytes->f64. Every refusal in the table - "", "abc", "1x", ".", "1e", " 1", "1 ", "0x10", "nan" - is a plausible number out of strtod. Two caveats, both written into the source rather than discovered later. The locale worry that keeps parse-i64 in Flan does apply to strtod's decimal point, and is moot only because nothing in the runtime calls setlocale; if that stops being true this is what breaks. And the length is capped at 511 because flan_bytes_to_f64 truncates there - a validator that approved 600 digits would be approving a different number than the one strtod reads. digit? and space? exist because parse-f64 and trim need them, and calc-me loses its own byte-identical digit?. One top-level namespace makes the second definition an error rather than a shadow, which is the rule doing its job: two copies that later drift apart is exactly what it prevents.
358 lines
17 KiB
OCaml
358 lines
17 KiB
OCaml
(* The milestone-2 acceptance test: a table of expression/result pairs run
|
|
through a compiled calc-me (plan.org, Build sequence).
|
|
|
|
It is a table rather than a golden file because milestone 3 runs the *same*
|
|
table on wasm32 — headless is what makes one test cover both targets. *)
|
|
|
|
open Flan
|
|
|
|
let failures = ref 0
|
|
|
|
let scratch = Filename.get_temp_dir_name ()
|
|
|
|
let run exe arg =
|
|
let out = Filename.concat scratch "flan-acceptance.out" in
|
|
let cmd =
|
|
Printf.sprintf "%s %s > %s 2>&1"
|
|
(Filename.quote exe)
|
|
(match arg with None -> "" | Some a -> Filename.quote a)
|
|
(Filename.quote out)
|
|
in
|
|
let code = Sys.command cmd in
|
|
let text = In_channel.with_open_bin out In_channel.input_all in
|
|
Sys.remove out;
|
|
(code, text)
|
|
|
|
let compile ?(opt = "-O2") ?(checks = true) ?(dev = false) path =
|
|
let exe =
|
|
Filename.concat scratch
|
|
("flan-t-" ^ Filename.remove_extension (Filename.basename path))
|
|
in
|
|
(* Through [Load], so a program with an (import ...) is buildable here: it
|
|
brings back the package's C shim and linker arguments as well. *)
|
|
let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in
|
|
let p = Check.program l.Load.decls in
|
|
ignore (Build.executable ~opts:{ Build.default with opt; checks; dev }
|
|
~csrcs:l.Load.csrcs ~lflags:l.Load.lflags p ~out:exe);
|
|
exe
|
|
|
|
(* No Str, and the reader is hand-written for the same reason. *)
|
|
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
|
|
|
|
let () =
|
|
match Sys.command "command -v clang > /dev/null 2>&1" with
|
|
| 0 ->
|
|
let exe = compile "../calc-me.flan" in
|
|
|
|
let case name arg expected_out expected_code =
|
|
let code, text = run exe arg in
|
|
if text <> expected_out || code <> expected_code then begin
|
|
incr failures;
|
|
Printf.printf
|
|
"FAIL %s\n got: %S (exit %d)\n wanted: %S (exit %d)\n"
|
|
name text code expected_out expected_code
|
|
end
|
|
in
|
|
let evaluates src expected = case src (Some src) (expected ^ "\n") 0 in
|
|
let rejects src = case src (Some src) "calc-me: cannot parse\n" 1 in
|
|
|
|
(* Arithmetic and precedence *)
|
|
evaluates "1 + 2 * (3 - 0.5) / 2" "3.5";
|
|
evaluates "1+2*3" "7";
|
|
evaluates "2*3+4" "10";
|
|
evaluates "(1+2)*3" "9";
|
|
evaluates "10/4" "2.5";
|
|
evaluates "7" "7";
|
|
evaluates " 7 " "7";
|
|
evaluates "1.5+2.25" "3.75";
|
|
|
|
(* Left-associative: 1-2-3 is (1-2)-3, not 1-(2-3) *)
|
|
evaluates "1-2-3" "-4";
|
|
evaluates "8/4/2" "1";
|
|
|
|
(* Unary minus, including nested *)
|
|
evaluates "-5" "-5";
|
|
evaluates "-(1+2)" "-3";
|
|
evaluates "3 * -2" "-6";
|
|
|
|
(* Whole input or nothing: trailing junk is an error, not ignored *)
|
|
rejects "1 +";
|
|
rejects "(1+2";
|
|
rejects "1 2";
|
|
rejects "";
|
|
rejects "+";
|
|
rejects "1+2)";
|
|
|
|
case "no argument" None "usage: calc-me \"1 + 2 * 3\"\n" 1;
|
|
(try Sys.remove exe with Sys_error _ -> ());
|
|
|
|
(* Programs whose whole output is fixed. These cover the milestone-2
|
|
surface calc-me does not reach — globals, 2-D arrays, places through a
|
|
pointer, casts, match with either arm taken, and the value semantics of
|
|
spec-memory.md. *)
|
|
let outputs ?opt ?dev name path expected =
|
|
let exe = compile ?opt ?dev path in
|
|
let code, text = run exe None in
|
|
if text <> expected || code <> 0 then begin
|
|
incr failures;
|
|
Printf.printf
|
|
"FAIL %s\n got: %S (exit %d)\n wanted: %S (exit 0)\n"
|
|
name text code expected
|
|
end;
|
|
(try Sys.remove exe with Sys_error _ -> ())
|
|
in
|
|
let values_out = "1\n5\nel\n" in
|
|
let machine_out = "12\n30\n2\n2\n3\n3.5\n42\n99\n12\n123\n" in
|
|
outputs "value semantics" "programs/values.flan" values_out;
|
|
outputs "machine surface" "programs/machine.flan" machine_out;
|
|
outputs "unit main exits 0" "programs/unit-main.flan" "ok\n";
|
|
(* The prelude's slice algorithms. Every assertion here is over an input a
|
|
wrong implementation fails: unsorted with duplicates, negatives and an
|
|
odd length; a reverse-sorted slice; and a sort of a subslice whose
|
|
neighbours must be untouched, which is the in-place, ptr+len claim
|
|
itself. At -O0 as well — a slice parameter is an alloca of a two-word
|
|
struct, and mem2reg is exactly what would hide it being copied. *)
|
|
let slices_out =
|
|
"5 -3 5 0 12 -3 7\n23\n-3\n12\n0\n-1\n99\n\
|
|
7 -3 12 0 5 -3 5\n-3 7 12 0 5 -3 5\n\
|
|
-3 -3 0 5 5 7 12\n1 2 3 4 5\n\
|
|
100 -1 0 4 9 9 200 300\n100 -1 0 4 9 9 200 300\n"
|
|
in
|
|
outputs "slice algorithms" "programs/slices.flan" slices_out;
|
|
outputs ~opt:"-O0" "slice algorithms, -O0" "programs/slices.flan" slices_out;
|
|
(* The byte predicates, parse-i64, and the two number helpers. The refused
|
|
parse-i64 cases are every shape strtoll answers 0 for — "", "abc",
|
|
"12x", "-", " 1" — so a None there is the whole reason the function is
|
|
Flan and not the bytes->i64 primitive. The RNG lines pin the actual
|
|
sequence off a fixed seed rather than just a range, which is the only
|
|
way a later change to the derivation gets caught; rand-u32 itself is
|
|
pinned by the sand hash. *)
|
|
let text_out =
|
|
"tfft\ntfftt\ntfftt\n\
|
|
1 -1 -1\n\
|
|
0 42 -42 7 9007199254740993\n\
|
|
-999 -999 -999 -999 -999\n\
|
|
1 -1 0\n\
|
|
0 2.5 10 0\n\
|
|
11 14 12 14 15\n5 5\n\
|
|
0.793725 0.324519 0.0835023\n"
|
|
in
|
|
outputs "bytes, parsing and numbers" "programs/text.flan" text_out;
|
|
outputs ~opt:"-O0" "bytes, parsing and numbers, -O0" "programs/text.flan"
|
|
text_out;
|
|
(* index-of-bytes, trim, the byte classes and parse-f64. The search cases
|
|
are the ones that separate a correct loop from a lucky one: a match
|
|
only at the end, "aab" in "aaab" (where the first byte matches twice
|
|
before the needle does), a needle longer than the haystack, which must
|
|
answer None without building a window off the end, and the empty needle
|
|
at Some 0. trim prints inside brackets so the all-whitespace answer is
|
|
visible as [] — that input is also the one that would build a reversed
|
|
slice and trap. And parse-f64's refusals are every shape strtod hands
|
|
back a plausible number for: "", "abc", "1x", ".", "1e", " 1", "1 ",
|
|
"0x10", "nan". *)
|
|
let bytes2_out =
|
|
"6 0 4 2 1 \n\
|
|
-1 -1 -1 0 0 0 \n\
|
|
[hi][hi][hi][][][a b][x][x]\n\
|
|
ttfff\n\
|
|
ttttff\n\
|
|
0 3.5 -3.5 0.25 1000 0.015 12\n\
|
|
-999 -999 -999 -999 -999 -999 -999 -999 -999 -999 -999\n\
|
|
1 0.5\n\
|
|
2.25\n"
|
|
in
|
|
outputs "substring, trim and parse-f64" "programs/bytes2.flan" bytes2_out;
|
|
outputs ~opt:"-O0" "substring, trim and parse-f64, -O0" "programs/bytes2.flan"
|
|
bytes2_out;
|
|
(* handler-bind and signal, spec-conditions.md §1 and §2: signal returns
|
|
Unit and carries on, an unhandled one is a no-op, a nested frame does
|
|
not displace the one outside it, and the stack is restored after. *)
|
|
let conditions_out = "0\n3\n23\n3\n1103\n1103\n" in
|
|
outputs "conditions" "programs/conditions.flan" conditions_out;
|
|
outputs ~opt:"-O0" "conditions, -O0" "programs/conditions.flan" conditions_out;
|
|
outputs ~dev:true "conditions, dev" "programs/conditions.flan" conditions_out;
|
|
(* restart-case and invoke-restart, §3 to §6: the transfer itself. A
|
|
fall-through with nothing handling it, a clause reached from two frames
|
|
down, the defer in between running on the way out, an inner frame
|
|
shadowing an outer one of the same name, and a handler that returns
|
|
normally still transferring nothing. At -O0 as well, because the guard
|
|
after every call is control flow the optimiser would otherwise launder;
|
|
and as a dev build, where every one of those calls goes through a cell. *)
|
|
let restarts_out = "101\n1\n-1\n2\n7\n1010\n101\n105\n-2\n" in
|
|
outputs "restarts" "programs/restarts.flan" restarts_out;
|
|
outputs ~opt:"-O0" "restarts, -O0" "programs/restarts.flan" restarts_out;
|
|
outputs ~dev:true "restarts, dev" "programs/restarts.flan" restarts_out;
|
|
(* §2's other half, which cannot be an [outputs] case because it does not
|
|
exit 0: a handler runs, returns normally, and has still not answered the
|
|
error, so the program stops and names the condition. *)
|
|
let exe = compile "programs/error.flan" in
|
|
let code, text = run exe None in
|
|
if code <> 134 || not (contains text "handler ran")
|
|
|| not (contains text "unhandled AssetMissing")
|
|
then begin
|
|
incr failures;
|
|
Printf.printf
|
|
"FAIL an unhandled error stops the program\n\
|
|
\ got: %S (exit %d)\n wanted: exit 134, naming the condition\n"
|
|
text code
|
|
end;
|
|
|
|
(* The raylib FFI, headless. GetColor, rectangle intersection and the
|
|
shapes texture need no window, so the whole boundary is exercised
|
|
without a display: a struct out of C through an out-pointer, a struct
|
|
into C through a pointer, a keyword resolved against an enum, and a
|
|
Flan string crossing as ptr+len.
|
|
|
|
Every case is asymmetric, which is the point. 0x11223344 comes back as
|
|
four separate bytes, so a Color is not the little-endian reading of the
|
|
packed integer. The intersection of (0,0,10,4) and (6,1,10,10) is
|
|
(6,1,4,3), four numbers from four different pairs of fields, so no
|
|
permutation of Rectangle survives it. And the shapes texture is stored
|
|
or replaced by 1 1 1 1 7 depending on which field is zero, which pins
|
|
Texture2D's id and format. Handing raylib a struct and reading it back
|
|
would have passed with any of those permuted — storing and returning is
|
|
symmetric. What the last case cannot pin, because nothing raylib
|
|
computes without a GL context reads them, is width, height and mipmaps
|
|
against each other.
|
|
|
|
The camera conversions are the strongest headless material here: both
|
|
are pure arithmetic over every field of a Camera2D and two Vector2s,
|
|
and both directions are asserted as absolute answers. A round trip
|
|
would not be — the inverse cancels a permuted layout exactly, the same
|
|
way store-and-return does. The rotated pair is the only thing in the
|
|
package that pins Vector2's own two fields, because every
|
|
component-wise formula is merely mirrored by exchanging x and y and so
|
|
compares equal; a rotation mixes them. It reports ok/bad rather than a
|
|
number because sinf and cosf make the answer 27.9999981, and this
|
|
table compares stdout byte for byte. *)
|
|
let raylib_out =
|
|
"17\n34\n51\n68\n\
|
|
6\n1\n4\n3\n\
|
|
7\n13\n17\n2\n4\n3.5\n7.25\n11.5\n13.75\n\
|
|
1\n1\n1\n1\n7\n\
|
|
7\n0\n17\n2\n4\n\
|
|
28\n24\n140\n90\n\
|
|
rotated screen-to-world ok\n\
|
|
rotated world-to-screen ok\n\
|
|
point in rect yes\npoint below rect no\n\
|
|
rects overlap yes\nrects apart no\n\
|
|
circles touch yes\ncircles clear no\n\
|
|
3\n7\n\
|
|
circle meets rect yes\ncircle clears rect no\n\
|
|
circle meets line yes\ncircle clears line no\n\
|
|
point in circle yes\npoint outside circle no\n\
|
|
point in triangle yes\npoint outside triangle no\n\
|
|
point on line yes\npoint off line no\n\
|
|
point in poly yes\npoint outside poly no\n\
|
|
in square, four corners yes\nout of triangle, three no\n\
|
|
no crossing\n"
|
|
in
|
|
if Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 then begin
|
|
outputs "raylib ffi, headless" "programs/raylib-ffi.flan" raylib_out;
|
|
(* And at -O0, for the reason the rest of the table is: every struct
|
|
here crosses as (addr v) on a local, which is the alloca mem2reg
|
|
would launder before anyone noticed it was wrong. *)
|
|
outputs ~opt:"-O0" "raylib ffi, headless, -O0" "programs/raylib-ffi.flan"
|
|
raylib_out
|
|
end
|
|
else
|
|
print_endline "acceptance: skipping the raylib FFI case (no libraylib)";
|
|
|
|
(* Again at -O0. Everything above runs through mem2reg, which launders a
|
|
sloppy alloca; -O0 tests the IR actually emitted, so a disagreement
|
|
between the two points at undefined behaviour rather than a typo. *)
|
|
(* sand.flan's simulation, headless. This is the milestone-4 acceptance
|
|
case: N frames from a seeded PRNG, one hash. It imports the sim package
|
|
and not raylib, deliberately — a program that imports raylib links
|
|
libraylib on every target, and this one is the version meant to run on
|
|
wasm32 too. The hash is reproducible only because rand-f32 is ours. *)
|
|
let sand_out = "2256461126764447066\n" in
|
|
outputs "sand, headless" "programs/sand-headless.flan" sand_out;
|
|
outputs ~opt:"-O0" "sand, headless, -O0" "programs/sand-headless.flan" sand_out;
|
|
|
|
outputs ~opt:"-O0" "value semantics, -O0" "programs/values.flan" values_out;
|
|
outputs ~opt:"-O0" "machine surface, -O0" "programs/machine.flan" machine_out;
|
|
|
|
(* And once more as a dev build. Every call in one goes through a cell, so
|
|
this is the same table asserting the indirection changes nothing before
|
|
anything has been redefined — the sand hash especially, since it is the
|
|
one result that would notice a call reaching the wrong function. *)
|
|
outputs ~dev:true "sand, headless, dev" "programs/sand-headless.flan" sand_out;
|
|
outputs ~dev:true "value semantics, dev" "programs/values.flan" values_out;
|
|
outputs ~dev:true "machine surface, dev" "programs/machine.flan" machine_out;
|
|
|
|
(* Bounds checks, NEXT.md item 2. A trap has no result — it has a nonzero
|
|
exit and a message on stderr — so it needs a case shape the table above
|
|
does not have. What is asserted is the *reason*: the location, and which
|
|
index against which length. The line and column are not pinned, because
|
|
editing the program should not break the test that reads it. *)
|
|
let bounds ?opt () =
|
|
let exe = compile ?opt "programs/bounds.flan" in
|
|
let traps name arg reason =
|
|
let code, text = run exe (Some arg) in
|
|
if code <> 134
|
|
|| not (contains text "programs/bounds.flan:")
|
|
|| not (contains text reason)
|
|
then begin
|
|
incr failures;
|
|
Printf.printf
|
|
"FAIL %s\n got: %S (exit %d)\n wanted: %S (exit 134)\n"
|
|
name text code reason
|
|
end
|
|
in
|
|
(* Both edges are in bounds and must not trap: the last index of a fixed
|
|
array, a slice ending exactly at len, and an empty slice at len. *)
|
|
let code, text = run exe (Some "0") in
|
|
if text <> "0ello\n" || code <> 0 then begin
|
|
incr failures;
|
|
Printf.printf "FAIL in-bounds edges\n got: %S (exit %d)\n" text code
|
|
end;
|
|
traps "at past a fixed array" "3"
|
|
"index 3 is out of bounds for length 3";
|
|
(* Negative indices sext to a huge unsigned, so the one unsigned
|
|
comparison catches them; the message still reports the signed value. *)
|
|
traps "at with a negative index" "-1"
|
|
"index -1 is out of bounds for length 3";
|
|
traps "at past a slice" "9"
|
|
"index 9 is out of bounds for length 5";
|
|
(* A different lowering — place/Pindex, not At — so it is its own case. *)
|
|
traps "set past a fixed array" "7"
|
|
"index 7 is out of bounds for length 3";
|
|
traps "slice with hi past len" "4"
|
|
"slice [4 9) is out of bounds for length 5";
|
|
(* Without the lo <= hi test this one would not trap: it would build a
|
|
slice of length hi - lo as a huge unsigned, which is worse. *)
|
|
traps "slice with a reversed range" "2"
|
|
"slice [2 1) is out of bounds for length 5";
|
|
(try Sys.remove exe with Sys_error _ -> ())
|
|
in
|
|
bounds ();
|
|
bounds ~opt:"-O0" ();
|
|
|
|
(* The release build drops them — the calls, that is; the two declarations
|
|
stay in the header and LLVM discards the unused ones. Asserted on the IR
|
|
rather than by running an unchecked out-of-bounds program, which has no
|
|
defined behaviour to assert on. *)
|
|
let p =
|
|
Reader.read_file "programs/bounds.flan" |> Parse.program |> Check.program
|
|
in
|
|
if not (contains (Emit.program p) "call void @flan_bounds_fail(") then begin
|
|
incr failures;
|
|
print_endline "FAIL checks on: no bounds call emitted"
|
|
end;
|
|
let off = Emit.program ~checks:false p in
|
|
if contains off "call void @flan_bounds_fail(" || contains off "call void @flan_slice_fail(" then begin
|
|
incr failures;
|
|
print_endline "FAIL --no-bounds-checks: a check survived"
|
|
end;
|
|
|
|
if !failures = 0 then print_endline "acceptance: all tests passed"
|
|
else begin
|
|
Printf.printf "\n%d failure(s)\n" !failures;
|
|
exit 1
|
|
end
|
|
| _ -> print_endline "acceptance: skipped (no clang on PATH)"
|