(* 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 (* The watchdog first: a hang is the one failure mode that reports nothing at all. See watchdog.ml. *) let () = Watchdog.arm ~seconds:1200 "test_acceptance" 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 (* [Reach.link] decides the link from the program: a package nothing reachable calls into hands over no C and no linker argument, and its functions are not emitted. *) let p, csrcs, lflags = Reach.link ~dev l p in ignore (Build.executable ~opts:{ Build.default with opt; checks; dev } ~csrcs ~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; (* println, one row per arm of render.ml's walk. The walk is shared with the REPL, but its only coverage was the REPL tests -- a dev build, emitting to flan_dev_emit. This is the same walk with the other emitter in an ordinary build, which is a path nothing else takes. Three of these rows are load-bearing beyond "it prints something". The u64 reads 18446744073709551615 and not -1, which is what a second shim exists for. The Blob's name is quoted and escaped while the two strings at the top are raw, which is the top-level/nested split and the thing most likely to be "tidied up" into being wrong. And the Option rows are an arm that never ran until now: a field of an Option had no gep in emit.ml, so the REPL would have failed on one too. At -O0 as well -- the slice arm allocates slots in the enclosing function's frame and emits a loop, and mem2reg is the pass that would hide a mistake in either. *) let println_out = "plain string\nplain bytes\n42\n-7\n5\n18446744073709551615\n3.5\n\ -0.25\ntrue\nfalse\n()\n:green\n:red\n\n(some 0)\nnone\n\ (Blob {.id 7 .name \"sandy \\\"quoted\\\"\" .pos (V {.x 1.5 .y -2}) .tags [ 0 42 0]})\n\ [ 0 0 9 0]\n[ 0 0 0 0 0 0 0 0 ...]\n[ 0 9 0]\n\ (D1 {.d (D2 {.d (D3 {.d (D4 {.d (D5 {.n ...})})})})})\n[ 0 0]\n\ [ 0 0]\n[ 9 0]\n" (* The escape buffer is 1024 and the input is 1100 x's, so this is the truncation: the ellipsis goes *inside* the quotes, and the count is spelled out rather than pasted so that a change to the buffer or to the reserve shows up here as a number and not as a wall of x. *) ^ "(Long {.s \"" ^ String.make 1014 'x' ^ "...\"})\n" ^ "abc\n" in outputs "println, every arm" "programs/println.flan" println_out; outputs ~opt:"-O0" "println, every arm, -O0" "programs/println.flan" println_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; (* Rounding and sqrt. Every case here is a *negative* or a half, because those are the two places a plausible wrong version differs: a floor written as the bare cast truncates toward zero and answers -2 for -2.5, and a round written as (floor-f32 (+ x 0.5)) is half-up rather than half-away and answers -2 as well. 16777216.0 is past 2^24, where the guard rather than the cast has to produce the answer — and where the cast it guards would be out of i32's range. sqrt is a `declare` on libm's sqrtf; the -O0 run is the one that matters for it, because at -O2 LLVM folds most calls into the hardware instruction and a symbol that never has to resolve proves nothing about the link. *) let math_out = "2 2 2 -3 -2 -3 0 -1 \n\ 3 2 3 -2 -2 -2 1 0 \n\ 0 0 -0 \n\ 2 3 3 -2 -3 -3 1 -1 \n\ 1.67772e+07 1.67772e+07 1.67772e+07 -1.67772e+07 \n\ 0 1 2 1.41421 0.5 1000 \n\ 5 \n" in outputs "rounding and sqrt" "programs/math.flan" math_out; outputs ~opt:"-O0" "rounding and sqrt, -O0" "programs/math.flan" math_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; (* (string b). The conversion emits nothing — String and Slice _ are the same %slice — so the rows are about length and ownership rather than arithmetic: a number round-tripped, an empty slice, sub-views whose length is not the underlying storage's, and the result crossing a declare-c boundary where the shim NUL-terminates a copy. That last one is the load-bearing case: "hello world" cut to five bytes has a space where C wants a NUL, so a shim that trusted the bytes would print all eleven. Both levels, because a reinterpretation that had accidentally been undefined would fail one way at -O0 and the other at -O2. *) let string_of_bytes_out = "[42] 2\n[-7] 2\n[0] 1\n[] 0\n\ [hello] 5\n[world] 5\n[] 0\n\ 7\n\ hello\nok\n12345\nok\n\nok\n" in outputs "string of bytes" "programs/string-of-bytes.flan" string_of_bytes_out; outputs ~opt:"-O0" "string of bytes, -O0" "programs/string-of-bytes.flan" string_of_bytes_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. Then §3's parameters: one, two of them in an order a sum would not pin, a string beside an integer, a clause taking none in the same form as clauses taking some, and an argument that is a call to a function reached from nowhere else. The last one is the reachability claim — an invoke-restart whose arguments were not walked would drop [half] and fail to link, which is why the arguments are evaluated into slots before the node rather than hanging off it. *) let restarts_out = "101\n1\n-1\n2\n7\n1010\n101\n105\n-2\n42\n34\n7\nsupplied\n5\n42\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; (* §3's run-time check, which is the price of a restart being found by name on a dynamic stack: neither end of an invoke can see the other, so what a clause takes against what was given is settled where the transfer starts. Each of these stops the program, so each is asserted on its reason rather than on the exit status alone — too few arguments, the right count of the wrong type, and arguments handed to a clause that takes none. *) let restart_mismatch ?opt () = let exe = compile ?opt "programs/restarts.flan" in let refuses name arg reason = let code, text = run exe (Some arg) in if code <> 134 || not (contains text "programs/restarts.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 refuses "a restart invoked with too few arguments" "1" "restart use-value takes (i32), given ()"; refuses "a restart invoked with the wrong type" "2" "restart use-value takes (i32), given (string)"; refuses "arguments given to a restart that takes none" "3" "restart retry takes (), given (i32)"; (* §4 meets §3. The name finds the innermost frame offering it and the signature is checked against *that*; nothing searches outward for a frame the arguments would have fitted, and an outer clause that would have taken them is not consulted. *) refuses "a shadowing clause of the same name and a different signature" "4" "restart use-value takes (string), given (i32)"; (try Sys.remove exe with Sys_error _ -> ()) in restart_mismatch (); restart_mismatch ~opt:"-O0" (); (* The other way a transfer starts is the break loop, which chooses a restart by position and has nothing to fill parameters in with. It reaches the clause through the same channel an invoke-restart writes, so nothing downstream could tell the two apart — except that the clause's buffer is still the zero the frame was pushed with. Asserted on the IR, because driving it needs a stopped program and a socket, and what is being claimed is that the guard exists at all. *) let p = Reader.read_file "programs/restarts.flan" |> Parse.program |> Check.program in if not (contains (Emit.program p) "call void @flan_restart_unarmed(") then begin incr failures; print_endline "FAIL a clause with parameters has no guard against being taken \ without any" end; (* What is refused before anything runs, and why. Not everything about a restart's arguments waits for run time: the shape of the form and whether an argument is a value at all are here, and each is asserted on its reason. *) let refuses_src name src needle = match Check.program (Parse.program (Reader.read_all ~file:"" src)) with | _ -> incr failures; Printf.printf "FAIL %s\n it was accepted\n" name | exception Loc.Error (_, m) -> if not (contains m needle) then begin incr failures; Printf.printf "FAIL %s\n said: %S\n wanted: %S in it\n" name m needle end in (* The name is still a quoted symbol, and now it is the *first* of several things, so an unquoted one has to say what the form is rather than read as a call with a spare argument. *) refuses_src "invoke-restart without a quoted name" "(defn main [] i32 (invoke-restart use-value 1) 0)" "a quoted restart name and then its arguments"; (* A clause parameter is a binding, so it needs something to hold. *) refuses_src "a restart parameter that is not a value" "(defn main [] i32 (restart-case 0 (use-value [v Unit] 1)))" "which is not a value"; (* And so does an argument: a [println] is Unit, and there would be nothing to store into the clause's buffer. *) refuses_src "a restart argument that is not a value" "(defn main [] i32 (restart-case 0 (use-value [v i32] v))\n\ \ (invoke-restart 'use-value (println \"\")) 0)" "a restart argument must be a value"; (* An embed reads the bytes before any value exists, so the path has to be a literal - Odin's rule and for Odin's reason (check_load_directive refuses anything that is not Addressing_Constant). This is the refusal that keeps the result genuinely free at run time. *) refuses_src "an embedded path that is computed" "(defn main [] i32 (let [p \"x\"] (len (embed p))))" "must be a literal string"; (* A file that is not there is a compile error naming it, not an empty embed: an asset silently missing is the class of quiet wrongness this whole feature exists to remove. *) refuses_src "an embedded file that does not exist" "(defn main [] i32 (len (embed \"no-such-asset.bin\")))" "cannot embed"; (* A directory where a file was meant. On Linux open_in_bin on a directory succeeds and the *read* is where EISDIR arrives, so this was an uncaught exception out of the checker until the whole read was guarded - the one way a user could make the compiler crash rather than refuse. *) refuses_src "embed given a directory" "(defn main [] i32 (len (embed \"programs/assets\")))" "it is a directory"; (* One extra argument, and `string` is the only thing it can be. Two spellings, not one form that changes type with its context. *) refuses_src "embed asked for a type it cannot read a file as" "(defn main [] i32 (len (embed \"no-such-asset.bin\" i32)))" "`string` is the only one"; (* Allocators, spec-memory.md. The tier on its own, with no container above it, so that a failure here is not read as a Vec bug. What is asserted is the capability set differing per allocator, the context rebinding for a dynamic extent and restoring — out of a call and out of a *transfer* — and free-all moving the epoch while keeping the pages. At -O0 as well, because with-allocator's restore on the transfer path is control flow an optimiser would otherwise launder, and as a dev build, because the call inside the body then goes through a cell. *) let allocators_out = "true\nfalse\nfalse\ntrue\ntrue\nfalse\nfalse\ntrue\n41\n0\n1\n2\n2\ntrue\ntrue\n" in outputs "allocators" "programs/allocators.flan" allocators_out; outputs ~opt:"-O0" "allocators, -O0" "programs/allocators.flan" allocators_out; outputs ~dev:true "allocators, dev" "programs/allocators.flan" allocators_out; (* free-all on an allocator that does not offer it traps rather than doing nothing, because "I released the region" and "I leaked the region" must not be the same program text. Its own case for the same reason the bounds traps are: a trap has no result, only an exit and a message. *) let exe = compile "programs/free-all-refused.flan" in let code, text = run exe None in if code <> 134 || not (contains text "programs/free-all-refused.flan:") || not (contains text "does not offer free-all") then begin incr failures; Printf.printf "FAIL free-all on an allocator without it\n\ \ got: %S (exit %d)\n wanted: exit 134, naming the site\n" text code end; (try Sys.remove exe with Sys_error _ -> ()); (* (Vec T), spec-memory.md. Two element types over one type-erased runtime, which is the whole claim: size_of and align_of are produced at the concrete call site and nothing below it knows the element type. The moves are here too — into a call and out of one — because a Vec that cannot be handed to a function is not a container anyone can use. *) let vec_out = "0\n3\n10\n30\n99\n139\n2\n99\n-1\n10\n3\n4\n\ \n\n2\n4\n7\nfalse\n11\n5\n" in outputs "vec" "programs/vec.flan" vec_out; outputs ~opt:"-O0" "vec, -O0" "programs/vec.flan" vec_out; outputs ~dev:true "vec, dev" "programs/vec.flan" vec_out; (* A debug build, because [dty] is a separate path from everything above: [outputs ~dev:true] goes through the cells, not through DWARF, and a type with no arm there dies at emit rather than being merely undebugged. That is NEXT.md's landed item 2 exactly — [field_addr] took only [Types.Named], so the printer's Option arm had never run. Asserted on the metadata as well as on the program still working: a composite whose element count disagreed with [lay] would print plausible values for the wrong fields, which is the failure debug info has. *) let dbg = Emit.program ~debug:true (Check.program (Parse.program (Reader.read_file "programs/vec.flan"))) in if not (contains dbg "name: \"Allocator\"") || not (contains dbg "name: \"(Vec i32)\", size: 384") then begin incr failures; print_endline "FAIL debug info for Allocator and (Vec T)" end; (* StorageExhausted and retry. The allocator is genuinely exhausted — a ceiling on live bytes, hit repeatedly — and the handler raises it and invokes retry, so the same request is re-attempted and no push is lost. Every allocating operation is covered, not only push: reserve asks for the whole block at once and clone asks for the source's length. At -O0 because the retry loop and the guard after the error are control flow an optimiser would otherwise launder. *) let exhausted_out = "64\n0\n126\ntrue\ntrue\n4\ntrue\n0\n8\n7\ntrue\n" in outputs "storage exhausted, retried" "programs/exhausted.flan" exhausted_out; outputs ~opt:"-O0" "storage exhausted, retried, -O0" "programs/exhausted.flan" exhausted_out; outputs ~dev:true "storage exhausted, retried, dev" "programs/exhausted.flan" exhausted_out; (* The same exhaustion with nothing handling it. [error] is the diverging variant: the program stops on the frame that erred rather than carrying on with a push that appended nothing, which is the Odin outcome the rule exists to make impossible. *) let exe = compile "programs/exhausted-unhandled.flan" in let code, text = run exe None in if code <> 134 || not (contains text "before") || not (contains text "unhandled StorageExhausted") || contains text "unreachable" then begin incr failures; Printf.printf "FAIL an unhandled StorageExhausted stops the program\n\ \ got: %S (exit %d)\n wanted: exit 134, naming the condition\n" text code end; (try Sys.remove exe with Sys_error _ -> ()); (* -- Files, NEXT.md decisions 1, 2 and 5 -------------------------- Embedding first, because it is the one that costs nothing at run time and needs no host ABI at all: a compiler feature, so no linker arguments, no per-target packaging, and identical on desktop and web. At -O0 and as a dev build too - a dev build emits a defconst as a mutable global, so the (embed-dir) constant travels a different path there and is worth seeing twice. *) let embed_out = "13\nhello from a\nBBB\n4\n0\n255\n254\n3\na.txt\nb.bin\nraw.bin\nBBB\n\ no nope.txt\n" in outputs "embed, a file and a directory" "programs/embed.flan" embed_out; outputs ~opt:"-O0" "embed, -O0" "programs/embed.flan" embed_out; outputs ~dev:true "embed, dev" "programs/embed.flan" embed_out; (* slurp and barf, with all three restart paths taken: use-value on a read, use-value on a write, and retry after the handler made the file. The typed restart is the thing being exercised as much as the file I/O - this is the first restart clause the *compiler* emits with a parameter, and its parameter is the path slot the attempt reads. *) let slurp_out = "13\nhello from a\n4\n0\n255\n3\nBBB\n1\ntrue\ntrue\n\ programs/assets/does-not-exist\n11\nround trip\n1\ntrue\nsecond\n\ made by the handler\n1\ntrue\n" in let clean () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ "slurp-out.txt"; "slurp-made.txt" ] in clean (); outputs "slurp and barf, with restarts" "programs/slurp.flan" slurp_out; clean (); outputs ~opt:"-O0" "slurp and barf, -O0" "programs/slurp.flan" slurp_out; clean (); outputs ~dev:true "slurp and barf, dev" "programs/slurp.flan" slurp_out; clean (); (* slurp's use-value is the first restart clause the *compiler* emits with a parameter - alloc_guard's retry takes none - so the guard against the break loop taking it with nothing to fill the parameter in with is worth asserting here too. It is the same emit.ml path a hand-written typed clause goes through (the restarts.flan case above), and this says the compiler-emitted one is on it rather than beside it. *) let p = Reader.read_file "programs/slurp.flan" |> Parse.program |> Check.program in if not (contains (Emit.program p) "call void @flan_restart_unarmed(") then begin incr failures; print_endline "FAIL the compiler-emitted use-value has no guard against being taken \ without an argument" end; (* The desktop half of the one program whose behaviour differs by target. test_web.ml builds this same text for the browser and asserts the other outcome: there `barf` signals and the program says which file it could not write, here it writes it. No conditional compilation is involved in either - nothing in parse.ml or check.ml reads the target, and the whole of the difference is one #ifdef in flan_rt.c. Seeing both halves is what makes the claim a test rather than an assertion. *) (try Sys.remove "web-files-out.txt" with Sys_error _ -> ()); outputs "files, the desktop half of the web case" "programs/web-files.flan" "hello from a\nwrote it\n"; (try Sys.remove "web-files-out.txt" with Sys_error _ -> ()); (* A missing file with nothing handling it. The same rule StorageExhausted follows: [error] is the diverging variant, so the program stops on the frame that erred rather than carrying on with a Vec that was never filled. Neither restart is taken and both were still offered. *) let exe = compile "programs/slurp-unhandled.flan" in let code, text = run exe None in if code <> 134 || not (contains text "before") || not (contains text "unhandled FileError") || contains text "unreachable" then begin incr failures; Printf.printf "FAIL an unhandled FileError stops the program\n\ \ got: %S (exit %d)\n wanted: exit 134, naming the condition\n" text code end; (try Sys.remove exe with Sys_error _ -> ()); (* The epoch trap: a container whose allocator has been released. This is spec-memory.md's shipping answer to "Open: catching a use-after-release statically" — detection, loud and immediate, rather than a static rule that with-allocator and context/allocator deny the knowledge for. What is asserted is the reason and the site, not the line. *) let exe = compile "programs/stale-region.flan" in let code, text = run exe None in if code <> 134 || not (contains text "programs/stale-region.flan:") || not (contains text "allocator was released") then begin incr failures; Printf.printf "FAIL a container used after its region was released\n\ \ got: %S (exit %d)\n wanted: exit 134, naming the site\n" text code end; (try Sys.remove exe with Sys_error _ -> ()); (* The same trap on the Map's side, and it is not the same code path: a Vec's operations check on the way in and stop there, while a map's get goes on to call a hash and an equality function through pointers into the block. A missing check here is not a wrong number, it is a probe loop walking released memory. *) let exe = compile "programs/map-stale-region.flan" in let code, text = run exe None in if code <> 134 || not (contains text "programs/map-stale-region.flan:") || not (contains text "allocator was released") || not (contains text "20") then begin incr failures; Printf.printf "FAIL a map used after its region was released\n\ \ got: %S (exit %d)\n wanted: exit 134, naming the site\n" text code end; (try Sys.remove exe with Sys_error _ -> ()); (* §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\ axes 0 0 0 0 -1 -1 past-end 0\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)"; (* The same boundary, from declarations nobody wrote. Every binding this program calls came out of raylib's header through vendor/raylib/headers; the package binds none of the four by hand, so if it runs at all the importer produced working declarations. What it prints pins more than that. ColorToInt of {17,34,51,68} is 0x11223344 — the four fields read in r,g,b,a order, so exchanging any two changes the number — and ColorTint by white is the identity, which hands the four bytes back separately. That is the same argument the GetColor case makes and for the same reason: handing a struct over and reading it back proves nothing, because storing and returning is symmetric and a permuted layout comes back permuted the same way. TextLength of "hello" is 5, which is only true if the generated wrapper NUL-terminated the copy. Skipped without FLAN_RAYLIB_H, because the import is opt-in — a build needs libraylib linkable and not raylib-devel installed, and that is a property worth keeping. The importer's own table does not skip: it runs against test/headers/sample.h, which is committed. *) (match Sys.getenv_opt "FLAN_RAYLIB_H" with | Some h when Sys.file_exists h && Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 -> let out = "10\n5\n287454020\n17\n34\n51\n68\n" in outputs "raylib, bindings read from the header" "programs/raylib-imported.flan" out; (* At -O0 too, 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, bindings read from the header, -O0" "programs/raylib-imported.flan" out | _ -> print_endline "acceptance: skipping the imported-bindings case (FLAN_RAYLIB_H unset)"); (* raylib's Image family, headless, and the strongest FFI case here: an Image is pixels in RAM, so raylib *computes* with it rather than storing and returning it. Two separate things are pinned. gen-image-color is handed two scalars and answers with a struct reading 4, 2, 1, 7 — four distinct values in four adjacent i32 slots, so exchanging any two of width, height, mipmaps and format is visible, and dropping `data` makes width the low half of raylib's pointer. Scalars in and fields out is what makes that work: a permuted layout has nothing to cancel against, unlike the shapes texture, where nothing without a GPU read width, height or mipmaps at all. The other is the axis, which the collision cases could not get. raylib indexes a pixel as y*width + x, and the image is 4 wide by 2 tall, so (3,0) exists and its transpose does not — exchange x and y in the shim and the read is out of bounds and answers transparent black. The horizontal and vertical flips are the same argument twice more: on two rows, one of them moves a mark that the other leaves alone. The PNG round trip is not the symmetric trap either: stb's encoder and decoder are external ground truth and agree with each other rather than with whatever field order Flan believes in. It also crosses a path as ptr+len. /tmp is written to, and both optimisation levels write the same bytes, so the shared name is harmless. Trace logging stays at :warning and no read here is out of bounds, so a warning appearing in this output is a real failure — [run] folds stderr in. *) let raylib_image_out = "generated 4 2 1 7\n\ at 3,0 200 0 0 255\n\ at 0,1 0 200 0 255\n\ at 0,0 10 20 30 255\n\ at 3,1 10 20 30 255\n\ flipped-h at 0,0 200 0 0 255\n\ flipped-h at 3,1 0 200 0 255\n\ flipped-h at 3,0 10 20 30 255\n\ flipped-v at 0,1 200 0 0 255\n\ flipped-v at 3,0 0 200 0 255\n\ flipped-v at 0,0 10 20 30 255\n\ exported yes\n\ loaded valid yes\n\ loaded 4 2 1 7\n\ loaded at 0,1 200 0 0 255\n\ loaded at 3,0 0 200 0 255\n\ loaded at 0,0 10 20 30 255\n\ resized-nn 8 2 1 7\n\ nn at 0,1 200 0 0 255\n\ nn at 1,1 200 0 0 255\n\ nn at 6,0 0 200 0 255\n\ nn at 7,0 0 200 0 255\n\ nn at 2,1 10 20 30 255\n\ resized 2 6 1 7\n\ cropped 2 1 1 7\n\ cropped at 1,0 200 0 0 255\n\ cropped at 0,0 10 20 30 255\n" in if Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 then begin outputs "raylib images, headless" "programs/raylib-image.flan" raylib_image_out; outputs ~opt:"-O0" "raylib images, headless, -O0" "programs/raylib-image.flan" raylib_image_out end else print_endline "acceptance: skipping the raylib Image case (no libraylib)"; (* raylib's Wave family, headless — and the first claim to make about it is that it exists. The received wisdom in this repository was that audio needs a device and so cannot be in this table at all. That is true of Sound, Music and AudioStream, every one of which is a handle the miniaudio mixer owns, and false of Wave: samples in RAM and four integers describing them, with copy, crop, reformat, export, load and decode all running on the CPU. So it gets the Image family's treatment. Three shapes, and they pin different things. wave-format is the scalars-in/fields-out case gen-image-color is: three plain integers go in and all four u32 fields come out, with frame-count *computed* from the ratio of the sample rates — 16, from eight frames at twice the rate, and no argument named it. Eight bits rather than sixteen in that call so sample-size cannot be confused with the frame count it would otherwise equal. export-wave then load-wave is external ground truth, the PNG argument transposed: dr_wav writes the header from three fields and reads them back, agreeing with itself rather than with Flan's field order. Be precise about its reach, because it is narrower than it looks — it catches sample-size against channels (the "loaded" line reads "8 8000 16 16" when those two are exchanged) and NOT frame-count against sample-rate, which leaves every line of the round trip green. The crop and the reformat are what catch that pair. And the decoded samples are the axis discriminator this section needed. load-wave-samples answers a (Ptr f32), which Flan cannot index — [at] takes an array, a slice or a string — so the program crops to a single frame first and dereferences sample 0. That detour is what makes the case strong rather than weak: raylib's crop offset is init-frame times channels times sample-size over 8, so asking for frame 3 and getting +3000 pins sample-size against channels. Exchange those two and the crop lands two bytes off and the sample is a different number, not the same one mirrored, which is the failure mode axis-aligned geometry could never produce. Verified red by permuting the Wave defstruct three ways: frame-count with sample-rate (cropped reads "8 4 16 1" and reformatted "16000 16000000 8 2", while the file round trip stays green — see above), sample-size with channels (every frame read turns to "no" and the loaded line reads "8 8000 16 16"), and data moved to the front (the run dies after two lines). *) let raylib_audio_out = "valid yes\n\ source 8 8000 16 1\n\ cropped 4 8000 16 1\n\ reformatted 16 16000 8 2\n\ frame 1 is +1000 yes\n\ frame 3 is +3000 yes\n\ frame 4 is -3000 yes\n\ frame 0 is zero yes\n\ exported yes\n\ loaded valid yes\n\ loaded 8 8000 16 1\n\ loaded frame 1 is +1000 yes\n\ loaded frame 4 is -3000 yes\n" in if Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 then begin outputs "raylib audio, headless" "programs/raylib-audio.flan" raylib_audio_out; outputs ~opt:"-O0" "raylib audio, headless, -O0" "programs/raylib-audio.flan" raylib_audio_out end else print_endline "acceptance: skipping the raylib Wave case (no libraylib)"; (* raylib's Font family, headless, which the package refused to bind at all until now. The stated reason was that a Font drags in two more aggregates and two owned arrays "for something with no headless test at the end of it". The generator takes all of it unchanged — a struct held by value is emitted after what it contains, one held by pointer is forward-declared — and the test turned out to exist. What makes it exist is that the program does not ASK raylib for a font. Every call that makes one needs a window or a TTF and a GL context. So it builds one out of Flan arrays, field by field, and hands it over to be computed with: three glyphs, three atlas rectangles, a base size of 10 and a texture that is a lie in every field but [id]. Text measuring is pure arithmetic over exactly those fields, so this is scalars in and numbers out with no raylib-produced struct anywhere for a permutation to cancel against. The one raylib trap worth recording: MeasureTextEx returns (0,0) immediately when font.texture.id is 0. The hand-built font claims an id of 1, and that guard is what pins where the Texture2D sits inside the Font — land it elsewhere and every measurement collapses to zero. Glyph C carries an advance of 0 deliberately, which sends raylib down its other branch: the atlas rectangle's width plus the glyph's offset, 9 + 3 = 12, which is why "ABC" is 36 and "AB" is 24. And "A" at a spacing of 3 measures 11 and not 14, because spacing is added per gap and not per glyph — without that line, a wrapper that added it per glyph would pass everything else. Verified red by six permutations. In Font: base-size with glyph-count (the measurements become 80, 120, 163 and 36.6667), the recs and glyphs pointers (floats in the 1e9 range and a garbage atlas rectangle), and [texture] moved to the end (the run dies after the first line). In GlyphInfo: offset-x with advance-x (3, 6, 9, 1), and [image] moved to the FRONT, which shifts the four ints by 24 bytes — the glyph search collapses, every index reads 0 and glyph C answers with A's fields. In Rectangle: x with width, which moves "measure ABC" to 39 and leaves "measure AB" at 24, since only the advance-0 fallback reads a width out of the recs array. Two of the six were a crash rather than a wrong number, which still counts. What this case does NOT pin, said here for the same reason the Texture2D notes above say it: glyph-padding is read by nothing raylib computes on the CPU, offset-y only moves a glyph when it is drawn, and of each atlas rectangle only `width` is ever looked at. Those four fields rest on the header agreeing with raylib's and on sand.flan looking right, and on nothing else. *) let raylib_font_out = "valid yes\n\ index A 0\nindex B 1\nindex C 2\nindex Z 0\n\ atlas B 5 0 7 10\n\ glyph C value 67\nglyph C offset 3\nglyph C advance 0\n\ measure AB 24 10\n\ measure ABC 36 10\n\ measure AB big 51 20\n\ measure A spaced 11 10\n" in if Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 then begin outputs "raylib fonts, headless" "programs/raylib-font.flan" raylib_font_out; outputs ~opt:"-O0" "raylib fonts, headless, -O0" "programs/raylib-font.flan" raylib_font_out end else print_endline "acceptance: skipping the raylib Font 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 = "15595743031174623232\n" in outputs "sand, headless" "programs/sand-headless.flan" sand_out; outputs ~opt:"-O0" "sand, headless, -O0" "programs/sand-headless.flan" sand_out; (* The ported raylib example that has a headless half. The other nine of the ten in examples/ are input read straight into drawing calls, and a test of those would be asserting that raylib answers 0 for every input with no window open — which is also what a binding with its arguments crossed would answer. This one is different: which virtual D-pad button sits under a pointer, and what a held button does to the player, is arithmetic. The driver sweeps a pointer over the pad in a fixed grid, so every branch of the search is taken, and hashes where the player ended up. A crossed x and y anywhere in it changes the number. Like sand-headless it imports the example and reaches no raylib call, so it links neither a shim nor libraylib. *) let vc_out = "-2146089238186896844\n" in outputs "virtual controls, headless" "programs/virtual-controls-headless.flan" vc_out; outputs ~opt:"-O0" "virtual controls, headless, -O0" "programs/virtual-controls-headless.flan" vc_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; (* ── Packages: the link follows the program ──────────────────────── A package's C and linker arguments used to come with the import, whatever [main] did — which is what made sand's two halves two files rather than one file with two entry points (NEXT.md, sand.flan is two programs). [Reach.link] decides it from the checked program instead: nothing reachable calls into raylib here, so no shim is compiled, no -lraylib is passed, and no body that would reference a raylib symbol is emitted. Natively that is invisible; the wasm32 case below is where it is the difference between building and not. *) outputs "an imported package nothing calls" "programs/pkg-unused.flan" "ok\n"; outputs "an imported package nothing calls, -O0" ~opt:"-O0" "programs/pkg-unused.flan" "ok\n"; (* A package may import a package, and one reached along two routes is read once: pkg-shared imports sand.flan, which imports raylib, and imports raylib itself. Loading it twice would declare every binding twice. *) outputs "a package reached along two routes" "programs/pkg-shared.flan" "ok\n"; (* A local shadows an imported name. Qualification rewrites a package's own names wherever they are used, and a binding is where it has to stop — in an expression and in a place, which are two separate lines of the renamer. Nothing refuses a renamer that qualifies through a binding: the program builds and runs and reads the top-level name instead, so what says it is wrong is the number. 7 is the let's and not the constant's 5; 20 comes back out of [assigned] while the package's own [sink] is still 0, which is the place half. *) outputs "a local shadows an imported name" "programs/pkg-shadow.flan" "7\n20\n0\n5\n"; (* Reach's walk, edge by edge. Pruning is what makes the link follow the program, and the cost of getting it wrong is not a wrong answer: a function the walk fails to reach is not emitted, and the build dies in the linker naming a symbol nobody wrote. reach-walk.flan calls three functions from three places that are each the only route to them — the index expression of a place, a place under [addr], and a restart-case clause body — so a walk that forgets any one of the three fails to build here. Caught rather than raised, because a build that dies takes the rest of the table with it. *) (match compile "programs/reach-walk.flan" with | exception Failure m -> incr failures; Printf.printf "FAIL Reach's walk: it did not build, which is what a pruned function looks like\n%s\n" m | exe -> let code, text = run exe None in let want = "10\n20\n42\n" in if text <> want || code <> 0 then begin incr failures; Printf.printf "FAIL Reach's walk\n got: %S (exit %d)\n wanted: %S\n" text code want end; (try Sys.remove exe with Sys_error _ -> ())); (* The refusals. Each is a thing that would otherwise fail later and elsewhere — as a name the checker says is unknown, or as a collision nobody wrote — so what is asserted is the *reason*, at the form that caused it. None of these is built; being refused is the whole test. *) let refuses name path needle = let attempt () = let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in ignore (Check.program l.Load.decls) in match attempt () with | () -> incr failures; Printf.printf "FAIL %s\n it was accepted\n" name | exception Loc.Error (_, m) -> if not (contains m needle) then begin incr failures; Printf.printf "FAIL %s\n said: %S\n wanted: %S in it\n" name m needle end in (* Visibility: main is not a name a package offers, and saying so is the point — "unknown name sand/main" would be true and useless. *) refuses "a package's main is not visible" "programs/pkg-hidden-main.flan" "sand/main is not a name"; refuses "one directory under two aliases" "programs/pkg-two-aliases.flan" "one directory is one set of names"; refuses "two mains in one program" "programs/pkg-two-mains.flan" "main is defined twice"; (* nth is gone, not renamed: it has to fail as a name nobody defined. If it were ever re-added as an alias of [at] it would have to be a place too, and this row is what says so. *) refuses "nth is not a name" "programs/nth-gone.flan" "unknown function nth"; (* The one thing in the allocator tier that really does need milestone 5, refused by name and with the reason rather than as an unknown function. NEXT.md's escape is that the *built-in* set needs nothing from milestone 5; this row is the other half of that claim. *) refuses "a user-written allocator" "programs/user-allocator.flan" "a defn's name in value position"; (* Move-only, spec-memory.md. Each of these would otherwise be a double free or a use-after-free at run time, and each is refused at the second use with the first one's location in the message. *) refuses "a Vec used after it was passed" "programs/vec-moved.flan" "was moved at"; refuses "a Vec freed twice" "programs/vec-double-free.flan" "double free unrepresentable"; (* The one case the dead set cannot answer on its own: merged once at the end of the body it counts one move, not two. *) refuses "a Vec moved inside a loop" "programs/vec-moved-in-loop.flan" "the next iteration would use what this one gave away"; (* let has no type annotation, so with no element type and no expectation there is nothing to infer from — and guessing is the alternative. *) refuses "vec-new with nothing saying what of" "programs/vec-untyped.flan" "write the element type"; (* The three shapes ownership is not transitive through yet. Each is refused where it is declared, naming drop as what it waits on, rather than accepted into a path that would copy a header and hand out a second owner. *) refuses "a struct field that owns a Vec" "programs/vec-in-struct.flan" "a struct that owns one is move-only too"; refuses "a global Vec" "programs/vec-global.flan" "the dead set is per function"; refuses "a Vec of a Vec" "programs/vec-of-vec.flan" "copies and releases elements bytewise"; (* And it does not cross to C: the shim would flatten a header that owns storage. Refused by the shim generator, where the message can say what to pass instead. *) refuses "a Vec crossing to C" "programs/vec-to-c.flan" "handing its header to C hands out an owner"; (* ── wasm32 (NEXT.md, deferred item 6) ────────────────────────────── The second target, and the reason sand-headless imports no raylib. What is asserted is not that a wasm module exists — it is that it prints the *same hash* as the native build, byte for byte. That is only possible because rand-f32 is written in Flan rather than bound to libc, so the case is the regression test for that decision as much as for the port. Four independent things can be absent — clang's wasm target, the wasi-libc sysroot, a builtins archive, and a runtime that speaks WASI — so the skip is a *probe*: build the smallest program and run it. A [which] would go red on the machine where Node is too old, with a reason nobody could read. *) let wasm_runner = if Sys.command "command -v wasmtime > /dev/null 2>&1" = 0 then Some "wasmtime" else if Sys.command "command -v wasmer > /dev/null 2>&1" = 0 then Some "wasmer run" else if Sys.command "command -v node > /dev/null 2>&1" = 0 then (* --no-warnings because node:wasi prints an ExperimentalWarning to stderr on every run, and this harness compares combined output. *) Some "node --no-warnings wasm-run.mjs" else None in let wasm_build ?(opt = "-O2") path out = let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in let p = Check.program l.Load.decls in let p, csrcs, lflags = Reach.link l p in ignore (Build.executable ~opts:{ Build.default with opt; target = Some "wasm32-wasi" } ~csrcs ~lflags p ~out) in let wasm_run ?arg runner wasm = let out = Filename.concat scratch "flan-acceptance-wasm.out" in let code = Sys.command (Printf.sprintf "%s %s %s > %s 2>&1" runner (Filename.quote wasm) (match arg with None -> "" | Some a -> Filename.quote a) (Filename.quote out)) in let text = In_channel.with_open_bin out In_channel.input_all in (try Sys.remove out with Sys_error _ -> ()); (code, text) in (match wasm_runner with | None -> print_endline "acceptance: skipping the wasm32 case (no wasmtime, wasmer or node)" | Some runner -> let probe = Filename.concat scratch "flan-wasm-probe.wasm" in let outcome = match wasm_build "programs/unit-main.flan" probe with | () -> let code, text = wasm_run runner probe in if code = 0 && text = "ok\n" then Ok () else Error (Printf.sprintf "%s could not run it: %S (exit %d)" runner text code) | exception Failure m -> Error m in (try Sys.remove probe with Sys_error _ -> ()); (match outcome with | Error why -> Printf.printf "acceptance: skipping the wasm32 case (%s)\n" why | Ok () -> let wasm_case name ?opt ?arg path expected = let wasm = Filename.concat scratch ("flan-w-" ^ Filename.remove_extension (Filename.basename path) ^ ".wasm") in wasm_build ?opt path wasm; let code, text = wasm_run ?arg runner wasm 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 wasm with Sys_error _ -> ()) in (* The hash, which must equal the native one above. At both levels: agreement at -O2 alone could be a coincidence of how LLVM folded the float arithmetic, and -O0 is the cheap way to say it is not. *) wasm_case "sand, headless, wasm32" "programs/sand-headless.flan" sand_out; wasm_case "sand, headless, wasm32, -O0" ~opt:"-O0" "programs/sand-headless.flan" sand_out; (* And the two fixed-output programs, which between them cover the milestone-2 surface: globals, 2-D arrays, places through a pointer, casts and match. A 32-bit pointer is the thing most likely to go wrong and these are where it would show. *) wasm_case "value semantics, wasm32" "programs/values.flan" values_out; wasm_case "machine surface, wasm32" "programs/machine.flan" machine_out; (* calc-me, for the one host-ABI path the three above do not touch: [flan_argv] builds an array of flan_slice in C and Flan indexes it as [string], so what is pinned here is the element *stride* of a ptr+len pair, which is 16 bytes native and 12 on wasm32 — not a field offset, and nothing else in the table reaches it. This is also the file header's own claim, that the table runs on wasm32 too, honoured for the first time. *) wasm_case "calc-me, wasm32" "../calc-me.flan" ~arg:"1 + 2 * (3 - 0.5) / 2" "3.5\n"; (* And the case the whole of Reach.link exists for: a program that imports raylib, calls none of it, and builds for a target where libraylib cannot be linked at all. Before, this was not a failing test — it was a file nobody could write. *) wasm_case "an imported package nothing calls, wasm32" "programs/pkg-unused.flan" "ok\n"; wasm_case "an imported package nothing calls, wasm32, -O0" ~opt:"-O0" "programs/pkg-unused.flan" "ok\n")); (* The EDN tokenizer, and the struct reader written by hand against it (vendor/edn, test/programs/edn.flan). The expected output is a raw literal because the token dump is full of brackets and quotes, and escaping them here would put a second reader between the test and what the program actually printed. Every line is one a plausible wrong version fails. The dump prints both the kind letter and the text in <>, so a tokenizer with the right kinds and the wrong slices - off by the opening quote, off by the keyword's colon - fails even though it agreed about every kind. The cases that are not obvious: a number followed straight by a delimiter ("[1]", "1;c") separates a scan-to-delimiter from a scan-to-whitespace; foo/bar must stay a namespaced symbol where a "contains a slash" ratio rule makes it an error; a string holding a bracket and a semicolon must not open a vector or start a comment; "1 ; no newline at the end" is the comment a scan-to-newline loop runs off the end of; and an empty map is what a reader assuming at least one key-value pair gets wrong. The refusals are asserted on their *reason* and not on the fact of failing, with the byte offset first - a tokenizer answering one generic error for all of them would pass a test that only checked that it stopped. Both string cases are here because they fail differently: an escaped quote is the one where a wrong version returns a backslash as part of the text and leaves the rest of the literal behind as garbage. At -O0 as well. A Token is a two-word slice inside a struct returned by value, and a Cursor is passed by pointer with a fixed array in it; mem2reg is exactly what launders a struct being copied where it should be shared. *) let edn_out = {edn|i<1> i<-1>i<+2>i<0> f<1.5>f<-2.5e3>f<.5> bbn yyy<-> kk [<>i<1>]<> [<>i<1>i<2>]<>[<>i<3>]<> {<>ki<1>}<> i<1> k {<>}<> [<>]<> (<>)<> [<>[<>i<1>]<>[<>i<2>[<>i<3>]<>]<>]<> {<>k{<>k[<>]<>}<>}<> k i<1> s i<1> i<1>i<2> i<1> [<>i<1>i<2>i<3>]<> s si<1> s<>i<1> s 2 escaped strings are refused: unescaping needs a copy of the bytes, and there is no allocator to put one in 2 escaped strings are refused: unescaping needs a copy of the bytes, and there is no allocator to put one in 0 unterminated string: end of input before the closing quote 0 sets #{} are refused: there is no hash set, and no allocator to build one in 0 tagged literals #tag are refused: the tag would pick the type at run time, which is what a type-directed reader exists to avoid 0 #inst is refused: it is a tagged literal, and there is no timestamp type to read it into 0 #uuid is refused: it is a tagged literal, and there is no uuid type to read it into 0 metadata ^ is refused: it attaches to the value after it, and a flat token stream has nowhere to attach it 0 ratios are refused: there is no rational type, and rounding one to a float would change the value 0 character literals are refused: a character is not a byte once it is not ASCII, and there is no code point type 0 not a number: the token starts like one but does not parse as an integer or a float 3 empty keyword: a colon with no name after it 0 unexpected byte: not the start of any EDN value 0 unexpected byte: not the start of any EDN value 4 unbalanced: this closing delimiter does not match the one that is open 0 unbalanced: this closing delimiter does not match the one that is open 4 unbalanced: this closing delimiter does not match the one that is open 32 nesting is too deep: the balance stack is a fixed array and it is full [goblin] hp=12 speed=1.5 boss=no [dragon] hp=40 speed=0 boss=yes [imp] hp=1 speed=2 boss=no [] hp=0 speed=0 boss=no ERR@7 unexpected token: not the kind the caller was reading [orc] hp=9 speed=0 boss=no |edn} in outputs "edn tokenizer" "programs/edn.flan" edn_out; outputs ~opt:"-O0" "edn tokenizer, -O0" "programs/edn.flan" edn_out; (* Comparing enums, found by auditing emit.ml's failwith sites. It type checked and then died in the backend with no source location, which is the project's worst failure shape. All six operators, a negative member so that an unsigned compare would answer the other way, and a compare through a struct field, which reaches the same lowering by another path. *) let enum_out = "eq yes\neq no\nlo below mid\nhi not below mid\nfield eq yes\n" in outputs "enum comparison" "programs/enum-compare.flan" enum_out; outputs ~opt:"-O0" "enum comparison, -O0" "programs/enum-compare.flan" enum_out; (* Converting an enum, explicitly, in both directions: (i32 k) and (K n). An enum is an i32 at run time, so neither direction is an instruction and the interesting thing is what the checker will let through — which is why this is here and at -O0 rather than only in test_flan. The rows are the three members out, a round trip back, a value that is no declared member and the comparisons it exists for, a narrowing and a widening of a negative member, and an enum parameter driven by a loop variable, which is the whole point. The two bare prints in the middle are the ones that hold the design up rather than merely exercising it: 7 prints as 7 and 1 prints as :hi. Allowing a non-member to be *built* is only coherent because the printer already shows one as its number, and this is where that is asserted rather than asserted about. *) let enum_conv_out = "-1\n0\n1\n1\n-1\n7\n7\n:hi\nnot a member\nabove 3\n-1\n255\n1\n\ lo\nmid\nhi\nother\n" in outputs "enum conversion" "programs/enum-convert.flan" enum_conv_out; outputs ~opt:"-O0" "enum conversion, -O0" "programs/enum-convert.flan" enum_conv_out; (* ── declare-c: the generated FFI shim (lib/shim.ml) ──────────────── The raylib package is the proof that the generator is real — 84 hand-written wrappers replaced by 84 one-line declarations, with the two raylib cases above unchanged — and the permutation runs below are the proof that the generated C typedefs actually follow the Flan `defstruct`s rather than merely looking as if they do. Everything here is text, not a link: what a wrapper does is settled by clang, and what is worth asserting in OCaml is the shape of what clang is handed and the refusals, each by name and reason. *) let shim_of src = let decls = Parse.program (Reader.read_all ~file:"" src) in (* One string again for the assertions: the parts exist so [Reach] can drop a wrapper, and what is asserted here is the text clang is handed, which is the concatenation. *) String.concat "" (List.map snd (Check.program decls).Tast.cshim) in let shim_case name src needles = match shim_of src with | c -> List.iter (fun n -> if not (contains c n) then begin incr failures; Printf.printf "FAIL %s\n wanted in the generated C: %S\n" name n end) needles | exception Loc.Error (_, m) -> incr failures; Printf.printf "FAIL %s\n refused: %s\n" name m in (* A refusal is by name and carries the reason; the tests assert on the reason, so weakening one to a bare "cannot" breaks them. *) let shim_refuses name src fragment = match shim_of src with | _ -> incr failures; Printf.printf "FAIL %s: accepted, and it should not have been\n" name | exception Loc.Error (_, m) -> if not (contains m fragment) then begin incr failures; Printf.printf "FAIL %s\n reason: %S\n wanted to contain: %S\n" name m fragment end in let v2 = "(defstruct Vector2 [x f32 y f32])\n" in let img = "(defstruct Image [data (Ptr u8) width i32 height i32])\n" in (* A struct argument goes by pointer and a struct return through an out-pointer, and the prototype says what C really takes. *) shim_case "declare-c: a struct crosses by pointer, both ways" (v2 ^ "(declare-c mid [a Vector2 b Vector2] Vector2 \"Mid\")") [ "extern flan_ty_Vector2"; "*out = Mid(*a0, *a1);"; "const flan_ty_Vector2"; "*out)" ]; (* The typedef is made from the defstruct and nothing else, so its field order is the defstruct's — which is what makes permuting a defstruct a real test rather than a rewording. Both orders asserted, because only the pair rules out a generator that sorts. *) shim_case "declare-c: the C typedef follows the defstruct's field order" (v2 ^ "(declare-c f [v Vector2] \"F\")") [ " float x;\n float y;\n" ]; shim_case "declare-c: and permuting the defstruct permutes the typedef" ("(defstruct Vector2 [y f32 x f32])\n(declare-c f [v Vector2] \"F\")") [ " float y;\n float x;\n" ]; (* One type mapper for fields and parameters alike: a bool is C's bool and never an int, and a pointer field keeps its element type. *) shim_case "declare-c: field and parameter types come from one mapper" (img ^ "(defstruct S [flag bool n u64])\n\ (declare-c g [s S i (Ptr Image) b bool] u64 \"G\")") [ " bool flag;\n uint64_t n;\n"; " uint8_t *data;\n"; "uint64_t G(flan_ty_S"; "bool a2" ]; (* A struct held by value pulls its own typedef in, and the definitions are ordered so the inner one is complete first. *) shim_case "declare-c: a nested struct is defined before it is used" (v2 ^ "(defstruct Camera2D [offset Vector2 zoom f32])\n\ (declare-c h [c Camera2D] \"H\")") [ "struct flan_ty_Vector2"; " flan_ty_Vector2" ]; (* A string is ptr+len on the Flan side and a NUL-terminated copy on C's. The buffer is sized here and not per call site, because a generator has no call site to look at: 256 on the stack, the heap past that, and the copy is freed after the call rather than before the return value is computed. *) shim_case "declare-c: a string is copied, NUL-terminated and freed" "(declare-c open-it [path string] bool \"OpenIt\")" [ "char a0_b[256];"; "flan_shim_cstr(a0_p, a0_n, a0_b, sizeof a0_b)"; "bool r = OpenIt(a0);"; "flan_shim_cstr_free(a0, a0_b);"; " return r;\n" ]; shim_case "declare-c: two strings get two buffers" "(declare-c both [a string b string] \"Both\")" [ "char a0_b[256];"; "char a1_b[256];"; "flan_shim_cstr_free(a0, a0_b);"; "flan_shim_cstr_free(a1, a1_b);" ]; (* [declare] is untouched by any of this: its signature still IS the C signature, which is what vendor/agent's flan_agent_start and the prelude's sqrtf depend on. A program with no declare-c generates no C at all. *) if shim_of "(declare start [path string] i32 \"flan_agent_start\")" <> "" then begin incr failures; print_endline "FAIL declare (not declare-c) generated a shim" end; shim_refuses "declare-c: a slice parameter, by name and reason" (v2 ^ "(declare-c poly [pts [Vector2]] bool \"Poly\")") "the count parameter the C function actually takes"; shim_refuses "declare-c: an Option" (v2 ^ "(declare-c maybe [] (Option Vector2) \"Maybe\")") "which is a Flan shape and not a C one"; shim_refuses "declare-c: a union" ("(defunion Shape [(Circle [r f32]) (Square [s f32])])\n\ (declare-c area [s Shape] f32 \"Area\")") "a union, and a Flan union has no C layout"; shim_refuses "declare-c: a fixed array" "(declare-c takes [xs [4 f32]] \"Takes\")" "which C passes as a pointer and Flan as a value"; shim_refuses "declare-c: a map" "(declare-c takes [m {string i32}] \"Takes\")" "which has no C representation"; shim_refuses "declare-c: a returned string" "(declare-c name [] string \"Name\")" "a string only crosses as a parameter"; shim_refuses "declare-c: a callback" "(declare-c each [f (Fn [i32] Unit)] \"Each\")" "a C callback is not implemented"; shim_refuses "declare-c: an unknown type" "(declare-c f [x Nope] \"F\")" "which is not a type this shim generator knows"; shim_refuses "declare-c: a field C cannot hold" "(defstruct S [xs [i32]])\n(declare-c f [s S] \"F\")" "field xs of S is a slice"; shim_refuses "declare-c: the generated name is already taken" (v2 ^ "(defn mid-c [a (Ptr Vector2) out (Ptr Vector2)])\n\ (declare-c mid [a Vector2] Vector2 \"Mid\")") "needs the name mid-c for the declaration it generates"; shim_refuses "declare-c: two Flan names for one C function" "(declare-c a [] \"Same\")\n(declare-c b [] \"Same\")" "one declare-c per C function"; (* Two programs written against a mutation-testing report, each covering a claim the whole suite could be broken on while staying green. cleanup.flan: a return running the defers above it, and running them innermost-first; a defer that calls something, so a guard is emitted inside it on the transfer path; a transfer out of a handler-bind popping its frames; a two-clause handler-bind popping both; and a signal that stops at the inner handler once that one has answered it by transferring. Six claims, and the numbers differ per failure so a wrong answer names its own cause. signedness.flan: the ashr/lshr and slt/ult choices, which emit.ml makes from the operand's type. Either could have been hardcoded to one arm, because nothing in the corpus shifted a negative right or compared an unsigned value above 2^31. *) let cleanup_out = "7\n21\n42\n0\n5\n0\n0\n" in outputs "cleanup paths" "programs/cleanup.flan" cleanup_out; outputs ~opt:"-O0" "cleanup paths, -O0" "programs/cleanup.flan" cleanup_out; (* defer-let.flan: a [let] at the top level of a function body has exactly the function's extent, so a defer written in it always registers and is as safe as one written at the top level. Six claims, and the numbers differ per failure. The one a plausible wrong version gets wrong is [two]: a permission granted once around a block rather than once before each form lets the first defer through and refuses the second, and every other case here still passes. *) let defer_let_out = "9\n91\n921\n921\n9321\n7\n21\n" in outputs "defer in a let" "programs/defer-let.flan" defer_let_out; outputs ~opt:"-O0" "defer in a let, -O0" "programs/defer-let.flan" defer_let_out; (* The two refusals that stay, each named by what blocks it. A loop body would fire once at function exit rather than once per iteration, and a branch would have to express "maybe registered", which a construct copied into every exit path cannot. A [let] inside either one inherits the refusal, not the permission: its extent is the loop's or the arm's. *) refuses_src "defer in a loop body" "(defn g [] 0)\n(defn f [] (while true (defer (g))))" "not allowed inside a loop body"; refuses_src "defer in a dotimes body" "(defn g [] 0)\n(defn f [] (dotimes [i 3] (defer (g))))" "not allowed inside a loop body"; refuses_src "defer in a branch" "(defn g [] 0)\n(defn f [] (if true (defer (g)) 0))" "not allowed inside a branch"; refuses_src "defer in a let inside a loop" "(defn g [] 0)\n(defn f [] (while true (let [x 1] (defer (g)))))" "not allowed inside a loop body"; refuses_src "defer in a let inside a branch" "(defn g [] 0)\n(defn f [] (if true (let [x 1] (defer (g))) 0))" "not allowed inside a branch"; (* ── (Map K V), spec-memory.md step 4 ────────────────────────── Odin's map: open-addressed Robin Hood hashing at a 75% load factor with cache-line cell packing. maps.flan is seven claims, each one a plausible wrong version gets wrong, and the numbers differ per failure. The two worth naming, because nothing else in the suite would catch them. A struct key is hashed *field by field*, never bytewise, because a struct's padding bytes are indeterminate — hashing them makes two equal keys hash differently and the entry unfindable, which shows up here as a wrong count rather than a crash. And a grow rehashes against a fresh seed, because the seed is derived from the block address; carrying the old hashes across a grow puts every entry in a slot nothing will probe. 2000 entries is eight grows and then every one of them read back. *) let maps_out = "2000\n0\n1600\n709\ntrue\nfalse\n3\n20\nfalse\n2\n3\nfalse\n\ 100\n999\n2\n1\n3\n500\n998\n2\n2\n" in outputs "maps" "programs/maps.flan" maps_out; outputs ~opt:"-O0" "maps, -O0" "programs/maps.flan" maps_out; (* A dev build, because the hash and equality pair emitted for a struct key is a function nobody wrote and the only other inhabitant of that list — a lifted handler clause — carries a parent this one cannot: the pair is shared by every function that maps that key type. A dev build puts every body behind an indirection cell, so it is the build that would notice. *) outputs ~dev:true "maps, dev" "programs/maps.flan" maps_out; (* The allocation-failure rule is one rule over every allocating operation, so it has to hold for map-new, put, reserve and clone as it does for the Vec's four. A map is the harder case: its growth allocates a new block, rehashes into it and only then releases the old one, so a failure partway must leave the map exactly as it was or the retry re-attempts against a half-moved map. *) let map_exhausted_out = "300\n0\ntrue\ntrue\ntrue\n0\n2\n2\ntrue\n" in outputs "map StorageExhausted and retry" "programs/map-exhausted.flan" map_exhausted_out; (* The refusals, each by name. A float key is not a milestone question — NaN is not equal to itself and 0.0 and -0.0 are equal while differing bytewise, so there is no equality for a map to hash. A move-only value is the refusal (Vec (Vec T)) already carries, for the identical reason. Unit as a value is refused rather than dividing a cache line by zero, and it is named because it is the natural spelling of a set. *) refuses_src "a float is not a map key" "(defn f [m (Map f32 i32)] 0)" "is not a map key"; refuses_src "a Ptr is not a map key" "(defn f [m (Map (Ptr i32) i32)] 0)" "hash an address"; refuses_src "a map value may not own storage" "(defn f [m (Map i32 (Vec i32))] 0)" "holds a move-only value"; refuses_src "a map value may not be Unit" "(defn f [m (Map i32 Unit)] 0)" "cannot be Unit"; refuses_src "map-new with nothing to say what it maps" "(defn main [] i32 (let [m (map-new)] (free m)) 0)" "nothing here says what (map-new) maps"; (* A map is move-only like a Vec, and the refusal names the type that was moved rather than saying "a Vec" whatever it was. *) refuses_src "a map used after it was moved" "(defn main [] i32 (let [m (map-new i32 i32)] (free m) (put m 1 2)) 0)" "cannot be used again"; let signed_out = "-4\n-1\nbig is not small\nbig is large\n1\n" in outputs "signedness" "programs/signedness.flan" signed_out; outputs ~opt:"-O0" "signedness, -O0" "programs/signedness.flan" signed_out; (* ── Destructuring ─────────────────────────────────────────── *) (* A destructuring let is desugared in [Parse] into the Let, field access, [at] and [slice] that already existed, so there is nothing in the typed IR to inspect and this program *is* the test. The last line is the one that catches the mistake worth catching: four names come out of two calls, so a desugaring that dropped the temporary and re-evaluated the initialiser per name would print 4 instead of 2. Every other line here would stay green through that. -O0 as well, for the usual reason — the tail slice is an address into a local array, and mem2reg launders a sloppy one. *) let destructure_out = "keys 1 2\npairs 10 20\nnested 7 8\nshadow 5 6\nsequential 100 200\n\ array 11 22 33\nrest 1 4 2 5\nempty-tail 17 0\nnested-in-array 1 4\n\ struct-tail 1 2 4 5\ncalls 2 14\n" in outputs "destructuring" "programs/destructure.flan" destructure_out; outputs ~opt:"-O0" "destructuring, -O0" "programs/destructure.flan" destructure_out; (* A package-qualified struct as a declared return type, which the parser used to read as the first body form. Reported by the raylib lane, which hit it on rl/Vector2 and worked around it rather than reaching into a file it did not own. *) let pkgret_out = "9\n5\n" in outputs "a package struct in return position" "programs/pkg-return.flan" pkgret_out; outputs ~opt:"-O0" "a package struct in return position, -O0" "programs/pkg-return.flan" pkgret_out; (* -- Source-level debugging: DWARF, and whether it is true --------- The whole of this section is about one risk. A Flan struct is its C struct and lldb needs to learn nothing about the data model, which is what makes DWARF cheap here; but !DIDerivedType takes its member offset as an integer literal, so those offsets are the one layout number the backend works out for itself instead of handing to LLVM. A wrong one does not crash: it prints a plausible value for the wrong field, which is the failure this project has met over and over at the FFI boundary. So the offsets are not checked against a table written by the same hand as the code. They are checked against LLVM's own answer for the same struct type — ptrtoint of a getelementptr through a null pointer, which is exactly the idiom Emit already uses for the size it passes to flan_dev_global — constant-folded by llc into a .quad and read back. And the whole thing is run twice over the same struct with its fields permuted, because a check that cannot come out differently is not checking anything. *) (* Small text tools, since there is no Str and the reader is hand-written for the same reason. *) let lines_of s = String.split_on_char '\n' s in let index_of hay needle = let n = String.length needle and h = String.length hay in let rec go i = if i + n > h then -1 else if String.sub hay i n = needle then i else go (i + 1) in go 0 in (* The value of [key: ] in a metadata node, up to the next , or ). *) let attr line key = let k = key ^ ": " in match index_of line k with | -1 -> None | i -> let i = i + String.length k in let j = ref i in let n = String.length line in while !j < n && line.[!j] <> ',' && line.[!j] <> ')' do incr j done; Some (String.sub line i (!j - i)) in (* [elements: !{!12, !13}] — the value has commas in it, so it needs its own reader rather than [attr]'s stop-at-the-next-comma. *) let attr_ids line key = let k = key ^ ": !{" in match index_of line k with | -1 -> [] | i -> let i = i + String.length k in let j = ref i and n = String.length line in while !j < n && line.[!j] <> '}' do incr j done; String.sub line i (!j - i) |> String.split_on_char ',' |> List.filter_map (fun t -> let t = String.trim t in if String.length t > 1 && t.[0] = '!' then int_of_string_opt (String.sub t 1 (String.length t - 1)) else None) in let unquote s = let n = String.length s in if n >= 2 && s.[0] = '"' && s.[n - 1] = '"' then String.sub s 1 (n - 2) else s in (* The parameter names come down from the driver, exactly as [bin/main.ml] sends them: the typed IR does not carry them. *) let pnames_of decls = List.filter_map (fun (d : Ast.decl) -> match d.Ast.d with | Ast.Defn fn -> Some (fn.Ast.name, List.map (fun (f : Ast.field) -> f.Ast.fname) fn.Ast.params) | _ -> None) decls in let debug_ir src = let decls = Parse.program (Reader.read_all ~file:"" src) in Emit.program ~debug:true ~pnames:(pnames_of decls) (Check.program decls) in (* Every (member name, byte offset) of a named struct, in declaration order, as the emitted DWARF states it. *) let dwarf_members ir sname = let ls = lines_of ir in let node id = List.find_opt (fun l -> String.starts_with ~prefix:(Printf.sprintf "!%d = " id) l) ls in let composite = List.find_opt (fun l -> index_of l "!DICompositeType(tag: DW_TAG_structure_type" >= 0 && attr l "name" = Some (Printf.sprintf "\"%s\"" sname)) ls in match composite with | None -> None | Some c -> let ids = attr_ids c "elements" in Some ((List.filter_map (fun id -> match node id with | None -> None | Some l -> (match attr l "name", attr l "offset" with | Some n, Some o -> Some (unquote n, int_of_string (String.trim o) / 8) | _ -> None)) ids), (match attr c "size" with | Some sz -> int_of_string (String.trim sz) / 8 | None -> -1)) in (* LLVM's own answer, for the same struct type text the DWARF describes. The type definitions are lifted straight out of the emitted module, so there is no second spelling of the layout to get wrong. *) let llvm_members ir sname nfields = let tydefs = lines_of ir |> List.filter (fun l -> String.length l > 0 && l.[0] = '%' && index_of l " = type " >= 0) in let sty = Printf.sprintf "%%\"%s\"" sname in let b = Buffer.create 512 in List.iter (fun l -> Buffer.add_string b (l ^ "\n")) tydefs; for i = 0 to nfields - 1 do Buffer.add_string b (Printf.sprintf "@o%d = constant i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 0, i32 %d) to i64)\n" i sty i) done; Buffer.add_string b (Printf.sprintf "@sz = constant i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 1) to i64)\n" sty); let ll = Filename.concat scratch "flan-dwarf-oracle.ll" in let asm = Filename.concat scratch "flan-dwarf-oracle.s" in Out_channel.with_open_bin ll (fun ch -> Out_channel.output_string ch (Buffer.contents b)); let llc = try Sys.getenv "FLAN_LLC" with Not_found -> "llc" in let code = Sys.command (Printf.sprintf "%s -filetype=asm %s -o %s > /dev/null 2>&1" (Filename.quote llc) (Filename.quote ll) (Filename.quote asm)) in if code <> 0 then None else begin let text = In_channel.with_open_bin asm In_channel.input_all in (try Sys.remove ll with Sys_error _ -> ()); (try Sys.remove asm with Sys_error _ -> ()); (* llc writes the folded constant as ".quad 0+24" — a sum, because the null base is still a symbolic zero to the assembler. *) let pending = ref "" and acc = ref [] in List.iter (fun l -> let t = String.trim l in if String.length t > 1 && t.[String.length t - 1] = ':' then pending := String.sub t 0 (String.length t - 1) else if index_of t ".quad" >= 0 && !pending <> "" then begin let v = String.trim (String.sub t 5 (String.length t - 5)) in let v = match index_of v "#" with -1 -> v | i -> String.sub v 0 i in let n = String.split_on_char '+' v |> List.fold_left (fun a part -> match int_of_string_opt (String.trim part) with | Some x -> a + x | None -> a) 0 in acc := (!pending, n) :: !acc; pending := "" end) (lines_of text); Some (List.rev !acc) end in (* The case itself: the DWARF a source text produces must agree with LLVM on every member's offset, and on the struct's size. *) let layout_case name src sname fields = let ir = debug_ir src in match dwarf_members ir sname with | None -> incr failures; Printf.printf "FAIL %s\n no DWARF type for %s\n" name sname | Some (members, size) -> let got = List.map fst members in if got <> fields then begin incr failures; Printf.printf "FAIL %s\n DWARF members: %s\n wanted: %s\n" name (String.concat " " got) (String.concat " " fields) end; (match llvm_members ir sname (List.length fields) with | None -> (* No llc is a reason to skip the oracle, not to pass silently. *) Printf.printf "acceptance: %s — llc unavailable, offsets unchecked\n" name | Some oracle -> List.iteri (fun i (fname, off) -> match List.assoc_opt (Printf.sprintf "o%d" i) oracle with | None -> () | Some want -> if off <> want then begin incr failures; Printf.printf "FAIL %s\n %s.%s at byte %d in the DWARF, %d in LLVM\n" name sname fname off want end) members; (match List.assoc_opt "sz" oracle with | Some want when want <> size -> incr failures; Printf.printf "FAIL %s\n %s is %d bytes in the DWARF, %d in LLVM\n" name sname size want | _ -> ())); () in let cell = "(defstruct Cell [alive bool heat f64 id i32 name string])\n" in let cell' = "(defstruct Cell [name string id i32 alive bool heat f64])\n" in let body = "(defn main [] i32 (let [c (Cell {.id 1})] (i32 (.id c))))\n" in layout_case "DWARF offsets agree with LLVM: a mixed struct" (cell ^ body) "Cell" [ "alive"; "heat"; "id"; "name" ]; (* The same struct, permuted. If the offsets came from anywhere but the declaration order they would survive this, and they do not. *) layout_case "DWARF offsets agree with LLVM: the same fields permuted" (cell' ^ body) "Cell" [ "name"; "id"; "alive"; "heat" ]; layout_case "DWARF offsets agree with LLVM: nesting and fixed arrays" ("(defstruct P [x i32 y i32])\n\ (defstruct Board [tag u8 cells [4 P] here P edge (Ptr P) seen (Option i64)])\n\ (defn main [] i32 (let [b (Board {.tag 1})] (i32 (.tag b))))\n") "Board" [ "tag"; "cells"; "here"; "edge"; "seen" ]; (* Permuting the fields must actually move them. Asserting that the two orderings disagree is what makes the two cases above a test: an offset table that ignored declaration order would satisfy both. *) (match dwarf_members (debug_ir (cell ^ body)) "Cell", dwarf_members (debug_ir (cell' ^ body)) "Cell" with | Some (a, _), Some (b, _) -> let off l n = List.assoc_opt n l in if List.for_all (fun n -> off a n = off b n) [ "alive"; "heat"; "id"; "name" ] then begin incr failures; print_endline "FAIL permuting a defstruct left every DWARF offset unchanged" end | _ -> incr failures; print_endline "FAIL permuting a defstruct: no DWARF type for Cell"); (* A slot's *type* has to be right too, not only where it sits. These are the shapes lldb has to render, and the layout table says what each one weighs; a wrong size there is a truncated or over-read value. *) let ir = debug_ir (cell ^ body) in List.iter (fun (needle, what) -> if not (contains ir needle) then begin incr failures; Printf.printf "FAIL DWARF for %s\n wanted: %S\n" what needle end) [ ("!DIBasicType(name: \"i32\", size: 32, encoding: DW_ATE_signed)", "i32"); ("!DIBasicType(name: \"u8\", size: 8, encoding: DW_ATE_unsigned)", "u8"); ("!DIBasicType(name: \"f64\", size: 64, encoding: DW_ATE_float)", "f64"); (* A byte in memory, not a bit: an i1 alloca is one byte wide. *) ("!DIBasicType(name: \"bool\", size: 8, encoding: DW_ATE_boolean)", "bool"); (* ptr+len, and shown as ptr+len — there is no owner and no capacity to hide, so two members are the whole truth about a string. *) ("name: \"string\", size: 128", "string"); (* A let-bound local carries the name the source gave it. [Tast.fn] records one per slot and [Check] fills it in at the binding, so [(let [c ...)] is [c] in the debug info and not [s0] -- which is what it used to be, and was the one honest gap in this picture. *) ("!DILocalVariable(name: \"c\"", "a let-bound local, named by its source name"); ("!llvm.dbg.cu = ", "the compile unit is registered"); (* Without this LLVM discards every node above, silently. *) ("!{i32 2, !\"Debug Info Version\", i32 3}", "the module flag") ]; (* Parameters carry the name the source gave them. The typed IR does not record it — [Check] has it and drops it — so this is the driver handing the names down, and it is worth a test because the path is easy to forget when either end changes. *) let ir = debug_ir "(defn dist [ax f64 ay f64] f64 (+ ax ay))\n\ (defn main [] i32 (i32 (i64 (dist 1.0 2.0))))\n" in List.iter (fun needle -> if not (contains ir needle) then begin incr failures; Printf.printf "FAIL parameter names in DWARF\n wanted: %S\n" needle end) [ "!DILocalVariable(name: \"ax\", arg: 1"; "!DILocalVariable(name: \"ay\", arg: 2" ]; (* The transfer channel is a parameter of every Flan function and is not a Flan name, so it gets no variable at all — and must not, or it would take arg: 1 and shift every real parameter's storage by one. *) if contains ir "name: \"xfer\"" then begin incr failures; print_endline "FAIL the transfer channel appeared as a local variable" end; (* The two rules about a name that is not simply the source's own. A slot the compiler invented has no source name and keeps [s]: [dotimes] evaluates its bound once into a hidden slot, and calling that something plausible would put a variable in the debugger that is not in the file. [i] is the programmer's and is named; the bound is not. And a shadowed name is disambiguated. Every [!DILocalVariable] is scoped to the subprogram — the typed IR has no block structure to build a [!DILexicalBlock] from — so two slots both called [v] leave lldb answering [p v] with whichever it finds first. Measured: it answers with the outer one, and does not list the inner at all, so the debugger is confident and wrong. [~] cannot occur in a source symbol, so [v~2] is unambiguous and visibly the compiler's. The prelude shadows in [split-next], so this rule is load-bearing for the library too. *) let ir = debug_ir "(defn spin [n i32] i32\n\ \ (let [v 11]\n\ \ (let [v 22]\n\ \ (dotimes [i n] (set v (+ v i)))\n\ \ v)))\n\ (defn main [] i32 (spin 3))\n" in List.iter (fun (needle, what) -> if not (contains ir needle) then begin incr failures; Printf.printf "FAIL DWARF for %s\n wanted: %S\n" what needle end) [ ("!DILocalVariable(name: \"v\"", "the outer of two shadowed bindings"); ("!DILocalVariable(name: \"v~2\"", "the inner one, disambiguated"); ("!DILocalVariable(name: \"i\"", "a dotimes counter, which is the source's"); ("!DILocalVariable(name: \"s4\"", "dotimes' hidden bound, which is not") ]; (* LLVM's own verifier, over both entry points. String needles cannot see a DISubprogram the compile unit does not reach, or a call without a !dbg inside a function that has debug info — and that second one is a hard rejection, not a warning, so it would turn every debug build into a clang error rather than into anything visible here. [redefinition] is the half that needs this most. It is only ever run at the default debug:false today, and it differs from [program] in exactly the places metadata goes wrong: hidden bodies, the by-name cell and global loads, and flan_reload_install and flan_reload_call, which are raw defines with no subprogram that nonetheless contain calls. *) if Sys.command "command -v opt > /dev/null 2>&1" = 0 then begin let verifies name ir = let f = Filename.concat scratch "flan-dwarf-verify.ll" in Out_channel.with_open_bin f (fun ch -> Out_channel.output_string ch ir); let log = Filename.concat scratch "flan-dwarf-verify.log" in let code = Sys.command (Printf.sprintf "opt -passes=verify -disable-output %s > %s 2>&1" (Filename.quote f) (Filename.quote log)) in if code <> 0 then begin incr failures; Printf.printf "FAIL %s: LLVM's verifier rejected the module\n%s\n" name (In_channel.with_open_bin log In_channel.input_all) end; (try Sys.remove f with Sys_error _ -> ()); (try Sys.remove log with Sys_error _ -> ()) in (* A program with a bit of everything that emits a call the backend invents rather than one a Tast node asked for: a bounds check, a condition signalled and handled, a restart transferred to, a defer on the way out. Each would be a verifier rejection without a location. *) let src = "(defstruct Missing [id i32])\n\ (defvar seen i64)\n\ (defvar arr [4 i32])\n\ (defn pick [xs [i32] i i32] i32 (at xs i))\n\ (defn fetch [n i32] i32\n\ \ (restart-case\n\ \ (do (error (Missing {.id n})) 0)\n\ \ (use-value [v i32 s string] (do (print s) v))\n\ \ (use-placeholder [] -1)))\n\ (defn run [] i32\n\ \ (defer (set seen (+ seen 1)))\n\ \ (handler-bind [(Missing [m] (invoke-restart 'use-value 4 \"\"))]\n\ \ (fetch 3)))\n\ (defn main [] i32\n\ \ (set (at arr 2) 9)\n\ \ (let [s (slice arr 0 4)]\n\ \ (print (pick s 2)) (println \"\")\n\ \ (print (run)) (println \"\")\n\ \ 0))\n" in let decls = Parse.program (Reader.read_all ~file:"" src) in let p = Check.program decls in verifies "the whole program, with debug info" (Emit.program ~debug:true ~pnames:(pnames_of decls) p); (* And a redefinition module against a host that has every name — the shape C-c C-c produces. *) verifies "a redefinition module, with debug info" (Emit.redefinition ~dev:true ~debug:true ~known:(fun _ -> true) p ~fns:[ "fetch"; "run" ]); (* And one against a host that has none of them, which is the other path: every call goes through flan_dev_cell and every global through flan_dev_global, so the module is almost entirely different code. *) verifies "a redefinition of names the host does not have" (Emit.redefinition ~dev:true ~debug:true ~known:(fun _ -> false) p ~fns:[ "fetch"; "run" ]) end else print_endline "acceptance: the DWARF verifier cases skipped (no opt)"; (* A debug build and a release build must still be the same program. *) let debug_compile ?(dev = false) path = let exe = Filename.concat scratch ("flan-dbg-" ^ Filename.remove_extension (Filename.basename path) ^ if dev then "-dev" else "") in let l = Load.program ~file:path (Parse.program (Reader.read_file path)) in let p = Check.program l.Load.decls in let pnames = List.filter_map (fun (d : Ast.decl) -> match d.Ast.d with | Ast.Defn fn -> Some (fn.Ast.name, List.map (fun (f : Ast.field) -> f.Ast.fname) fn.Ast.params) | _ -> None) l.Load.decls in let p, csrcs, lflags = Reach.link ~dev l p in ignore (Build.executable ~opts:{ Build.default with debug = true; dev } ~csrcs ~lflags ~pnames p ~out:exe); exe in let expected = "42\n4.75\n42\ngrain\n" in List.iter (fun path -> let exe = debug_compile path in let code, text = run exe None in if text <> expected || code <> 0 then begin incr failures; Printf.printf "FAIL a --debug build of %s runs the same\n got: %S (exit %d)\n wanted: %S\n" path text code expected end) [ "programs/debug.flan"; "programs/debug-permuted.flan" ]; (* wasm32 is refused by name. The offsets above are the host's, and wasm32's 32-bit pointer moves every slice member; emitting them anyway would give a debugger a confident wrong answer. *) (match Build.executable ~opts:{ Build.default with debug = true; target = Some "wasm32-wasi" } { Tast.structs = []; unions = []; globals = []; externs = []; fns = []; cshim = [] } ~out:(Filename.concat scratch "flan-dbg-wasm") with | _ -> incr failures; print_endline "FAIL --debug --target=wasm32-wasi was accepted" | exception Failure m -> if not (contains m "--debug is native only") then begin incr failures; Printf.printf "FAIL --debug on wasm32\n said: %S\n" m end); (* -- lldb, for real ------------------------------------------------ Everything above is about the metadata being self-consistent. This is the only part that says a person can debug a Flan program: a breakpoint set on a Flan function *by name*, a backtrace with .flan files and line numbers, and locals printed with their own types and values. It is skipped rather than failed where there is no lldb. *) if Sys.command "command -v lldb > /dev/null 2>&1" = 0 then begin let lldb_run exe cmds = let out = Filename.concat scratch "flan-lldb.out" in let code = Sys.command (Printf.sprintf "lldb -b %s %s > %s 2>&1" (String.concat " " (List.map (fun c -> "-o " ^ Filename.quote c) cmds)) (Filename.quote exe) (Filename.quote out)) in let text = In_channel.with_open_bin out In_channel.input_all in (try Sys.remove out with Sys_error _ -> ()); (code, text) in let lldb_case name path needles = let exe = debug_compile path in let _, text = lldb_run exe [ "breakpoint set --name flan.tick"; "run"; "bt"; "frame variable"; "p *c" ] in List.iter (fun n -> if not (contains text n) then begin incr failures; Printf.printf "FAIL %s\n wanted %S in lldb's output\n" name n; print_endline text end) needles in (* The four claims, one needle each: the breakpoint resolved on a Flan name; the frame names a .flan file and a line inside tick; the caller is the Flan main and not a C frame; a parameter prints by its source name; and the struct through the pointer prints every field with the value the program put there. *) lldb_case "lldb: breakpoint, frames and locals" "programs/debug.flan" [ "flan.tick"; "at debug.flan:"; "flan.main at debug.flan:"; "(int) n = 41"; "alive = true"; "heat = 3.25"; "id = 7"; "len = 5"; (* And the let-bound local under its own name rather than [s0], which is the gap this closes. Only the name is claimed here: a name breakpoint stops on the function's first line, which is before the [let] has stored anything, so the value at this point is whatever the frame happened to hold. The value is pinned just below. *) "(int) bump" ]; (* And the same, with the fields permuted. If the offsets were not following the declaration, the values would land on the wrong names here and nowhere else. *) lldb_case "lldb: the same struct with its fields permuted" "programs/debug-permuted.flan" [ "at debug-permuted.flan:"; "flan.main at debug-permuted.flan:"; "(int) n = 41"; "alive = true"; "heat = 3.25"; "id = 7"; "len = 5" ]; (* The value, which the case above deliberately does not claim. Every [!DILocalVariable] is scoped to the whole subprogram and carries the function's own line, so a let-bound local is nominally in scope from entry and reads as garbage until its binding runs. Breaking *after* the binding is what makes the value load-bearing: [bump] is n+1 and n is 41, so 42 is the only right answer, and a [!DILocalVariable] attached to the wrong alloca prints something else. That is the check that a name which is present is also not a lie. *) let exe = debug_compile "programs/debug.flan" in let _, text = lldb_run exe [ "breakpoint set --file debug.flan --line 20"; "run"; "frame variable bump" ] in if not (contains text "(int) bump = 42") then begin incr failures; print_endline "FAIL lldb: a let-bound local's value after its binding"; print_endline text end; (* A dev build routes every call through a cell, so the call site is an indirect call through a mutable global. The frame above it is still the Flan caller with its own line: the indirection is in how the callee is found, not in how the frame is laid out, so nothing about unwinding changes. Worth pinning, because "the stack goes missing under --dev" would be the sort of thing found late. *) let exe = debug_compile ~dev:true "programs/debug.flan" in let _, text = lldb_run exe [ "breakpoint set --name flan.tick"; "run"; "bt" ] in List.iter (fun n -> if not (contains text n) then begin incr failures; Printf.printf "FAIL lldb: --dev --debug keeps the Flan stack\n wanted %S\n" n; print_endline text end) [ "flan.tick"; "flan.main at debug.flan:" ] end else print_endline "acceptance: lldb cases skipped (no lldb on PATH)"; (* ── Strings: UTF-8, the split cursor, and ASCII case ────────────── The prelude's port of Odin's core/unicode/utf8, which is the only part of a string library that needs no allocator. The valid decodes prove almost nothing on their own — a decoder that just masks and shifts gets every one of them right — so the test is the malformed group: an overlong two- and three-byte "/", a UTF-16 surrogate, a code point past U+10FFFF, a lead byte that leads nothing, a lone continuation byte, and a valid character truncated by the end of its slice. Each isolates one row of the accept_sizes table, and each answers width 1 so that a scan makes progress rather than hanging. Encoding is checked by round trip rather than against expected bytes, because an encoder and a decoder that are wrong in the same direction agree with each other and disagree with nothing else. At -O0 as well, for the reason the slice algorithms run there: a slice is a two-word struct through an alloca, decode-rune returns a struct by value, and the split cursor is mutated through a (Ptr Split) — mem2reg is exactly what would hide any of those being copied when it should be shared. *) let utf8_out = "0/0/f 65/1/t 233/2/t 26085/3/t 128512/4/t \n\ 0/1/f 0/1/f 0/1/f 0/1/f 0/1/f 0/1/f 0/1/f \n\ 0/1/f 0/1/f 0/1/f 0/1/f \n\ tft\n\ 0 3 8 13 3\n\ ttffft\n\ 26085 26412 -1 -1 -1 \n\ -1 1 1 2 2 3 3 -1 -1 3 3 4 4 -1 \n\ 0 65 127 128 2047 2048 65535 65536 1114111 \n\ -1 -1 -1 -1 -1 1 \n\ 65 -1 65 -1 65 \n\ [a][b][c] [a][][b] [abc] [] [][] [][a] [a][] \n\ 60\n\ 97 122 97 64 91 65 90 65 96 123 53 \n\ 195 195 \n\ tftfft\n" in outputs "utf-8, splitting and ascii case" "programs/utf8.flan" utf8_out; outputs ~opt:"-O0" "utf-8, splitting and ascii case, -O0" "programs/utf8.flan" utf8_out; 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)"