aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorChimrod <>2023-10-01 19:07:17 +0200
committerChimrod <>2023-10-01 19:07:17 +0200
commit622bbf897af29ec6f7d533f915b0170d3a9c899f (patch)
treef985dc2f40c8ca9938e93b75fb266fe2b12330ae /test
parent2e41a214e4c2a2984ad3b2afa3d80178d227927f (diff)
Added some test for syntax errors
Diffstat (limited to 'test')
-rw-r--r--test/qsp_parser_test.ml832
-rw-r--r--test/syntax.ml832
-rw-r--r--test/syntax_error.ml85
3 files changed, 918 insertions, 831 deletions
diff --git a/test/qsp_parser_test.ml b/test/qsp_parser_test.ml
index 652ef75..cbbe91e 100644
--- a/test/qsp_parser_test.ml
+++ b/test/qsp_parser_test.ml
@@ -1,831 +1 @@
-module Parser = Qparser.Parser.Make (Qsp_syntax.Tree)
-module Tree = Qsp_syntax.Tree
-module Ast = Qsp_syntax.Tree.Ast
-module T = Ast
-
-let _position = (Lexing.dummy_pos, Lexing.dummy_pos)
-
-type 'a location = 'a * 'a Ast.statement list [@@deriving eq, show]
-
-(** Run the parser with the given expression and return the result *)
-let parse : string -> T.pos location =
- fun content ->
- let lexing =
- Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
- in
- match Qparser.Analyzer.parse (module Qsp_syntax.Tree) lexing with
- | Ok e -> e
- | Error e ->
- let msg = Format.asprintf "%a" Qsp_syntax.Report.pp e in
- raise (Failure msg)
-
-let location : T.pos location Alcotest.testable =
- let equal = equal_location (fun _ _ -> true) in
- let pp =
- pp_location (fun formater _ -> Format.fprintf formater "_position")
- in
- Alcotest.testable pp equal
-
-let test_empty_location () =
- let expected = (_position, [])
- and actual = parse {|# Location
-------- |}
- and msg = "Empty location" in
-
- Alcotest.(check' location ~msg ~expected ~actual)
-
-let test_location_without_database () =
- let expected = (_position, [])
- and actual = parse {|# $Location
-------- |}
- and msg = "Location without database" in
-
- let () = Alcotest.(check' location ~msg ~expected ~actual) in
-
- let actual = parse {|# !Location
-------- |} in
- let () = Alcotest.(check' location ~msg ~expected ~actual) in
-
- let actual = parse {|# ^Location
-------- |} in
- Alcotest.(check' location ~msg ~expected ~actual)
-
-let _test_instruction : string -> Ast.pos Ast.statement list -> unit =
- fun literal expected ->
- let expected = (_position, expected)
- and _location = Printf.sprintf {|# Location
-%s
-------- |} literal in
- let actual = parse _location and msg = literal in
-
- Alcotest.(check' location ~msg ~expected ~actual)
-
-let test_numeric_expression () =
- _test_instruction "123" [ Expression (Integer (_position, "123")) ]
-
-let test_negative_numeric_expression () =
- _test_instruction "-123"
- [ Expression (Op (_position, Neg, Integer (_position, "123"))) ]
-
-let test_negative_numeric_expression2 () =
- let index = None in
- let var = { Ast.pos = _position; name = "CURTIMESUN"; index } in
- _test_instruction "-(780-CurTimeSun)"
- Ast.
- [
- Expression
- (Op
- ( _position,
- Neg,
- BinaryOp (_position, Minus, Integer (_position, "780"), Ident var)
- ));
- ]
-
-let test_str_variable () =
- let index = None in
- let var = { Ast.pos = _position; name = "$VALUE"; index } in
- _test_instruction "$value" [ Expression (Ident var) ]
-
-let test_variable () =
- let index = None in
- let var = { Ast.pos = _position; name = "VALUE"; index } in
- _test_instruction "value" [ Expression (Ident var) ]
-
-let test_indexed_variable () =
- let index = Some Ast.(Integer (_position, "1")) in
- let var = { Ast.pos = _position; name = "VALUE"; index } in
- _test_instruction "value[1]" [ Expression (Ident var) ]
-
-let test_let_literal () =
- let index = None in
- let var = { Ast.pos = _position; name = "VALUE"; index } in
- _test_instruction "let value = '123'"
- Ast.[ Declaration (_position, var, Eq', Literal (_position, "123")) ]
-
-let test_set_array_append () =
- let var = { Ast.pos = _position; name = "$VALUE"; index = None } in
- _test_instruction "set $value[] = ''"
- Ast.[ Declaration (_position, var, Eq', Literal (_position, "")) ]
-
-let test_direct_assignation () =
- let index = None in
- let var = { T.pos = _position; name = "VALUE"; index } in
- _test_instruction "value = '123'"
- Ast.[ Declaration (_position, var, Eq', Literal (_position, "123")) ]
-
-let test_command_assignation () =
- let index = None in
- let st_1 = { Ast.pos = _position; name = "ST_1"; index } in
- _test_instruction "st_1 = input 'Enter the amount'"
- Ast.
- [
- Declaration
- ( _position,
- st_1,
- Eq',
- Function
- (_position, Input, [ Literal (_position, "Enter the amount") ]) );
- ]
-
-let test_assignation2 () =
- let index = None in
- let var = { Ast.pos = _position; name = "VALUE"; index } in
- _test_instruction "set value += 123"
- Ast.[ Declaration (_position, var, Inc, Integer (_position, "123")) ]
-
-let test_multilie_literal () =
- let index = None in
- let var = { Ast.pos = _position; name = "VALUE"; index } in
- _test_instruction {|
- value = {
-$a = '123'
-}|}
- Ast.
- [
- Declaration (_position, var, Eq', Literal (_position, "\n$a = '123'\n"));
- ]
-
-let test_nested_literal () =
- _test_instruction
- {|
- value = {
-
- {
-
- }
-}|}
- [
- Ast.Declaration
- ( _position,
- { Ast.pos = _position; name = "VALUE"; index = None },
- Qsp_syntax.T.Eq',
- Ast.Literal (_position, "\n\n {\n\n }\n") );
- ]
-
-let test_concat_literal () =
- _test_instruction {|
- '123'
- +'456'
-|}
- [
- Ast.Expression (Ast.Literal (_position, "123"));
- Ast.Expression
- (Ast.Op (_position, Qsp_syntax.T.Add, Ast.Literal (_position, "456")));
- ]
-
-let test_literal () =
- _test_instruction "'123'" [ Expression (Literal (_position, "123")) ]
-
-let test_qutoted_literal () =
- _test_instruction "'12''3'" [ Expression (Literal (_position, "12'3")) ]
-
-let test_multiline1 () =
- let content = {|
-apples = 5
-pears = 10
-|} in
-
- let index = None in
- let apples = { Ast.pos = _position; name = "APPLES"; index }
- and pears = { Ast.pos = _position; name = "PEARS"; index }
- and value_5 = Ast.Integer (_position, "5")
- and value_10 = Ast.Integer (_position, "10") in
- _test_instruction content
- Ast.
- [
- Declaration (_position, apples, Eq', value_5);
- Declaration (_position, pears, Eq', value_10);
- ]
-
-let test_multiline2 () =
- let content = "apples = 5 & pears = 10" in
-
- let index = None in
- let apples = { Ast.pos = _position; name = "APPLES"; index }
- and pears = { Ast.pos = _position; name = "PEARS"; index }
- and value_5 = Ast.Integer (_position, "5")
- and value_10 = Ast.Integer (_position, "10") in
- _test_instruction content
- [
- Declaration (_position, apples, Eq', value_5);
- Declaration (_position, pears, Eq', value_10);
- ]
-
-let test_equality () =
- let content = "apples = 5 = pears" in
- let index = None in
- let apples = { Ast.pos = _position; name = "APPLES"; index }
- and pears = { Ast.pos = _position; name = "PEARS"; index }
- and value_5 = Ast.Integer (_position, "5") in
- _test_instruction content
- [
- Declaration
- (_position, apples, Eq', BinaryOp (_position, Eq, value_5, Ident pears));
- ]
-
-let test_plus () =
- let content = {|
-apples = 5 + pears
-|} in
- let index = None in
- let apples = { Ast.pos = _position; name = "APPLES"; index }
- and pears = { Ast.pos = _position; name = "PEARS"; index }
- and value_5 = Ast.Integer (_position, "5") in
- _test_instruction content
- [
- Declaration
- ( _position,
- apples,
- Eq',
- BinaryOp (_position, Plus, value_5, Ident pears) );
- ]
-
-let test_plus_litt () =
- let content = {|
-'five'+ pears
-|} in
- let index = None in
- let pears = { Ast.pos = _position; name = "PEARS"; index } in
- _test_instruction content
- [
- Ast.(
- Expression
- (BinaryOp (_position, Plus, Literal (_position, "five"), Ident pears)));
- ]
-
-let test_concat () =
- let content = {|
-$firstName + ' ' + $lastName
-|} in
- _test_instruction content
- [
- Tree.Ast.Expression
- (Tree.Ast.BinaryOp
- ( _position,
- Plus,
- Tree.Ast.BinaryOp
- ( _position,
- Plus,
- Tree.Ast.Ident
- {
- Tree.Ast.pos = _position;
- name = "$FIRSTNAME";
- index = None;
- },
- Tree.Ast.Literal (_position, " ") ),
- Tree.Ast.Ident
- { Tree.Ast.pos = _position; name = "$LASTNAME"; index = None } ));
- ]
-
-let test_comment () = _test_instruction "! Comment" [ Comment _position ]
-
-let test_comment2 () =
- let index = None in
- let a = { Ast.pos = _position; name = "A"; index }
- and value_0 = Ast.Integer (_position, "0") in
- _test_instruction "a = 0 &! Comment"
- Ast.[ Declaration (_position, a, Eq', value_0); Comment _position ]
-
-let test_comment3 () = _test_instruction {|!!1234
- |} [ Comment _position ]
-
-(** The exclamation mark here is an operation and not a comment *)
-let test_comment4 () =
- let index = None in
- let a = { Ast.pos = _position; name = "A"; index }
- and value_0 = Ast.Integer (_position, "0") in
- _test_instruction "a = rand(0, 1) ! 0"
- [
- Ast.(
- Declaration
- ( _position,
- a,
- Eq',
- BinaryOp
- ( _position,
- Neq,
- Function
- ( _position,
- Rand,
- [ Integer (_position, "0"); Integer (_position, "1") ] ),
- value_0 ) ));
- ]
-
-let test_comment5 () =
- _test_instruction "a = rand() &! Comment"
- [
- Ast.Declaration
- ( _position,
- { Ast.pos = _position; name = "A"; index = None },
- Qsp_syntax.T.Eq',
- Ast.Function (_position, Rand, []) );
- Ast.Comment _position;
- ]
-
-let test_comment6 () =
- _test_instruction
- "gs 'stat' &!! It should be here, because some of the strigs have to be \
- initialized"
- [
- Ast.Call (_position, "GOSUB", [ Ast.Literal (_position, "stat") ]);
- Ast.Comment _position;
- ]
-
-let test_long_comment () =
- _test_instruction
- {| !'this part of the comment is inside
-single quotes' but "this is still part
-of the same comment because sometimes
-life is unfair." Oh yeah, {curly brackets
-also count}. This is still the same comment. |}
- [ Comment _position ]
-
-(** This test ensure that the unary operator is applied to the whole expression
- *)
-let test_precedence () =
- let index = None in
- let x = Ast.Ident { Ast.pos = _position; name = "X"; index }
- and y = Ast.Ident { Ast.pos = _position; name = "Y"; index } in
- _test_instruction "no x = y"
- Ast.[ Expression (Op (_position, No, BinaryOp (_position, Eq, x, y))) ]
-
-(** This test ensure that a ! is not considered as a comment in an
- expression *)
-let test_precedence2 () =
- let index = None in
- let x = { Ast.pos = _position; name = "X"; index }
- and y = Ast.Ident { Ast.pos = _position; name = "Y"; index } in
- _test_instruction "x = y ! 0"
- Ast.
- [
- Declaration
- ( _position,
- x,
- Eq',
- BinaryOp (_position, Neq, y, Integer (_position, "0")) );
- ]
-
-let test_if () =
- let index = Some Ast.(Integer (_position, "0")) in
- let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
- and expr1 = Ast.(Literal (_position, "blockA"))
- and expr2 = Ast.(Expression (Literal (_position, "You are in block A"))) in
- _test_instruction {| if $ARGS[0] = 'blockA':
- 'You are in block A'
-end |}
- Ast.
- [
- If
- {
- loc = _position;
- then_ = (_position, BinaryOp (_position, Eq, args, expr1), [ expr2 ]);
- elifs = [];
- else_ = [];
- };
- ]
-
-let test_if2 () =
- let index = Some Ast.(Integer (_position, "0")) in
- let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
- and expr1 = Ast.(Literal (_position, "blockA"))
- and expr2 = Ast.(Expression (Literal (_position, "You are in block A"))) in
- _test_instruction {| if $ARGS[0] = 'blockA':
- 'You are in block A'
-end if|}
- Ast.
- [
- If
- {
- loc = _position;
- then_ = (_position, BinaryOp (_position, Eq, args, expr1), [ expr2 ]);
- elifs = [];
- else_ = [];
- };
- ]
-
-let test_if_chained () =
- let value_0 = Ast.Integer (_position, "0") in
- _test_instruction {| if 0:
- 0
-end &! -- |}
- Ast.
- [
- If
- {
- loc = _position;
- then_ = (_position, value_0, [ Expression value_0 ]);
- elifs = [];
- else_ = [];
- };
- Comment _position;
- ]
-
-let test_if_equality () =
- _test_instruction {|
-if 0 = 0:
-end &! --
-|}
- [
- Ast.If
- {
- loc = _position;
- then_ =
- ( _position,
- Ast.BinaryOp
- ( _position,
- Qsp_syntax.T.Eq,
- Ast.Integer (_position, "0"),
- Ast.Integer (_position, "0") ),
- [] );
- elifs = [];
- else_ = [];
- };
- Ast.Comment _position;
- ]
-
-let test_if_inline () =
- let value_0 = Ast.Integer (_position, "0") in
- _test_instruction "if 0: 0 else 0"
- Ast.
- [
- If
- {
- loc = _position;
- then_ = (_position, value_0, [ Expression value_0 ]);
- elifs = [];
- else_ = [ Expression value_0 ];
- };
- ]
-
-let test_if_inline_comment () =
- let value_0 = Ast.Integer (_position, "0") in
- _test_instruction "if 0: 0 else 0 &! comment "
- Ast.
- [
- If
- {
- loc = _position;
- then_ = (_position, value_0, [ Expression value_0 ]);
- elifs = [];
- else_ = [ Expression value_0 ];
- };
- Comment _position;
- ]
-
-let test_if_inline_comment2 () =
- _test_instruction "if 0: 1 & !! Comment"
- [
- Ast.If
- {
- loc = _position;
- then_ =
- ( _position,
- Ast.Integer (_position, "0"),
- [
- Ast.Expression (Ast.Integer (_position, "1"));
- Ast.Comment _position;
- ] );
- elifs = [];
- else_ = [];
- };
- ]
-
-let test_if_inline_act () =
- _test_instruction "if 1 and hour >= 8: minut += 1 & act 'go': gt 'go'"
- [
- Ast.If
- {
- loc = _position;
- then_ =
- ( _position,
- Ast.BinaryOp
- ( _position,
- Qsp_syntax.T.And,
- Ast.Integer (_position, "1"),
- Ast.BinaryOp
- ( _position,
- Qsp_syntax.T.Gte,
- Ast.Ident
- { Ast.pos = _position; name = "HOUR"; index = None },
- Ast.Integer (_position, "8") ) ),
- [
- Ast.Declaration
- ( _position,
- { Ast.pos = _position; name = "MINUT"; index = None },
- Qsp_syntax.T.Inc,
- Ast.Integer (_position, "1") );
- Ast.Act
- {
- loc = _position;
- label = Ast.Literal (_position, "go");
- statements =
- [
- Ast.Call
- (_position, "GOTO", [ Ast.Literal (_position, "go") ]);
- ];
- };
- ] );
- elifs = [];
- else_ = [];
- };
- ]
-
-let test_if_inline_act2 () =
- _test_instruction "if 1: act 'go': gt 'go' &! comment "
- [
- Ast.If
- {
- loc = _position;
- then_ =
- ( _position,
- Ast.Integer (_position, "1"),
- [
- Ast.Act
- {
- loc = _position;
- label = Ast.Literal (_position, "go");
- statements =
- [
- Ast.Call
- (_position, "GOTO", [ Ast.Literal (_position, "go") ]);
- Ast.Comment _position;
- ];
- };
- ] );
- elifs = [];
- else_ = [];
- };
- ]
-
-let test_precedence3 () =
- let index = Some Ast.(Integer (_position, "0")) in
- let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
- and expr1 = Ast.(Literal (_position, "blockA"))
- and expr2 = Ast.(Expression (Literal (_position, "You are in block A")))
- and expr3 = Ast.(Expression (Integer (_position, "0"))) in
- _test_instruction {| if $ARGS[0] = 'blockA': 'You are in block A' & 0|}
- Ast.
- [
- If
- {
- loc = _position;
- then_ =
- ( _position,
- BinaryOp (_position, Eq, args, expr1),
- [ expr2; expr3 ] );
- elifs = [];
- else_ = [];
- };
- ]
-
-let test_gs () =
- _test_instruction "gs '123'"
- [ Ast.(Call (_position, "GOSUB", [ Literal (_position, "123") ])) ]
-
-let test_gt () =
- _test_instruction "gt $curloc"
- [
- Ast.Call
- ( _position,
- "GOTO",
- [ Ast.Ident { Ast.pos = _position; name = "$CURLOC"; index = None } ]
- );
- ]
-
-let test_nl () =
- _test_instruction "*NL 'It'"
- [ Ast.Call (_position, "*NL", [ Ast.Literal (_position, "It") ]) ]
-
-let test_function () =
- _test_instruction "iif(123, 1, 0)"
- [
- Ast.(
- Expression
- (Function
- ( _position,
- Iif,
- [
- Integer (_position, "123");
- Integer (_position, "1");
- Integer (_position, "0");
- ] )));
- ]
-
-(** Include a space before the parameters *)
-let test_function2 () =
- _test_instruction "rand (0, 1)"
- [
- Ast.(
- Expression
- (Function
- ( _position,
- Rand,
- [ Integer (_position, "0"); Integer (_position, "1") ] )));
- ]
-
-let test_precedence4 () =
- _test_instruction "trim()" Ast.[ Expression (Function (_position, Trim, [])) ]
-
-(** This should not be a keyword without arguments, followed by an expression *)
-let test_precedence5 () =
- _test_instruction "clear()" Ast.[ Call (_position, "CLEAR", []) ]
-
-let test_precedence6 () =
- _test_instruction "(1 = 0 and 2 ! 3)"
- [
- Ast.Expression
- (Ast.BinaryOp
- ( _position,
- And,
- Ast.BinaryOp
- ( _position,
- Eq,
- Ast.Integer (_position, "1"),
- Ast.Integer (_position, "0") ),
- Ast.BinaryOp
- ( _position,
- Neq,
- Ast.Integer (_position, "2"),
- Ast.Integer (_position, "3") ) ));
- ]
-
-(** An identifier cannot start by a number *0 is a product and not an
- identifier *)
-let test_operator () =
- let index = None in
- let a = { Ast.pos = _position; name = "A"; index }
- and value_0 = Ast.Integer (_position, "0") in
- _test_instruction "a *0"
- Ast.[ Expression (BinaryOp (_position, Product, Ident a, value_0)) ]
-
-let test_operator2 () =
- let value_0 = Ast.Integer (_position, "0") in
- _test_instruction "0 *rand()"
- Ast.
- [
- Expression
- (BinaryOp (_position, Product, value_0, Function (_position, Rand, [])));
- ]
-
-let test_dyneval () =
- _test_instruction "dyneval ''"
- [
- Ast.Expression
- (Ast.Function (_position, Dyneval, [ Ast.Literal (_position, "") ]));
- ]
-
-(** The parens after input are considered as arguments for the function, not a
- following expression.
-
- This expression is a boolean.
-*)
-let test_input () =
- _test_instruction "( input('') = '' )"
- [
- Tree.Ast.Expression
- (Tree.Ast.BinaryOp
- ( _position,
- Eq,
- Tree.Ast.Function
- (_position, Input, [ Tree.Ast.Literal (_position, "") ]),
- Tree.Ast.Literal (_position, "") ));
- ]
-
-let test_mutiple_inline_ifs () =
- _test_instruction "if 1 > 0: 1 else if 1 < 0: 0"
- [
- Tree.Ast.If
- {
- loc = _position;
- then_ =
- ( _position,
- Tree.Ast.BinaryOp
- ( _position,
- Gt,
- Tree.Ast.Integer (_position, "1"),
- Tree.Ast.Integer (_position, "0") ),
- [ Tree.Ast.Expression (Tree.Ast.Integer (_position, "1")) ] );
- elifs = [];
- else_ =
- [
- Tree.Ast.If
- {
- loc = _position;
- then_ =
- ( _position,
- Tree.Ast.BinaryOp
- ( _position,
- Lt,
- Tree.Ast.Integer (_position, "1"),
- Tree.Ast.Integer (_position, "0") ),
- [
- Tree.Ast.Expression (Tree.Ast.Integer (_position, "0"));
- ] );
- elifs = [];
- else_ = [];
- };
- ];
- };
- ]
-
-let test_precedence7 () =
- _test_instruction "(1 + 1 = '')"
- [
- Tree.Ast.Expression
- (Tree.Ast.BinaryOp
- ( _position,
- Eq,
- Tree.Ast.BinaryOp
- ( _position,
- Plus,
- Tree.Ast.Integer (_position, "1"),
- Tree.Ast.Integer (_position, "1") ),
- Tree.Ast.Literal (_position, "") ));
- ]
-
-let test_precedence8 () =
- _test_instruction "(0 = 1 or 0 = 1)"
- [
- Tree.Ast.Expression
- (Tree.Ast.BinaryOp
- ( _position,
- Or,
- Tree.Ast.BinaryOp
- ( _position,
- Eq,
- Tree.Ast.Integer (_position, "0"),
- Tree.Ast.Integer (_position, "1") ),
- Tree.Ast.BinaryOp
- ( _position,
- Eq,
- Tree.Ast.Integer (_position, "0"),
- Tree.Ast.Integer (_position, "1") ) ));
- ]
-
-let syntax =
- ( "Syntax",
- [
- Alcotest.test_case "Location" `Quick test_empty_location;
- Alcotest.test_case "Location" `Quick test_location_without_database;
- Alcotest.test_case " Numeric expression" `Quick test_numeric_expression;
- Alcotest.test_case "-Numeric expression" `Quick
- test_negative_numeric_expression;
- Alcotest.test_case "-Numeric expression2" `Quick
- test_negative_numeric_expression2;
- Alcotest.test_case "$Variable expression" `Quick test_str_variable;
- Alcotest.test_case " Variable expression" `Quick test_variable;
- Alcotest.test_case "Indexed Variable expression" `Quick
- test_indexed_variable;
- Alcotest.test_case "Let instruction" `Quick test_let_literal;
- Alcotest.test_case "Set array_append" `Quick test_set_array_append;
- Alcotest.test_case "Variable_assignation" `Quick test_direct_assignation;
- Alcotest.test_case "Command assignation" `Quick test_command_assignation;
- Alcotest.test_case "Variable_assignation2" `Quick test_assignation2;
- Alcotest.test_case "Literal" `Quick test_literal;
- Alcotest.test_case "Literal2" `Quick test_qutoted_literal;
- Alcotest.test_case "Literal3" `Quick test_multilie_literal;
- Alcotest.test_case "Concat Literal" `Quick test_concat_literal;
- Alcotest.test_case "Nested Literal" `Quick test_nested_literal;
- Alcotest.test_case "Multiline1" `Quick test_multiline1;
- Alcotest.test_case "Multiline2" `Quick test_multiline2;
- Alcotest.test_case "Equality" `Quick test_equality;
- Alcotest.test_case "Plus" `Quick test_plus;
- Alcotest.test_case "Plus_litt" `Quick test_plus_litt;
- Alcotest.test_case "PlusChained" `Quick test_concat;
- Alcotest.test_case "Comment" `Quick test_comment;
- Alcotest.test_case "Comment2" `Quick test_comment2;
- Alcotest.test_case "Comment3" `Quick test_comment3;
- Alcotest.test_case "Comment4" `Quick test_comment4;
- Alcotest.test_case "Comment5" `Quick test_comment5;
- Alcotest.test_case "Comment6" `Quick test_comment6;
- Alcotest.test_case "Multiline Comment" `Quick test_long_comment;
- Alcotest.test_case "If" `Quick test_if;
- Alcotest.test_case "If - end if" `Quick test_if2;
- Alcotest.test_case "If_chained" `Quick test_if_chained;
- Alcotest.test_case "If_equality" `Quick test_if_equality;
- Alcotest.test_case "If inline" `Quick test_if_inline;
- Alcotest.test_case "If inline &!" `Quick test_if_inline_comment;
- Alcotest.test_case "If inline & !!" `Quick test_if_inline_comment2;
- Alcotest.test_case "If : act" `Quick test_if_inline_act;
- Alcotest.test_case "If : act: &!" `Quick test_if_inline_act2;
- Alcotest.test_case "Precedence1" `Quick test_precedence;
- Alcotest.test_case "Precedence2" `Quick test_precedence2;
- Alcotest.test_case "Precedence3" `Quick test_precedence3;
- Alcotest.test_case "Call gs" `Quick test_gs;
- Alcotest.test_case "Call gt" `Quick test_gt;
- Alcotest.test_case "Call nl" `Quick test_nl;
- Alcotest.test_case "Function iif" `Quick test_function;
- Alcotest.test_case "Function rand" `Quick test_function2;
- Alcotest.test_case "Precedence4" `Quick test_precedence4;
- Alcotest.test_case "Precedence5" `Quick test_precedence5;
- Alcotest.test_case "Precedence6" `Quick test_precedence6;
- Alcotest.test_case "Operator" `Quick test_operator;
- Alcotest.test_case "Operator2" `Quick test_operator2;
- Alcotest.test_case "Dyneval" `Quick test_dyneval;
- Alcotest.test_case "Input" `Quick test_input;
- Alcotest.test_case "inline if else if" `Quick test_mutiple_inline_ifs;
- Alcotest.test_case "Precedence7" `Quick test_precedence7;
- Alcotest.test_case "Precedence8" `Quick test_precedence8;
- ] )
-
-let () = Alcotest.run "qsp_parser" [ syntax ]
+let () = Alcotest.run "qsp_parser" [ Syntax.test; Syntax_error.test ]
diff --git a/test/syntax.ml b/test/syntax.ml
new file mode 100644
index 0000000..8c6334e
--- /dev/null
+++ b/test/syntax.ml
@@ -0,0 +1,832 @@
+module Parser = Qparser.Parser.Make (Qsp_syntax.Tree)
+module Tree = Qsp_syntax.Tree
+module Ast = Qsp_syntax.Tree.Ast
+module T = Ast
+
+let _position = (Lexing.dummy_pos, Lexing.dummy_pos)
+
+type 'a location = 'a * 'a Ast.statement list [@@deriving eq, show]
+
+let get_location :
+ (T.pos location, Qsp_syntax.Report.t) result -> T.pos location = function
+ | Ok e -> e
+ | Error e ->
+ let msg = Format.asprintf "%a" Qsp_syntax.Report.pp e in
+ raise (Failure msg)
+
+(** Run the parser with the given expression and return the result *)
+let parse : string -> (T.pos location, Qsp_syntax.Report.t) result =
+ fun content ->
+ let lexing =
+ Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
+ in
+ Qparser.Analyzer.parse (module Qsp_syntax.Tree) lexing
+
+let location : T.pos location Alcotest.testable =
+ let equal = equal_location (fun _ _ -> true) in
+ let pp =
+ pp_location (fun formater _ -> Format.fprintf formater "_position")
+ in
+ Alcotest.testable pp equal
+
+let test_empty_location () =
+ let expected = (_position, [])
+ and actual = get_location @@ parse {|# Location
+------- |}
+ and msg = "Empty location" in
+
+ Alcotest.(check' location ~msg ~expected ~actual)
+
+let test_location_without_database () =
+ let expected = (_position, [])
+ and actual = get_location @@ parse {|# $Location
+------- |}
+ and msg = "Location without database" in
+
+ let () = Alcotest.(check' location ~msg ~expected ~actual) in
+
+ let actual = get_location @@ parse {|# !Location
+------- |} in
+ let () = Alcotest.(check' location ~msg ~expected ~actual) in
+
+ let actual = get_location @@ parse {|# ^Location
+------- |} in
+ Alcotest.(check' location ~msg ~expected ~actual)
+
+let _test_instruction : string -> Ast.pos Ast.statement list -> unit =
+ fun literal expected ->
+ let expected = (_position, expected)
+ and _location = Printf.sprintf {|# Location
+%s
+------- |} literal in
+ let actual = get_location @@ parse _location and msg = literal in
+
+ Alcotest.(check' location ~msg ~expected ~actual)
+
+let test_numeric_expression () =
+ _test_instruction "123" [ Expression (Integer (_position, "123")) ]
+
+let test_negative_numeric_expression () =
+ _test_instruction "-123"
+ [ Expression (Op (_position, Neg, Integer (_position, "123"))) ]
+
+let test_negative_numeric_expression2 () =
+ let index = None in
+ let var = { Ast.pos = _position; name = "CURTIMESUN"; index } in
+ _test_instruction "-(780-CurTimeSun)"
+ Ast.
+ [
+ Expression
+ (Op
+ ( _position,
+ Neg,
+ BinaryOp (_position, Minus, Integer (_position, "780"), Ident var)
+ ));
+ ]
+
+let test_str_variable () =
+ let index = None in
+ let var = { Ast.pos = _position; name = "$VALUE"; index } in
+ _test_instruction "$value" [ Expression (Ident var) ]
+
+let test_variable () =
+ let index = None in
+ let var = { Ast.pos = _position; name = "VALUE"; index } in
+ _test_instruction "value" [ Expression (Ident var) ]
+
+let test_indexed_variable () =
+ let index = Some Ast.(Integer (_position, "1")) in
+ let var = { Ast.pos = _position; name = "VALUE"; index } in
+ _test_instruction "value[1]" [ Expression (Ident var) ]
+
+let test_let_literal () =
+ let index = None in
+ let var = { Ast.pos = _position; name = "VALUE"; index } in
+ _test_instruction "let value = '123'"
+ Ast.[ Declaration (_position, var, Eq', Literal (_position, "123")) ]
+
+let test_set_array_append () =
+ let var = { Ast.pos = _position; name = "$VALUE"; index = None } in
+ _test_instruction "set $value[] = ''"
+ Ast.[ Declaration (_position, var, Eq', Literal (_position, "")) ]
+
+let test_direct_assignation () =
+ let index = None in
+ let var = { T.pos = _position; name = "VALUE"; index } in
+ _test_instruction "value = '123'"
+ Ast.[ Declaration (_position, var, Eq', Literal (_position, "123")) ]
+
+let test_command_assignation () =
+ let index = None in
+ let st_1 = { Ast.pos = _position; name = "ST_1"; index } in
+ _test_instruction "st_1 = input 'Enter the amount'"
+ Ast.
+ [
+ Declaration
+ ( _position,
+ st_1,
+ Eq',
+ Function
+ (_position, Input, [ Literal (_position, "Enter the amount") ]) );
+ ]
+
+let test_assignation2 () =
+ let index = None in
+ let var = { Ast.pos = _position; name = "VALUE"; index } in
+ _test_instruction "set value += 123"
+ Ast.[ Declaration (_position, var, Inc, Integer (_position, "123")) ]
+
+let test_multilie_literal () =
+ let index = None in
+ let var = { Ast.pos = _position; name = "VALUE"; index } in
+ _test_instruction {|
+ value = {
+$a = '123'
+}|}
+ Ast.
+ [
+ Declaration (_position, var, Eq', Literal (_position, "\n$a = '123'\n"));
+ ]
+
+let test_nested_literal () =
+ _test_instruction
+ {|
+ value = {
+
+ {
+
+ }
+}|}
+ [
+ Ast.Declaration
+ ( _position,
+ { Ast.pos = _position; name = "VALUE"; index = None },
+ Qsp_syntax.T.Eq',
+ Ast.Literal (_position, "\n\n {\n\n }\n") );
+ ]
+
+let test_concat_literal () =
+ _test_instruction {|
+ '123'
+ +'456'
+|}
+ [
+ Ast.Expression (Ast.Literal (_position, "123"));
+ Ast.Expression
+ (Ast.Op (_position, Qsp_syntax.T.Add, Ast.Literal (_position, "456")));
+ ]
+
+let test_literal () =
+ _test_instruction "'123'" [ Expression (Literal (_position, "123")) ]
+
+let test_qutoted_literal () =
+ _test_instruction "'12''3'" [ Expression (Literal (_position, "12'3")) ]
+
+let test_multiline1 () =
+ let content = {|
+apples = 5
+pears = 10
+|} in
+
+ let index = None in
+ let apples = { Ast.pos = _position; name = "APPLES"; index }
+ and pears = { Ast.pos = _position; name = "PEARS"; index }
+ and value_5 = Ast.Integer (_position, "5")
+ and value_10 = Ast.Integer (_position, "10") in
+ _test_instruction content
+ Ast.
+ [
+ Declaration (_position, apples, Eq', value_5);
+ Declaration (_position, pears, Eq', value_10);
+ ]
+
+let test_multiline2 () =
+ let content = "apples = 5 & pears = 10" in
+
+ let index = None in
+ let apples = { Ast.pos = _position; name = "APPLES"; index }
+ and pears = { Ast.pos = _position; name = "PEARS"; index }
+ and value_5 = Ast.Integer (_position, "5")
+ and value_10 = Ast.Integer (_position, "10") in
+ _test_instruction content
+ [
+ Declaration (_position, apples, Eq', value_5);
+ Declaration (_position, pears, Eq', value_10);
+ ]
+
+let test_equality () =
+ let content = "apples = 5 = pears" in
+ let index = None in
+ let apples = { Ast.pos = _position; name = "APPLES"; index }
+ and pears = { Ast.pos = _position; name = "PEARS"; index }
+ and value_5 = Ast.Integer (_position, "5") in
+ _test_instruction content
+ [
+ Declaration
+ (_position, apples, Eq', BinaryOp (_position, Eq, value_5, Ident pears));
+ ]
+
+let test_plus () =
+ let content = {|
+apples = 5 + pears
+|} in
+ let index = None in
+ let apples = { Ast.pos = _position; name = "APPLES"; index }
+ and pears = { Ast.pos = _position; name = "PEARS"; index }
+ and value_5 = Ast.Integer (_position, "5") in
+ _test_instruction content
+ [
+ Declaration
+ ( _position,
+ apples,
+ Eq',
+ BinaryOp (_position, Plus, value_5, Ident pears) );
+ ]
+
+let test_plus_litt () =
+ let content = {|
+'five'+ pears
+|} in
+ let index = None in
+ let pears = { Ast.pos = _position; name = "PEARS"; index } in
+ _test_instruction content
+ [
+ Ast.(
+ Expression
+ (BinaryOp (_position, Plus, Literal (_position, "five"), Ident pears)));
+ ]
+
+let test_concat () =
+ let content = {|
+$firstName + ' ' + $lastName
+|} in
+ _test_instruction content
+ [
+ Tree.Ast.Expression
+ (Tree.Ast.BinaryOp
+ ( _position,
+ Plus,
+ Tree.Ast.BinaryOp
+ ( _position,
+ Plus,
+ Tree.Ast.Ident
+ {
+ Tree.Ast.pos = _position;
+ name = "$FIRSTNAME";
+ index = None;
+ },
+ Tree.Ast.Literal (_position, " ") ),
+ Tree.Ast.Ident
+ { Tree.Ast.pos = _position; name = "$LASTNAME"; index = None } ));
+ ]
+
+let test_comment () = _test_instruction "! Comment" [ Comment _position ]
+
+let test_comment2 () =
+ let index = None in
+ let a = { Ast.pos = _position; name = "A"; index }
+ and value_0 = Ast.Integer (_position, "0") in
+ _test_instruction "a = 0 &! Comment"
+ Ast.[ Declaration (_position, a, Eq', value_0); Comment _position ]
+
+let test_comment3 () = _test_instruction {|!!1234
+ |} [ Comment _position ]
+
+(** The exclamation mark here is an operation and not a comment *)
+let test_comment4 () =
+ let index = None in
+ let a = { Ast.pos = _position; name = "A"; index }
+ and value_0 = Ast.Integer (_position, "0") in
+ _test_instruction "a = rand(0, 1) ! 0"
+ [
+ Ast.(
+ Declaration
+ ( _position,
+ a,
+ Eq',
+ BinaryOp
+ ( _position,
+ Neq,
+ Function
+ ( _position,
+ Rand,
+ [ Integer (_position, "0"); Integer (_position, "1") ] ),
+ value_0 ) ));
+ ]
+
+let test_comment5 () =
+ _test_instruction "a = rand() &! Comment"
+ [
+ Ast.Declaration
+ ( _position,
+ { Ast.pos = _position; name = "A"; index = None },
+ Qsp_syntax.T.Eq',
+ Ast.Function (_position, Rand, []) );
+ Ast.Comment _position;
+ ]
+
+let test_comment6 () =
+ _test_instruction
+ "gs 'stat' &!! It should be here, because some of the strigs have to be \
+ initialized"
+ [
+ Ast.Call (_position, "GOSUB", [ Ast.Literal (_position, "stat") ]);
+ Ast.Comment _position;
+ ]
+
+let test_long_comment () =
+ _test_instruction
+ {| !'this part of the comment is inside
+single quotes' but "this is still part
+of the same comment because sometimes
+life is unfair." Oh yeah, {curly brackets
+also count}. This is still the same comment. |}
+ [ Comment _position ]
+
+(** This test ensure that the unary operator is applied to the whole expression
+ *)
+let test_precedence () =
+ let index = None in
+ let x = Ast.Ident { Ast.pos = _position; name = "X"; index }
+ and y = Ast.Ident { Ast.pos = _position; name = "Y"; index } in
+ _test_instruction "no x = y"
+ Ast.[ Expression (Op (_position, No, BinaryOp (_position, Eq, x, y))) ]
+
+(** This test ensure that a ! is not considered as a comment in an
+ expression *)
+let test_precedence2 () =
+ let index = None in
+ let x = { Ast.pos = _position; name = "X"; index }
+ and y = Ast.Ident { Ast.pos = _position; name = "Y"; index } in
+ _test_instruction "x = y ! 0"
+ Ast.
+ [
+ Declaration
+ ( _position,
+ x,
+ Eq',
+ BinaryOp (_position, Neq, y, Integer (_position, "0")) );
+ ]
+
+let test_if () =
+ let index = Some Ast.(Integer (_position, "0")) in
+ let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
+ and expr1 = Ast.(Literal (_position, "blockA"))
+ and expr2 = Ast.(Expression (Literal (_position, "You are in block A"))) in
+ _test_instruction {| if $ARGS[0] = 'blockA':
+ 'You are in block A'
+end |}
+ Ast.
+ [
+ If
+ {
+ loc = _position;
+ then_ = (_position, BinaryOp (_position, Eq, args, expr1), [ expr2 ]);
+ elifs = [];
+ else_ = [];
+ };
+ ]
+
+let test_if2 () =
+ let index = Some Ast.(Integer (_position, "0")) in
+ let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
+ and expr1 = Ast.(Literal (_position, "blockA"))
+ and expr2 = Ast.(Expression (Literal (_position, "You are in block A"))) in
+ _test_instruction {| if $ARGS[0] = 'blockA':
+ 'You are in block A'
+end if|}
+ Ast.
+ [
+ If
+ {
+ loc = _position;
+ then_ = (_position, BinaryOp (_position, Eq, args, expr1), [ expr2 ]);
+ elifs = [];
+ else_ = [];
+ };
+ ]
+
+let test_if_chained () =
+ let value_0 = Ast.Integer (_position, "0") in
+ _test_instruction {| if 0:
+ 0
+end &! -- |}
+ Ast.
+ [
+ If
+ {
+ loc = _position;
+ then_ = (_position, value_0, [ Expression value_0 ]);
+ elifs = [];
+ else_ = [];
+ };
+ Comment _position;
+ ]
+
+let test_if_equality () =
+ _test_instruction {|
+if 0 = 0:
+end &! --
+|}
+ [
+ Ast.If
+ {
+ loc = _position;
+ then_ =
+ ( _position,
+ Ast.BinaryOp
+ ( _position,
+ Qsp_syntax.T.Eq,
+ Ast.Integer (_position, "0"),
+ Ast.Integer (_position, "0") ),
+ [] );
+ elifs = [];
+ else_ = [];
+ };
+ Ast.Comment _position;
+ ]
+
+let test_if_inline () =
+ let value_0 = Ast.Integer (_position, "0") in
+ _test_instruction "if 0: 0 else 0"
+ Ast.
+ [
+ If
+ {
+ loc = _position;
+ then_ = (_position, value_0, [ Expression value_0 ]);
+ elifs = [];
+ else_ = [ Expression value_0 ];
+ };
+ ]
+
+let test_if_inline_comment () =
+ let value_0 = Ast.Integer (_position, "0") in
+ _test_instruction "if 0: 0 else 0 &! comment "
+ Ast.
+ [
+ If
+ {
+ loc = _position;
+ then_ = (_position, value_0, [ Expression value_0 ]);
+ elifs = [];
+ else_ = [ Expression value_0 ];
+ };
+ Comment _position;
+ ]
+
+let test_if_inline_comment2 () =
+ _test_instruction "if 0: 1 & !! Comment"
+ [
+ Ast.If
+ {
+ loc = _position;
+ then_ =
+ ( _position,
+ Ast.Integer (_position, "0"),
+ [
+ Ast.Expression (Ast.Integer (_position, "1"));
+ Ast.Comment _position;
+ ] );
+ elifs = [];
+ else_ = [];
+ };
+ ]
+
+let test_if_inline_act () =
+ _test_instruction "if 1 and hour >= 8: minut += 1 & act 'go': gt 'go'"
+ [
+ Ast.If
+ {
+ loc = _position;
+ then_ =
+ ( _position,
+ Ast.BinaryOp
+ ( _position,
+ Qsp_syntax.T.And,
+ Ast.Integer (_position, "1"),
+ Ast.BinaryOp
+ ( _position,
+ Qsp_syntax.T.Gte,
+ Ast.Ident
+ { Ast.pos = _position; name = "HOUR"; index = None },
+ Ast.Integer (_position, "8") ) ),
+ [
+ Ast.Declaration
+ ( _position,
+ { Ast.pos = _position; name = "MINUT"; index = None },
+ Qsp_syntax.T.Inc,
+ Ast.Integer (_position, "1") );
+ Ast.Act
+ {
+ loc = _position;
+ label = Ast.Literal (_position, "go");
+ statements =
+ [
+ Ast.Call
+ (_position, "GOTO", [ Ast.Literal (_position, "go") ]);
+ ];
+ };
+ ] );
+ elifs = [];
+ else_ = [];
+ };
+ ]
+
+let test_if_inline_act2 () =
+ _test_instruction "if 1: act 'go': gt 'go' &! comment "
+ [
+ Ast.If
+ {
+ loc = _position;
+ then_ =
+ ( _position,
+ Ast.Integer (_position, "1"),
+ [
+ Ast.Act
+ {
+ loc = _position;
+ label = Ast.Literal (_position, "go");
+ statements =
+ [
+ Ast.Call
+ (_position, "GOTO", [ Ast.Literal (_position, "go") ]);
+ Ast.Comment _position;
+ ];
+ };
+ ] );
+ elifs = [];
+ else_ = [];
+ };
+ ]
+
+let test_precedence3 () =
+ let index = Some Ast.(Integer (_position, "0")) in
+ let args = Ast.(Ident { pos = _position; name = "$ARGS"; index })
+ and expr1 = Ast.(Literal (_position, "blockA"))
+ and expr2 = Ast.(Expression (Literal (_position, "You are in block A")))
+ and expr3 = Ast.(Expression (Integer (_position, "0"))) in
+ _test_instruction {| if $ARGS[0] = 'blockA': 'You are in block A' & 0|}
+ Ast.
+ [
+ If
+ {
+ loc = _position;
+ then_ =
+ ( _position,
+ BinaryOp (_position, Eq, args, expr1),
+ [ expr2; expr3 ] );
+ elifs = [];
+ else_ = [];
+ };
+ ]
+
+let test_gs () =
+ _test_instruction "gs '123'"
+ [ Ast.(Call (_position, "GOSUB", [ Literal (_position, "123") ])) ]
+
+let test_gt () =
+ _test_instruction "gt $curloc"
+ [
+ Ast.Call
+ ( _position,
+ "GOTO",
+ [ Ast.Ident { Ast.pos = _position; name = "$CURLOC"; index = None } ]
+ );
+ ]
+
+let test_nl () =
+ _test_instruction "*NL 'It'"
+ [ Ast.Call (_position, "*NL", [ Ast.Literal (_position, "It") ]) ]
+
+let test_function () =
+ _test_instruction "iif(123, 1, 0)"
+ [
+ Ast.(
+ Expression
+ (Function
+ ( _position,
+ Iif,
+ [
+ Integer (_position, "123");
+ Integer (_position, "1");
+ Integer (_position, "0");
+ ] )));
+ ]
+
+(** Include a space before the parameters *)
+let test_function2 () =
+ _test_instruction "rand (0, 1)"
+ [
+ Ast.(
+ Expression
+ (Function
+ ( _position,
+ Rand,
+ [ Integer (_position, "0"); Integer (_position, "1") ] )));
+ ]
+
+let test_precedence4 () =
+ _test_instruction "trim()" Ast.[ Expression (Function (_position, Trim, [])) ]
+
+(** This should not be a keyword without arguments, followed by an expression *)
+let test_precedence5 () =
+ _test_instruction "clear()" Ast.[ Call (_position, "CLEAR", []) ]
+
+let test_precedence6 () =
+ _test_instruction "(1 = 0 and 2 ! 3)"
+ [
+ Ast.Expression
+ (Ast.BinaryOp
+ ( _position,
+ And,
+ Ast.BinaryOp
+ ( _position,
+ Eq,
+ Ast.Integer (_position, "1"),
+ Ast.Integer (_position, "0") ),
+ Ast.BinaryOp
+ ( _position,
+ Neq,
+ Ast.Integer (_position, "2"),
+ Ast.Integer (_position, "3") ) ));
+ ]
+
+(** An identifier cannot start by a number *0 is a product and not an
+ identifier *)
+let test_operator () =
+ let index = None in
+ let a = { Ast.pos = _position; name = "A"; index }
+ and value_0 = Ast.Integer (_position, "0") in
+ _test_instruction "a *0"
+ Ast.[ Expression (BinaryOp (_position, Product, Ident a, value_0)) ]
+
+let test_operator2 () =
+ let value_0 = Ast.Integer (_position, "0") in
+ _test_instruction "0 *rand()"
+ Ast.
+ [
+ Expression
+ (BinaryOp (_position, Product, value_0, Function (_position, Rand, [])));
+ ]
+
+let test_dyneval () =
+ _test_instruction "dyneval ''"
+ [
+ Ast.Expression
+ (Ast.Function (_position, Dyneval, [ Ast.Literal (_position, "") ]));
+ ]
+
+(** The parens after input are considered as arguments for the function, not a
+ following expression.
+
+ This expression is a boolean.
+*)
+let test_input () =
+ _test_instruction "( input('') = '' )"
+ [
+ Tree.Ast.Expression
+ (Tree.Ast.BinaryOp
+ ( _position,
+ Eq,
+ Tree.Ast.Function
+ (_position, Input, [ Tree.Ast.Literal (_position, "") ]),
+ Tree.Ast.Literal (_position, "") ));
+ ]
+
+let test_mutiple_inline_ifs () =
+ _test_instruction "if 1 > 0: 1 else if 1 < 0: 0"
+ [
+ Tree.Ast.If
+ {
+ loc = _position;
+ then_ =
+ ( _position,
+ Tree.Ast.BinaryOp
+ ( _position,
+ Gt,
+ Tree.Ast.Integer (_position, "1"),
+ Tree.Ast.Integer (_position, "0") ),
+ [ Tree.Ast.Expression (Tree.Ast.Integer (_position, "1")) ] );
+ elifs = [];
+ else_ =
+ [
+ Tree.Ast.If
+ {
+ loc = _position;
+ then_ =
+ ( _position,
+ Tree.Ast.BinaryOp
+ ( _position,
+ Lt,
+ Tree.Ast.Integer (_position, "1"),
+ Tree.Ast.Integer (_position, "0") ),
+ [
+ Tree.Ast.Expression (Tree.Ast.Integer (_position, "0"));
+ ] );
+ elifs = [];
+ else_ = [];
+ };
+ ];
+ };
+ ]
+
+let test_precedence7 () =
+ _test_instruction "(1 + 1 = '')"
+ [
+ Tree.Ast.Expression
+ (Tree.Ast.BinaryOp
+ ( _position,
+ Eq,
+ Tree.Ast.BinaryOp
+ ( _position,
+ Plus,
+ Tree.Ast.Integer (_position, "1"),
+ Tree.Ast.Integer (_position, "1") ),
+ Tree.Ast.Literal (_position, "") ));
+ ]
+
+let test_precedence8 () =
+ _test_instruction "(0 = 1 or 0 = 1)"
+ [
+ Tree.Ast.Expression
+ (Tree.Ast.BinaryOp
+ ( _position,
+ Or,
+ Tree.Ast.BinaryOp
+ ( _position,
+ Eq,
+ Tree.Ast.Integer (_position, "0"),
+ Tree.Ast.Integer (_position, "1") ),
+ Tree.Ast.BinaryOp
+ ( _position,
+ Eq,
+ Tree.Ast.Integer (_position, "0"),
+ Tree.Ast.Integer (_position, "1") ) ));
+ ]
+
+let test =
+ ( "Syntax",
+ [
+ Alcotest.test_case "Location" `Quick test_empty_location;
+ Alcotest.test_case "Location" `Quick test_location_without_database;
+ Alcotest.test_case " Numeric expression" `Quick test_numeric_expression;
+ Alcotest.test_case "-Numeric expression" `Quick
+ test_negative_numeric_expression;
+ Alcotest.test_case "-Numeric expression2" `Quick
+ test_negative_numeric_expression2;
+ Alcotest.test_case "$Variable expression" `Quick test_str_variable;
+ Alcotest.test_case " Variable expression" `Quick test_variable;
+ Alcotest.test_case "Indexed Variable expression" `Quick
+ test_indexed_variable;
+ Alcotest.test_case "Let instruction" `Quick test_let_literal;
+ Alcotest.test_case "Set array_append" `Quick test_set_array_append;
+ Alcotest.test_case "Variable_assignation" `Quick test_direct_assignation;
+ Alcotest.test_case "Command assignation" `Quick test_command_assignation;
+ Alcotest.test_case "Variable_assignation2" `Quick test_assignation2;
+ Alcotest.test_case "Literal" `Quick test_literal;
+ Alcotest.test_case "Literal2" `Quick test_qutoted_literal;
+ Alcotest.test_case "Literal3" `Quick test_multilie_literal;
+ Alcotest.test_case "Concat Literal" `Quick test_concat_literal;
+ Alcotest.test_case "Nested Literal" `Quick test_nested_literal;
+ Alcotest.test_case "Multiline1" `Quick test_multiline1;
+ Alcotest.test_case "Multiline2" `Quick test_multiline2;
+ Alcotest.test_case "Equality" `Quick test_equality;
+ Alcotest.test_case "Plus" `Quick test_plus;
+ Alcotest.test_case "Plus_litt" `Quick test_plus_litt;
+ Alcotest.test_case "PlusChained" `Quick test_concat;
+ Alcotest.test_case "Comment" `Quick test_comment;
+ Alcotest.test_case "Comment2" `Quick test_comment2;
+ Alcotest.test_case "Comment3" `Quick test_comment3;
+ Alcotest.test_case "Comment4" `Quick test_comment4;
+ Alcotest.test_case "Comment5" `Quick test_comment5;
+ Alcotest.test_case "Comment6" `Quick test_comment6;
+ Alcotest.test_case "Multiline Comment" `Quick test_long_comment;
+ Alcotest.test_case "If" `Quick test_if;
+ Alcotest.test_case "If - end if" `Quick test_if2;
+ Alcotest.test_case "If_chained" `Quick test_if_chained;
+ Alcotest.test_case "If_equality" `Quick test_if_equality;
+ Alcotest.test_case "If inline" `Quick test_if_inline;
+ Alcotest.test_case "If inline &!" `Quick test_if_inline_comment;
+ Alcotest.test_case "If inline & !!" `Quick test_if_inline_comment2;
+ Alcotest.test_case "If : act" `Quick test_if_inline_act;
+ Alcotest.test_case "If : act: &!" `Quick test_if_inline_act2;
+ Alcotest.test_case "Precedence1" `Quick test_precedence;
+ Alcotest.test_case "Precedence2" `Quick test_precedence2;
+ Alcotest.test_case "Precedence3" `Quick test_precedence3;
+ Alcotest.test_case "Call gs" `Quick test_gs;
+ Alcotest.test_case "Call gt" `Quick test_gt;
+ Alcotest.test_case "Call nl" `Quick test_nl;
+ Alcotest.test_case "Function iif" `Quick test_function;
+ Alcotest.test_case "Function rand" `Quick test_function2;
+ Alcotest.test_case "Precedence4" `Quick test_precedence4;
+ Alcotest.test_case "Precedence5" `Quick test_precedence5;
+ Alcotest.test_case "Precedence6" `Quick test_precedence6;
+ Alcotest.test_case "Operator" `Quick test_operator;
+ Alcotest.test_case "Operator2" `Quick test_operator2;
+ Alcotest.test_case "Dyneval" `Quick test_dyneval;
+ Alcotest.test_case "Input" `Quick test_input;
+ Alcotest.test_case "inline if else if" `Quick test_mutiple_inline_ifs;
+ Alcotest.test_case "Precedence7" `Quick test_precedence7;
+ Alcotest.test_case "Precedence8" `Quick test_precedence8;
+ ] )
diff --git a/test/syntax_error.ml b/test/syntax_error.ml
new file mode 100644
index 0000000..b907bc7
--- /dev/null
+++ b/test/syntax_error.ml
@@ -0,0 +1,85 @@
+module Parser = Qparser.Parser.Make (Qsp_syntax.Tree)
+module Ast = Qsp_syntax.Tree.Ast
+
+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 : Ast.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 :
+ (Ast.pos Syntax.location, Qsp_syntax.Report.t) result -> Ast.pos report =
+ function
+ | Ok _ -> failwith "No error"
+ | Error { level; loc; message } -> { level; loc; message }
+
+let _test_instruction : string -> Ast.pos report -> unit =
+ fun literal expected ->
+ let _location = Printf.sprintf {|# Location
+%s
+------- |} literal in
+ let actual = get_report @@ Syntax.parse _location and msg = literal in
+
+ Alcotest.(check' report ~msg ~expected ~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 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;
+ ] )