flan/test/test_flan.ml
2026-09-10 14:40:34 +07:00

122 lines
5.3 KiB
OCaml

(* Reader tests. Plain assertions, no test framework — another dependency that
would have to be reimplemented if the compiler is ever self-hosted. *)
open Flan
let failures = ref 0
let check name cond =
if not cond then begin
incr failures;
Printf.printf "FAIL %s\n" name
end
let reads name src expected =
match Reader.read_all ~file:"<test>" src with
| forms ->
let got = String.concat " " (List.map Form.to_string forms) in
if got <> expected then begin
incr failures;
Printf.printf "FAIL %s\n src: %s\n got: %s\n wanted: %s\n"
name src got expected
end
| exception Loc.Error (loc, msg) ->
incr failures;
Printf.printf "FAIL %s\n src: %s\n error: %s: %s\n"
name src (Loc.to_string loc) msg
let rejects name src =
match Reader.read_all ~file:"<test>" src with
| _ -> incr failures; Printf.printf "FAIL %s: expected a read error\n" name
| exception Loc.Error _ -> ()
let () =
(* ── Atoms ─────────────────────────────────────────────────────── *)
reads "integer" "42" "42";
reads "negative" "-1" "-1";
reads "float" "0.05" "0.05";
reads "hex" "0xE6B800FF" "3870818559";
reads "string" "\"SAND\"" "\"SAND\"";
reads "symbol" "empty-at?" "empty-at?";
reads "qualified" "rl/draw-fps" "rl/draw-fps";
reads "field access" ".pos" ".pos";
reads "operator" "->>" "->>";
reads "bare minus" "-" "-";
reads "keyword" ":space" ":space";
reads "else keyword" ":else" ":else";
(* Byte literals, as used by calc-me's tokenizer. *)
reads "byte named" "\\space" "\\space";
reads "byte digit" "\\0" "\\0";
reads "byte paren" "\\(" "\\(";
reads "byte dot" "\\." "\\.";
(* ── Sequences ─────────────────────────────────────────────────── *)
reads "list" "(+ 1 2)" "(+ 1 2)";
reads "vector" "[1 2 3]" "[1 2 3]";
reads "map literal" "{:src src :pos 0}" "{:src src :pos 0}";
reads "type notation" "[4 f32]" "[4 f32]";
reads "nested type" "[rows [cols u32]]" "[rows [cols u32]]";
reads "commas as space" "[1, 2, 3]" "[1 2 3]";
reads "nested" "(a (b [c {:d e}]))" "(a (b [c {:d e}]))";
(* ── Trivia ────────────────────────────────────────────────────── *)
reads "line comment" "; nope\n42" "42";
reads "trailing comment" "42 ; nope" "42";
reads "banner comment" ";;;; header\n(f)" "(f)";
reads "multiple forms" "(a) (b)" "(a) (b)";
reads "empty source" "" "";
reads "only comments" "; nothing here" "";
(* ── Quote ─────────────────────────────────────────────────────── *)
(* Restart names are quoted symbols. Before this existed, 'skip-form read as
a symbol *named* "'skip-form", which is silently a different symbol from
skip-form and nothing would ever have reported it. *)
reads "quote symbol" "'skip-form" "(quote skip-form)";
reads "quote in call" "(invoke-restart 'use-placeholder)"
"(invoke-restart (quote use-placeholder))";
reads "quote list" "'(a b)" "(quote (a b))";
(* The whole class: no reader-significant character may end up inside a name. *)
let rec bad_names f =
let open Form in
match f.v with
| Sym s | Kw s ->
if String.exists (fun c -> c = '\'' || c = '^') s then [ s ] else []
| List l | Vec l | Map l -> List.concat_map bad_names l
| _ -> []
in
let corpus = "(invoke-restart 'skip-form) (a 'b [c 'd] {:e 'f}) '(g 'h)" in
check "no sigils leak into names"
(bad_names (Form.make (Form.List (Reader.read_all ~file:"<test>" corpus))
Loc.unknown) = []);
(* ── Errors ────────────────────────────────────────────────────── *)
rejects "unclosed list" "(f x";
rejects "unbalanced close" ")";
rejects "mismatched" "(f x]";
rejects "unterminated str" "\"abc";
rejects "empty keyword" ":";
rejects "unknown char" "\\bogus";
rejects "metadata" "^:async";
rejects "dangling quote" "'";
(* ── Locations ─────────────────────────────────────────────────── *)
(match Reader.read_all ~file:"f.flan" "(a)\n (b)" with
| [ a; b ] ->
check "loc line 1" (a.loc.line = 1 && a.loc.col = 1);
check "loc line 2" (b.loc.line = 2 && b.loc.col = 3);
check "loc file" (a.loc.file = "f.flan")
| _ -> check "loc: two forms" false);
(match Reader.read_all ~file:"f.flan" "(f\n bad" with
| _ -> check "unclosed reports opening loc" false
| exception Loc.Error (loc, _) ->
check "unclosed reports opening loc" (loc.line = 1 && loc.col = 1));
if !failures = 0 then print_endline "reader: all tests passed"
else begin
Printf.printf "\n%d failure(s)\n" !failures;
exit 1
end