qsp_parser/test/syntax_error.ml

module Ast = Qsp_syntax.Tree.Ast
module S = Qsp_syntax.S

let _position = (Lexing.dummy_pos, Lexing.dummy_pos)

type 'a report = { level : Qsp_syntax.Report.level; loc : 'a; message : string }
[@@deriving eq, show]

let report : S.pos report Alcotest.testable =
  let equal = equal_report (fun _ _ -> true) in
  let pp = pp_report (fun formater _ -> Format.fprintf formater "_position") in
  Alcotest.testable pp equal

let get_report :
    (S.pos Syntax.location, Qsp_syntax.Report.t) result -> S.pos report =
  function
  | Ok _ -> failwith "No error"
  | Error { level; loc; message } -> { level; loc; message }

let _test_instruction :
    ?k:(S.pos report -> unit) -> string -> S.pos report -> unit =
 fun ?k literal expected ->
  let _location = Printf.sprintf {|# Location
%s
------- |} literal in
  let actual = get_report @@ Syntax.parse _location and msg = literal in

  let () = Alcotest.(check' report ~msg ~expected ~actual) in
  match k with None -> () | Some f -> f actual

let else_column () =
  _test_instruction
    {|IF 1:
      0
      ELSE:
      1
      END|}
    {
      level = Error;
      loc = _position;
      message = "Unexpected operator after `ELSE`";
    }

let elseif_no_column () =
  _test_instruction
    {|IF 1:
      0
      ELSEIF 0
      1
      END|}
    {
      level = Error;
      loc = _position;
      message =
        "The `ELIF` expression does not end properly. A `:` is expected before \
         any instruction.";
    }

let unclosed_paren () =
  _test_instruction
    {|(1
    |}
    {
      level = Error;
      loc = _position;
      message = "Unexpected '('. Did you forgot a function before ?";
    }

let act_no_column () =
  _test_instruction
    {|ACT 1
      0
      END|}
    {
      level = Error;
      loc = _position;
      message = "Invalid `ACT` label. You probably missed a ':'";
    }

let missing_ampersand () =
  let result =
    {
      level = Error;
      loc = _position;
      message = "Missing separator between instructions";
    }
  in
  let () = _test_instruction "b = 1 a = 2" result
  and () = _test_instruction "let b = 1 a = 2" result
  and () = _test_instruction "set b = 1 a = 2" result in
  ()

let unclose_comment () =
  _test_instruction {| ! that's it|}
    { level = Error; loc = _position; message = "Unclosed string" }

(* Same but with nested string *)

let unclose_comment2 () =
  _test_instruction {|  !{ that's it }|}
    { level = Error; loc = _position; message = "Unclosed string" }

let syntax_error () =
  _test_instruction {|*clr $ cla|}
    { level = Error; loc = _position; message = "Unexpected character \"\"" }

let missing_operand () =
  let result =
    { level = Error; loc = _position; message = "Missing operand" }
  in
  let () = _test_instruction {|if  and other: 1|} result
  and () = _test_instruction {|a =  and other: 1|} result in
  ()

let unknow_function () =
  _test_instruction "a = ran(1, 2)"
    { level = Error; loc = _position; message = "Unexpected expression here." }

let inline_elif () =
  _test_instruction {|
		if a = 1:
		elseif a = 1: a = 1
  end|}
    {
      level = Error;
      loc = _position;
      message = "Mix between `IF` block and inline `ELIF`";
    }

let unclosed_block () =
  _test_instruction {|
if $ARGS[0] = 'arg':
	act'action':
end|}
    {
      level = Error;
      loc = _position;
      message =
        "Unclosed `IF` block. Another block ends before the `END` instruction.";
    };

  _test_instruction
    {|
IF 1:
ELSE
    0
      |}
    {
      level = Error;
      loc = _position;
      message =
        "Unclosed `ELSE` block. Another block ends before the `END` \
         instruction.";
    };
  _test_instruction
    {|
IF 1:
ELSEIF 0:
    0
      |}
    {
      level = Error;
      loc = _position;
      message =
        "Unclosed `ELIF` block. Another block ends before the `END` \
         instruction.";
    }

let comment_as_operator () =
  let result =
    {
      level = Error;
      loc = _position;
      message = "Missing separator between instructions";
    }
  in
  _test_instruction "gs 'a', 'b' ! target" result;
  _test_instruction "gs 'a' ! target" result

let missing_comparable () =
  let result =
    {
      level = Error;
      loc = _position;
      message = "Missing boolean after operator";
    }
  in
  _test_instruction "1 and >= 0" result;
  _test_instruction "1 >= and 0" result;
  _test_instruction "1 > and 0" result;
  _test_instruction "1 < and 0" result;
  _test_instruction "1 or >= 0" result;
  _test_instruction "1 >= or 0" result;
  _test_instruction "1 <= or 0" result;
  _test_instruction "1 = or 0" result

(** This code looks like a new location, but is actualy invalid. 
    The application should report the old location.
 *)
let location_change () =
  let result =
    {
      level = Error;
      loc = _position;
      message = "Missing boolean after operator";
    }
  in
  _test_instruction "1 and >= # invalid" result ~k:(fun actual ->
      let actual = (fst actual.loc).Lexing.pos_fname in

      Alcotest.(
        check' ~msg:"The location name is not valid" string ~actual
          ~expected:"Location"))

let misplaced_if () =
  _test_instruction {|
if $ARGS[0] = 'arg':
  0	
end if|}
    {
      level = Error;
      loc = _position;
      message = "Unexpected instruction after `IF` `END` block.";
    };
  _test_instruction {|
act 'arg':
  0	
end if|}
    {
      level = Error;
      loc = _position;
      message = "Unexpected instruction after `ACT` `END` block.";
    }

(* The location name *)

let unclosed_paren2 () =
  _test_instruction {|
iif(1,0,0 + iif(1, 1, 2)
|}
    { level = Error; loc = _position; message = "Unclosed `(`" }

let unclosed_act () =
  _test_instruction {|
		act 'Smthg':
			else
			end
		end|}
    {
      level = Error;
      loc = _position;
      message =
        "A block starting with `ACT` is not closed by `END`\n\
         If there are nested blocks, the error will points the highest block.";
    }

let unknown_operator () =
  _test_instruction
    {|
    variable + = 1
|}
    {
      level = Error;
      loc = _position;
      message = "Unknown operator. Did you write '+ =' instead of '+=' ?";
    }

let nested_string_mess () =
  _test_instruction
    {|
    '<<func('…', '…')>>'
|}
    { level = Error; loc = _position; message = "Unclosed string" }

let test =
  ( "Syntax Errors",
    [
      Alcotest.test_case "else:" `Quick else_column;
      Alcotest.test_case "elseif" `Quick elseif_no_column;
      Alcotest.test_case "(1" `Quick unclosed_paren;
      Alcotest.test_case "act 1" `Quick act_no_column;
      Alcotest.test_case "no &" `Quick missing_ampersand;
      Alcotest.test_case "unclose_comment" `Quick unclose_comment;
      Alcotest.test_case "unclose_comment2" `Quick unclose_comment2;
      Alcotest.test_case "Syntax error $" `Quick syntax_error;
      Alcotest.test_case "Missing operand" `Quick missing_operand;
      Alcotest.test_case "Unknown function" `Quick unknow_function;
      Alcotest.test_case "Inline elif" `Quick inline_elif;
      Alcotest.test_case "Unclosed block" `Quick unclosed_block;
      Alcotest.test_case "Unclosed block" `Quick comment_as_operator;
      Alcotest.test_case "Missing comparable" `Quick missing_comparable;
      Alcotest.test_case "Location change" `Quick location_change;
      Alcotest.test_case "Misplaced if" `Quick misplaced_if;
      Alcotest.test_case "(()" `Quick unclosed_paren2;
      Alcotest.test_case "act: else" `Quick unclosed_act;
      Alcotest.test_case "+ =" `Quick unknown_operator;
      Alcotest.test_case "'<<''>>'" `Quick nested_string_mess;
    ] )