Add native build and compiler driver

test/test_harness.ml

@@ -0,0 +1,65 @@
+type case = string * (unit -> unit)
+
+let failures = ref 0
+
+let cases = ref 0
+
+let check name condition =
+  incr cases;
+  if condition then Printf.printf "ok   %s\n" name
+  else (
+    incr failures;
+    Printf.printf "FAIL %s\n" name)
+
+let fail name message =
+  incr cases;
+  incr failures;
+  Printf.printf "FAIL %s: %s\n" name message
+
+let check_equal_int name expected actual =
+  incr cases;
+  if expected = actual then Printf.printf "ok   %s\n" name
+  else (
+    incr failures;
+    Printf.printf "FAIL %s: expected %d, got %d\n" name expected actual)
+
+let check_equal_string name expected actual =
+  incr cases;
+  if expected = actual then Printf.printf "ok   %s\n" name
+  else (
+    incr failures;
+    Printf.printf "FAIL %s: expected %S, got %S\n" name expected actual)
+
+let check_true name message condition =
+  if condition then (incr cases; Printf.printf "ok   %s\n" name)
+  else fail name message
+
+let expect_diagnostic name thunk =
+  incr cases;
+  try
+    thunk ();
+    incr failures;
+    Printf.printf "FAIL %s: expected a diagnostic error\n" name
+  with
+  | Diagnostic.Error diagnostic ->
+      if diagnostic.Diagnostic.message = "" then (
+        incr failures;
+        Printf.printf "FAIL %s: empty diagnostic message\n" name)
+      else Printf.printf "ok   %s\n" name
+  | error ->
+      incr failures;
+      Printf.printf "FAIL %s: unexpected exception %s\n" name (Printexc.to_string error)
+
+let run_case (name, thunk) =
+  try thunk () with
+  | exception_ ->
+      incr failures;
+      Printf.printf "FAIL %s: raised %s\n" name (Printexc.to_string exception_)
+
+let run_suite suite cases =
+  print_endline ("--- " ^ suite ^ " ---");
+  List.iter run_case cases
+
+let failure_count () = !failures
+
+let case_count () = !cases

test/test_harness.mli

@@ -0,0 +1,11 @@
+type case = string * (unit -> unit)
+
+val check : string -> bool -> unit
+val fail : string -> string -> unit
+val check_equal_int : string -> int -> int -> unit
+val check_equal_string : string -> string -> string -> unit
+val check_true : string -> string -> bool -> unit
+val expect_diagnostic : string -> (unit -> unit) -> unit
+val run_suite : string -> case list -> unit
+val failure_count : unit -> int
+val case_count : unit -> int

test/test_main.ml

@@ -0,0 +1,84 @@
+open Test_harness
+
+let position line col offset = { Location.line = line; col = col; offset = offset }
+
+let span line1 col1 line2 col2 =
+  Location.make (position line1 col1 0) (position line2 col2 10)
+
+let location_cases =
+  let open Location in
+  [
+    ( "merge of two spans uses first start and second stop",
+      fun () ->
+        check_equal_string "merged span" "1:2-3:4"
+          (to_string (merge (span 1 2 1 5) (span 3 1 3 4))) );
+    ("merge with none returns the other span", fun () ->
+      check_equal_string "none merge" "2:3-2:3" (to_string (merge none (point (position 2 3 7)))));
+    ("is_none distinguishes the empty span", fun () ->
+      check "none is none" (is_none none);
+      check "point is not none" (not (is_none (point (position 1 1 0)))));
+    ("size measures offsets", fun () ->
+      check_equal_int "size" 10 (size (span 1 1 2 1)));
+    ("pos_to_string renders line and column", fun () ->
+      check_equal_string "pos" "12:34" (pos_to_string (position 12 34 100)));
+  ]
+
+let ident_cases =
+  [
+    ( "fresh identifiers get distinct stamps",
+      fun () ->
+        Ident.reset ();
+        let a = Ident.fresh "x" Location.none in
+        let b = Ident.fresh "x" Location.none in
+        check "distinct" (not (Ident.equal a b));
+        check_equal_int "compare is stamp order" (-1) (Ident.compare a b) );
+    ( "display keeps the source name while to_string is unique",
+      fun () ->
+        Ident.reset ();
+        let a = Ident.fresh "row" Location.none in
+        check_equal_string "display" "row" (Ident.display a);
+        check_equal_string "to_string" "row#1" (Ident.to_string a) );
+    ( "reset restarts numbering deterministically",
+      fun () ->
+        Ident.reset ();
+        let first = Ident.fresh "x" Location.none in
+        Ident.reset ();
+        let second = Ident.fresh "x" Location.none in
+        check_equal_int "same stamp after reset" (Ident.stamp first) (Ident.stamp second) );
+    ( "identifiers carry their source span",
+      fun () ->
+        Ident.reset ();
+        let a = Ident.fresh "x" (span 4 5 4 6) in
+        check_equal_string "span" "4:5-4:6" (Location.to_string (Ident.span a)) );
+  ]
+
+let diagnostic_cases =
+  [
+    ( "diagnostic renders file line column and message",
+      fun () ->
+        let d = Diagnostic.make (span 2 3 2 4) "unknown variable total" in
+        check_equal_string "to_string" "<none>:2:3: error: unknown variable total"
+          (Diagnostic.to_string d) );
+    ( "diagnostic renders a source excerpt with carets",
+      fun () ->
+        let d = Diagnostic.make (span 2 5 2 9) "bad field" in
+        let rendered = Diagnostic.render (Some "let a = 1\nlet b = a.bad\n") d in
+        check_true "rendered contains header" rendered
+          (rendered = "<none>:2:5: error: bad field\n  let b = a.bad\n      ^^^^") );
+    ( "error raises with the current file",
+      fun () ->
+        Diagnostic.set_file "sample.delta";
+        (try
+           Diagnostic.error (span 1 1 1 2) "boom";
+           fail "raises" "expected an error"
+         with Diagnostic.Error d ->
+           check_equal_string "file" "sample.delta" d.Diagnostic.file);
+        Diagnostic.set_file "" );
+  ]
+
+let () =
+  Test_harness.run_suite "location" location_cases;
+  Test_harness.run_suite "ident" ident_cases;
+  Test_harness.run_suite "diagnostic" diagnostic_cases;
+  Printf.printf "%d cases, %d failures\n" (Test_harness.case_count ()) (Test_harness.failure_count ());
+  exit (if Test_harness.failure_count () = 0 then 0 else 1)