Something went wrong. Try again.
The Monad language. Dependent types, functional programming compiled with LLVM. Hobby project. monad-lang.org
dependent-types language compiler programming-language functional-programming
Something went wrong. Try again.
21 kB · 453 lines
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454/// End-to-end tests for the natives wired in the bootstrap-ladder pass:/// the GENERATED ones (`runtime/src/natives.mo` -- LLVM IR built in/// Monad itself) and the C-shaped ones (`runtime/src/runtime.c`).////// Each compiles real `.mo` source through the same pipeline/// `cli/src/main.mo`'s own `compile_file_codegen` uses, links it against/// the real runtime, RUNS the binary, and asserts its exit code --/// following `codegen_string_repr_tests.mo`'s/// `compile_source_run_expect` convention (reused verbatim).////// Running the binary is the whole point: every bug in this family was/// invisible to `llc`'s verifier. `String_to_list` silently compiling to/// a "return Unit" stub produced structurally valid IR and a binary that/// SIGSEGV'd inside `List_reverse_append` the moment `String.reverse`/// walked the Unit object as if it were a cons cell -- see/// `validate_no_unwired_natives`'s own doc comment for that story./// `String.reverse` is therefore deliberately exercised below.use std::process {process_id}use lang::codegen::test::e2e_harness {compile_source_run_expect}/// The generated `monad_string_starts_with` byte loop. A too-long/// prefix must fall out through the byte comparison against the NUL/// terminator, not a bounds check -- hence the "hello!" case.#[test]def test_generated_string_starts_with : IO Bool := let source := r#"def main (args : List String) : IO I64 := do { let yes := String.starts_with "he" "hello"; let no := String.starts_with "xy" "hello"; let too_long := String.starts_with "hello!" "hello"; let empty_prefix := String.starts_with "" "hello"; return (if yes && not no && not too_long && empty_prefix then 7 else 1)}"# in compile_source_run_expect source "gen_starts_with" 7/// `String.reverse` -- the exact path that SIGSEGV'd in v25. Routes/// through the generated `string_to_list`, `List.reverse`, and the C/// `string_from_list`, so it covers the cons-chain marshaling across/// the generated/C boundary in both directions.#[test]def test_generated_to_list_reverse_round_trip : IO Bool := let source := r#"def main (args : List String) : IO I64 := do { let there_and_back := String.beq (String.reverse (String.reverse "bootstrap")) "bootstrap"; let reversed := String.beq (String.reverse "abc") "cba"; let empty_ok := String.beq (String.reverse "") ""; return (if there_and_back && reversed && empty_ok then 7 else 1)}"# in compile_source_run_expect source "gen_reverse_round_trip" 7/// `String.ends_with` builds directly on reverse + starts_with, and is/// what `module_name_from_path` (lang/module.mo) calls on EVERY module/// load -- the first thing a self-compiled compiler binary executes.#[test]def test_generated_ends_with : IO Bool := let source := r#"def main (args : List String) : IO I64 := do { let yes := String.ends_with "cli/src/main.mo" ".mo"; let no := String.ends_with "lang/src/main.rs" ".mo"; return (if yes && not no then 7 else 1)}"# in compile_source_run_expect source "gen_ends_with" 7/// The generated `monad_string_get`: `Option U8` tags (none 3, some 4)/// through `alloc_constructor`, plus both out-of-bounds directions.#[test]def test_generated_string_get_option : IO Bool := let source := r#"def main (args : List String) : IO I64 := do { let at_1 := match String.get "hello" 1 { Option.some b => U8.beq b 101u8, Option.none => false }; let past_end := match String.get "hello" 99 { Option.some _ => false, Option.none => true }; let negative := match String.get "hello" (0 - 1) { Option.some _ => false, Option.none => true }; return (if at_1 && past_end && negative then 7 else 1)}"# in compile_source_run_expect source "gen_string_get" 7/// The generated unsigned ops, including the zero-divisor guard both/// `u8_div` and `u64_mod` carry (the reference returns 0 rather than/// trapping). `U64.mod` backs `std/map.mo`'s own bucket arithmetic, so/// the compiler's every HashMap depends on it.#[test]def test_generated_unsigned_ops : IO Bool := let source := r#"def main (args : List String) : IO I64 := do { let m := U64.beq (U64.mod 17u64 5u64) 2u64; let m0 := U64.beq (U64.mod 17u64 0u64) 0u64; let d := U8.beq (U8.div 17u8 5u8) 3u8; let d0 := U8.beq (U8.div 17u8 0u8) 0u8; let cmp := U8.lt 3u8 7u8 && U8.gt 7u8 3u8; return (if m && m0 && d && d0 && cmp then 7 else 1)}"# in compile_source_run_expect source "gen_unsigned_ops" 7/// The C `monad_string_to_lowercase` and `monad_u64_to_string`. The/// unsigned formatting cannot share `monad_i64_to_string`: a U64 near/// the top of its range is a negative i64 in this backend's uniform/// representation.#[test]def test_c_lowercase_and_unsigned_to_string : IO Bool := let source := r#"def main (args : List String) : IO I64 := do { let lower := String.beq (String.to_lowercase "MiXeD Case") "mixed case"; let u := String.beq (U64.to_string 42u64) "42"; let b := String.beq (U8.to_string 255u8) "255"; return (if lower && u && b then 7 else 1)}"# in compile_source_run_expect source "c_lowercase_to_string" 7/// The C `monad_exec_cmd` -- THE load-bearing native for the bootstrap/// ladder (`llvm/src/link.mo` invokes `llc`/`clang` through it, so/// a self-compiled compiler cannot run its own `compile` command/// without it). Asserts real exit-code passthrough from a real child/// process, including a non-zero code and a nonexistent binary.#[test]def test_c_exec_cmd_exit_codes : IO Bool := let source := r#"use std::process {exec_cmd}def main (args : List String) : IO I64 := do { let ok <- exec_cmd "true" []; let bad <- exec_cmd "false" []; let seven <- exec_cmd "sh" ["-c", "exit 7"]; let missing <- exec_cmd "definitely_no_such_binary_xyz" []; return (if ok == 0 && bad == 1 && seven == 7 && missing == 127 then 7 else 1)}"# in compile_source_run_expect source "c_exec_cmd" 7/// The C `monad_list_dir`: bare names, one level, SORTED. The sort is/// load-bearing rather than cosmetic -- readdir order is/// filesystem-dependent, and the reference sorts, so an unsorted/// implementation would make a compiled binary and the interpreter/// disagree on any directory walk.#[test]def test_c_list_dir_sorted : IO Bool := let dir := "/tmp/monad_e2e_listdir_" ++ I64.to_string process_id in let source := r#"use std::process {exec_cmd}def main (args : List String) : IO I64 := do { let dir := ""# ++ dir ++ r#""; exec_cmd "rm" ["-rf", dir]; exec_cmd "mkdir" ["-p", dir]; exec_cmd "touch" [dir ++ "/zeta", dir ++ "/alpha", dir ++ "/mid"]; let entries <- IO.list_dir (Path.path dir); exec_cmd "rm" ["-rf", dir]; let at := \i => match List.get i entries { Option.some e => e, Option.none => "<missing>" }; // Index 3 must be absent -- that plus the three names below pins // both the contents and the sort order, without `List.length` // (which needs an explicit `use std.list` import to compile). let sorted := String.beq (at 0) "alpha" && String.beq (at 1) "mid" && String.beq (at 2) "zeta"; let no_extra := String.beq (at 3) "<missing>"; return (if sorted && no_extra then 7 else 1)}"# in compile_source_run_expect source "c_list_dir" 7// --- `std/array.mo`'s six natives -----------------------------------//// The COMPILED half of what `std/array.mo`'s own `#[test]`s cover on// the Rust host. That split is the point: a native that passes every// host test can still be wired nowhere in codegen (the failure mode// `validate_no_unwired_natives` exists for), and only running a real// binary proves otherwise./// `array_new` + `array_len` + `array_get`: allocation with a fill,/// the O(1) length, and an in-range read.#[test]def test_array_new_len_get : IO Bool := let source := r#"use std::array {Array}def main (args : List String) : IO I64 := do { let a : Array I64 := Array.new 3 7; let len_ok := I64.beq (Array.length a) 3; let fill_ok := I64.beq (Array.get_or a 2 0) 7; return (if len_ok && fill_ok then 7 else 1)}"# in compile_source_run_expect source "array_new_len_get" 7/// Every out-of-range read is `Option.none` -- below zero, at `len`,/// and past it. In the compiled backend this is the difference between/// a bounds check and reading past the end of a heap object.#[test]def test_array_get_bounds : IO Bool := let source := r#"use std::array {Array}def main (args : List String) : IO I64 := do { let a : Array I64 := Array.new 2 5; let below := I64.beq (Array.get_or a (0 - 1) 99) 99; let at_len := I64.beq (Array.get_or a 2 99) 99; let past := I64.beq (Array.get_or a 77 99) 99; return (if below && at_len && past then 7 else 1)}"# in compile_source_run_expect source "array_get_bounds" 7/// `array_with` is PERSISTENT: the result carries the new value and/// the INPUT IS UNCHANGED. Without the second half, an implementation/// that writes through and returns the same object passes everything/// else -- and that implementation is exactly the cheaper wrong one.#[test]def test_array_set_is_persistent : IO Bool := let source := r#"use std::array {Array}def main (args : List String) : IO I64 := do { let a : Array I64 := Array.new 3 0; let b : Array I64 := Array.set a 1 42; let wrote := I64.beq (Array.get_or b 1 0) 42; let input_untouched := I64.beq (Array.get_or a 1 0) 0; return (if wrote && input_untouched then 7 else 1)}"# in compile_source_run_expect source "array_set_persistent" 7/// Elements are one machine word whatever their type, so the same/// natives serve `Array String` -- the polymorphism the design rests/// on, asserted in the backend where a wrong assumption would be a/// wild pointer rather than a type error.#[test]def test_array_holds_strings : IO Bool := let source := r#"use std::array {Array}def main (args : List String) : IO I64 := do { let a : Array String := Array.new 2 "x"; let b : Array String := Array.set a 0 "hello"; let wrote := String.beq (Array.get_or b 0 "none") "hello"; let other := String.beq (Array.get_or b 1 "none") "x"; return (if wrote && other then 7 else 1)}"# in compile_source_run_expect source "array_strings" 7/// `from_list`/`to_list` round trip with order preserved, which/// exercises the `set`-fold that builds an array from a list.#[test]def test_array_from_list_round_trip : IO Bool := let source := r#"use std::array {Array}def main (args : List String) : IO I64 := do { let xs : List I64 := List.cons 10 (List.cons 20 (List.cons 30 List.empty)); let a : Array I64 := Array.from_list xs; let len_ok := I64.beq (Array.length a) 3; let first := I64.beq (Array.get_or a 0 0) 10; let last := I64.beq (Array.get_or a 2 0) 30; let back := I64.beq (List.length (Array.to_list a)) 3; return (if len_ok && first && last && back then 7 else 1)}"# in compile_source_run_expect source "array_from_list" 7/// The mutable half: `set_in_place` writes through (genuinely O(1)/// here, unlike the interpreter's copy-on-write), and `freeze` COPIES/// -- so mutating the builder AFTER freezing must not disturb the/// frozen array. That aliasing assertion is the one that fails if/// `freeze` is ever "optimised" into a cast.#[test]def test_array_builder_freeze_does_not_alias : IO Bool := let source := r#"use std::array {Array, ArrayBuilder}def main (args : List String) : IO I64 := do { let b : ArrayBuilder I64 := Array.builder 3 0; Array.set_in_place b 1 42; let frozen : Array I64 <- Array.freeze b; let saw_write := I64.beq (Array.get_or frozen 1 0) 42; Array.set_in_place b 1 99; let frozen_unchanged := I64.beq (Array.get_or frozen 1 0) 42; return (if saw_write && frozen_unchanged then 7 else 1)}"# in compile_source_run_expect source "array_builder_freeze" 7/// The C `monad_string_count_newlines`/`monad_string_trailing_chars`/// (runtime.c). These back `lang/parser/position.mo`'s bulk offset/// resolver, which the compiler compiles into ITSELF -- so an unwired/// native here is not a missing convenience, it is a self-compiled/// compiler that reports wrong line:column, or fails codegen outright/// with `call to undefined symbol(s): monad_string_...`.////// Both halves of the contract are asserted, because the two runtimes/// have to agree byte for byte or host and compiled builds disagree/// about a column:/// * a LENGTH shorter than the string is honoured (nothing is sliced,/// so a native that ignored its second argument would still return/// the whole-string answer and pass a weaker test);/// * `trailing_chars` counts CHARACTERS, not bytes -- `"a—b"` is 5/// bytes and 3 characters -- and restarts at a newline.#[test]def test_c_newline_and_trailing_char_scans : IO Bool := let source := r#"def main (args : List String) : IO I64 := do { let s := "ab\nc—d\nefg"; let all_nl := I64.beq (String.count_newlines s (String.length s)) 2; let cut_nl := I64.beq (String.count_newlines s 3) 1; let none_nl := I64.beq (String.count_newlines s 2) 0; let tail := I64.beq (String.trailing_chars s (String.length s)) 3; let chars := I64.beq (String.trailing_chars s 8) 3; let whole := I64.beq (String.trailing_chars s 2) 2; return (if all_nl && cut_nl && none_nl && tail && chars && whole then 7 else 1)}"# in compile_source_run_expect source "string_newline_scans" 7/// The four generated `u16` arithmetic emitters plus the C/// `monad_u16_to_string` (runtime.c). `motes/http`'s `uri.mo`/`wire.mo`/// reach `u16_add`/`u16_mul`/`u16_to_string` on every request, so these/// are what make `moon`/`moose` compile at all -- before them the/// reachability-gated `validate_no_unwired_natives` fail-fast rejected/// the motes outright.////// The zero-divisor guard is asserted because the reference returns 0/// there rather than trapping, and `to_string` is asserted at BOTH ends/// of the range: 0 catches a sign/offset slip and 65535 catches a/// truncation to 8 bits, which is the mistake a "reuse the u8 emitter"/// shortcut would make.#[test]def test_generated_u16_ops : IO Bool := let source := r#"def main (args : List String) : IO I64 := do { let a := U16.beq (U16.add 300u16 400u16) 700u16; let s := U16.beq (U16.sub 700u16 300u16) 400u16; let m := U16.beq (U16.mul 300u16 4u16) 1200u16; let d := U16.beq (U16.div 1200u16 4u16) 300u16; let d0 := U16.beq (U16.div 17u16 0u16) 0u16; let lo := String.beq (U16.to_string 0u16) "0"; let hi := String.beq (U16.to_string 65535u16) "65535"; return (if a && s && m && d && d0 && lo && hi then 7 else 1)}"# in compile_source_run_expect source "gen_u16_ops" 7/// The C TCP natives (runtime.c) end to end: listen on an OS-assigned/// port, read it back with `tcp_local_port`, connect, accept, write,/// read, see EOF, and read a closed handle. The Rust evaluator has no/// TCP implementation at all, so THIS is the family's only test that/// compiles, links and runs the real thing -- the deleted unit tests in/// core_native.rs used to cover the same contract.////// Distinct non-7 exit codes name the failing step, because a failure/// here is otherwise just "the binary exited non-zero".////// The sequence is deliberately write-BEFORE-read on a single thread:/// these natives block, so a read that came before the write would hang/// rather than fail (see the note in runtime.c's TCP section).#[test]def test_c_tcp_roundtrip : IO Bool := let source := r#"use std::io {Socket}def main (args : List String) : IO I64 := do { let listen_res <- IO.tcp_listen 0u16; match listen_res { Result.err _ => return 1, Result.ok listener => do { let port <- IO.tcp_local_port listener; let conn_res <- IO.tcp_connect "127.0.0.1" port; match conn_res { Result.err _ => do { let _ <- IO.tcp_close_listener listener; return 2 }, Result.ok client => do { let accept_res <- IO.tcp_accept listener; let _ <- IO.tcp_close_listener listener; match accept_res { Result.err _ => do { let _ <- IO.tcp_close client; return 3 }, Result.ok server => do { let write_res <- IO.tcp_write client (String.to_list "hello"); let wrote_five := match write_res { Result.err _ => false, Result.ok n => U64.beq n 5u64 }; let read_res <- IO.tcp_read server 1024u64; let got_hello := match read_res { Result.err _ => false, Result.ok bytes => String.beq (String.from_list bytes) "hello" }; let _ <- IO.tcp_close client; let eof_res <- IO.tcp_read server 1024u64; let eof_is_empty := match eof_res { Result.err _ => false, Result.ok bytes => List.is_empty bytes }; let closed_res <- IO.tcp_read client 16u64; let closed_handle_errs := match closed_res { Result.err _ => true, Result.ok _ => false }; let _ <- IO.tcp_close server; if wrote_five && got_hello && eof_is_empty && closed_handle_errs then return 7 else return 4 } } } } } }}"# in compile_source_run_expect source "c_tcp_roundtrip" 7/// `IO.tcp_fd` end to end: both ends of a real connection hand back a/// descriptor that is non-negative and distinct from the peer's -- the/// first assertion ever to exercise the compiled `I32` comparison group/// (`runtime/src/natives.mo`), which the fd's `IO I32` type forces./// `I64.to_i32 0` for the zero because the corpus has no `i32` literal.#[test]def test_c_tcp_fd : IO Bool := let source := r#"use std::io {Socket}def main (args : List String) : IO I64 := do { let listen_res <- IO.tcp_listen 0u16; match listen_res { Result.err _ => return 1, Result.ok listener => do { let port <- IO.tcp_local_port listener; let conn_res <- IO.tcp_connect "127.0.0.1" port; match conn_res { Result.err _ => do { let _ <- IO.tcp_close_listener listener; return 2 }, Result.ok client => do { let accept_res <- IO.tcp_accept listener; let _ <- IO.tcp_close_listener listener; match accept_res { Result.err _ => do { let _ <- IO.tcp_close client; return 3 }, Result.ok server => do { let client_fd <- IO.tcp_fd client; let server_fd <- IO.tcp_fd server; let _ <- IO.tcp_close client; let _ <- IO.tcp_close server; let client_negative := I32.lt client_fd (I64.to_i32 0); let server_negative := I32.lt server_fd (I64.to_i32 0); let same_fd := I32.beq client_fd server_fd; if client_negative || server_negative || same_fd then return 4 else return 7 } } } } } }}"# in compile_source_run_expect source "c_tcp_fd" 7/// Connecting to a port nothing listens on is `Result.err`, not a hang/// and not a bogus `Socket` -- the same negative the deleted Rust unit/// test `test_tcp_connect_to_closed_port_returns_err` covered. The port/// is obtained by binding port 0 and closing the listener again, so it/// is one the kernel just handed out and nothing holds.#[test]def test_c_tcp_connect_to_closed_port_errs : IO Bool := let source := r#"use std::io {Socket}def main (args : List String) : IO I64 := do { let listen_res <- IO.tcp_listen 0u16; match listen_res { Result.err _ => return 1, Result.ok listener => do { let port <- IO.tcp_local_port listener; let _ <- IO.tcp_close_listener listener; let conn_res <- IO.tcp_connect "127.0.0.1" port; match conn_res { Result.err _ => return 7, Result.ok client => do { let _ <- IO.tcp_close client; return 2 } } } }}"# in compile_source_run_expect source "c_tcp_closed_port" 7