Parse scalar expressions with source spans

test/test_main.ml

@@ -76,9 +76,114 @@ let diagnostic_cases =
         Diagnostic.set_file "" );
   ]
 
+let parse text = Parse.expression text
+
+let parse_error text =
+  try
+    ignore (parse text);
+    None
+  with Diagnostic.Error diagnostic -> Some diagnostic
+
+let parse_cases =
+  [
+    ( "integer and operator spans are recorded",
+      fun () ->
+        let parsed = parse "1 + 20" in
+        check_equal_string "whole span" "1:1-1:7" (Location.to_string parsed.Syntax.espan);
+        match parsed.Syntax.e with
+        | Syntax.EBinop (Syntax.Add, left, right) ->
+            check_equal_string "left span" "1:1-1:2" (Location.to_string left.Syntax.espan);
+            check_equal_string "right span" "1:5-1:7" (Location.to_string right.Syntax.espan)
+        | _ -> fail "shape" "expected an addition" );
+    ( "pipeline is right associative application",
+      fun () ->
+        match (parse "x |> f |> g").Syntax.e with
+        | Syntax.EApp (outer, inner) -> (
+            check "outer argument is the inner application"
+              (match outer.Syntax.e with Syntax.EVar "g" -> true | _ -> false);
+            match inner.Syntax.e with
+            | Syntax.EApp (f, arg) ->
+                check "inner function is f" (match f.Syntax.e with Syntax.EVar "f" -> true | _ -> false);
+                check "source is x" (match arg.Syntax.e with Syntax.EVar "x" -> true | _ -> false)
+            | _ -> fail "shape" "expected an application on the left" )
+        | _ -> fail "shape" "expected an application" );
+    ( "let, lambda and conditional parse with spans",
+      fun () ->
+        match (parse "let f = fun n -> if n > 0 then n else - n in f 3").Syntax.e with
+        | Syntax.ELet (name, _, body) ->
+            check_equal_string "bound name" "f" name;
+            check "body is an application" (match body.Syntax.e with Syntax.EApp _ -> true | _ -> false)
+        | _ -> fail "shape" "expected a let expression" );
+    ( "tuples and record insertion parse",
+      fun () ->
+        match (parse "(1, 2, 3)").Syntax.e with
+        | Syntax.ETuple [ _; _; _ ] -> check "tuple of three" true
+        | _ -> fail "shape" "expected a tuple";
+        match (parse "{ customer = \"Ada\" }").Syntax.e with
+        | Syntax.ERecord [ ("customer", _) ] -> check "record with one field" true
+        | _ -> fail "shape" "expected a record" );
+    ( "field projection binds tighter than application",
+      fun () ->
+        match (parse "f o.total").Syntax.e with
+        | Syntax.EApp (_, argument) ->
+            check "argument is a projection" (match argument.Syntax.e with Syntax.EField _ -> true | _ -> false)
+        | _ -> fail "shape" "expected an application" );
+    ( "comparison binds looser than conjunction",
+      fun () ->
+        match (parse "a && b = c").Syntax.e with
+        | Syntax.EBinop (Syntax.And, _, right) ->
+            check "right side is a comparison" (match right.Syntax.e with Syntax.EBinop (Syntax.Eq, _, _) -> true | _ -> false)
+        | _ -> fail "shape" "expected a conjunction at the root" );
+    ( "unexpected character reports a span",
+      fun () ->
+        match parse_error "let x = @" with
+        | None -> fail "lexical error" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message" "<none>:1:9: error: unexpected character '@'"
+              (Diagnostic.to_string diagnostic) );
+    ( "unterminated string reports the opening quote",
+      fun () ->
+        match parse_error "let s = \"abc" with
+        | None -> fail "string" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message" "<none>:1:9: error: unterminated string literal"
+              (Diagnostic.to_string diagnostic);
+            check_equal_string "span starts at the opening quote" "1:9-1:13"
+              (Location.to_string diagnostic.Diagnostic.span) );
+    ( "unterminated comment reports a span",
+      fun () ->
+        match parse_error "1 (* comment" with
+        | None -> fail "comment" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message" "<none>:1:3: error: unterminated comment"
+              (Diagnostic.to_string diagnostic);
+            check_equal_string "span starts at the comment opener" "1:3-1:13"
+              (Location.to_string diagnostic.Diagnostic.span) );
+    ( "integer literal overflow reports a span",
+      fun () ->
+        match parse_error "99999999999999999999999" with
+        | None -> fail "overflow" "expected a diagnostic"
+        | Some diagnostic ->
+            check "message is non empty" (String.length diagnostic.Diagnostic.message > 0);
+            check_equal_string "position" "1:1" (Location.pos_to_string diagnostic.Diagnostic.span.Location.start) );
+    ( "missing else reports the offending token",
+      fun () ->
+        match parse_error "if a then b" with
+        | None -> fail "syntax" "expected a diagnostic"
+        | Some diagnostic ->
+            check_equal_string "message" "<none>:1:12: error: syntax error: unexpected end of file"
+              (Diagnostic.to_string diagnostic) );
+    ( "nested comments are skipped",
+      fun () ->
+        let parsed = parse "(* a (* b *) c *) 7" in
+        check "the expression after the comment is parsed"
+          (match parsed.Syntax.e with Syntax.EInt 7 -> true | _ -> false) );
+  ]
+
 let () =
   Test_harness.run_suite "location" location_cases;
   Test_harness.run_suite "ident" ident_cases;
   Test_harness.run_suite "diagnostic" diagnostic_cases;
+  Test_harness.run_suite "parse" parse_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)