(* The dynamic-value runtime, driven from C. runtime/flan_dyn.c is a C ABI with no Flan spelling yet — the compiler lane is what gives it one — so the only way to reach every operation, and every way each one refuses, is a C main. test/dyn_ops.c is that main and programs/dyn-host.flan is the program it is linked against, which has no [main] of its own for the same reason programs/reload.flan does not. What is asserted here, and why each is its own thing: ops every operation's happy path, the tags, the printed form of each, text identity against text equality, and a vec that contains itself gc a million allocations against a hundred live, and the heap's high-water mark bounded unrooted the positive control: an object nothing points at is reclaimed. Without it a collector that never freed would pass everything nested a chain of vecs sixty-four deep, traced through one root sharing one object held three times — written through one path and read through another, and swept once when the last goes refuse:* twenty-four refusals, one process each, asserted on the sentence as well as on the status: a process that died some other way is not the guard firing, and the exit code cannot tell them apart One binary, built once, run twenty-nine times. The build is the expensive part and the runs are milliseconds, which is what keeps this inside `dune test` rather than behind an alias. *) open Flan (* The watchdog first: a hang is the one failure mode that reports nothing at all. See watchdog.ml. *) let () = Watchdog.arm ~seconds:600 "test_dyn" let failures = ref 0 let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL " ^ s)) fmt let scratch = Filename.get_temp_dir_name () let tmp name = Filename.concat scratch ("flan-dyn-" ^ name) let has 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 p = Check.program (Load.program ~file:"programs/dyn-host.flan" (Reader.read_file "programs/dyn-host.flan")).Load.decls in let exe = tmp "ops" in ignore (Build.executable ~csrcs:[ "dyn_ops.c" ] p ~out:exe); let run mode = let o = tmp (mode ^ ".out") and e = tmp (mode ^ ".err") in let code = Sys.command (Printf.sprintf "%s %s > %s 2> %s" (Filename.quote exe) (Filename.quote mode) (Filename.quote o) (Filename.quote e)) in let out = In_channel.with_open_bin o In_channel.input_all in let err = In_channel.with_open_bin e In_channel.input_all in List.iter (fun x -> try Sys.remove x with Sys_error _ -> ()) [ o; e ]; (code, out, err) in (* The happy paths. Each assertion inside prints its own FAIL line, so the output is the report and this only has to notice that there was one. *) let code, out, err = run "ops" in if code <> 0 || out <> "ops ok\n" then fail "the operations\n got: %S (exit %d, err %S)" out code err; (* The collector. Four sentences, each a yes: the high-water mark stayed under half a megabyte across forty megabytes of allocation, the heap settled small, the object count stayed bounded, and the hundred rooted values were all still what they were set to. *) let code, out, err = run "gc" in let want_gc = "peak under 512K: yes\nsettled under 32K: yes\n\ live objects bounded: yes\nlive set intact: yes\n" in if code <> 0 || out <> want_gc then fail "a million allocations against a hundred live\n\ \ got: %S (exit %d, err %S)\n wanted: %S" out code err want_gc; (* And the control. A collector that never freed anything would pass every other case in this file; this is the one it cannot. *) let code, out, _ = run "unrooted" in let want_un = "allocated: yes\nreclaimed all but the ring: yes\n" in if code <> 0 || out <> want_un then fail "an unrooted object\n got: %S (exit %d)\n wanted: %S" out code want_un; let code, out, _ = run "nested" in if code <> 0 || out <> "chain of 64 intact: yes\n" then fail "a chain of nested vecs\n got: %S (exit %d)" out code; let code, out, _ = run "sharing" in let want_sh = "three slots hold one object: yes\n\ write through one path is seen through another: yes\n\ shared object survives on the holder alone: yes\n\ still reachable: yes\n\ live bytes after dropping everything: ok\n" in if code <> 0 || out <> want_sh then fail "interior sharing\n got: %S (exit %d)\n wanted: %S" out code want_sh; (* Every refusal. The pair is (mode, a phrase the sentence must contain); the phrase is chosen to be the part that says *which* mistake it was, so a message that named the wrong operation or the wrong tag would not pass by accident. The tag names are asserted here too, as words: "int" and "text" and not 2 and 4. A message with a number in it is a puzzle, and the rule is written down in flan_dyn.c beside the table the words come from. *) let refusals = [ ("add", "dyn +: int and text"); ("sub", "dyn -: nil and int"); ("mul", "dyn *: bool and int"); ("div", "dyn /: vec and int"); ("rem", "dyn %: int and nil"); ("divzero", "does not divide by zero"); ("remzero", "does not divide by zero"); ("divover", "one past the largest i64"); ("lt", "dyn <: int and text"); ("le", "dyn <=: text and nil"); ("gt", "dyn >: vec and vec"); ("ge", "dyn >=: bool and bool"); ("len", "dyn len: int"); ("at", "dyn at: int and int"); ("atindex", "an index must be an int"); ("atrange", "index 9 is out of bounds for text of length 2"); ("atnegative", "index -1 is out of bounds"); ("setattext", "a text is immutable"); ("setatnotvec", "only a vec is assigned into"); ("setatrange", "index 0 is out of bounds for vec of length 0"); ("push", "only a vec is pushed to"); ("needi64", "dyn i64: text"); ("needf64", "dyn f64: int"); ("needbool", "dyn bool: nil") ] in List.iter (fun (mode, phrase) -> let code, out, err = run ("refuse:" ^ mode) in if code = 0 then fail "%s returned rather than trapping: %S" mode out else if not (has err phrase) then fail "%s did not say %S; it said %S" mode phrase err) refusals; (try Sys.remove exe with Sys_error _ -> ()); (* A line on the way out, because a test that says nothing when it passes is a test nobody can tell from a test that did not run. *) if !failures = 0 then Printf.printf " ok the dyn runtime: %d refusals and five runs\n" (List.length refusals) else exit 1 | _ -> print_endline "SKIP test_dyn: no clang"