module Tree = Qsp_syntax.Tree
module Ast = Tree.Ast
module Check = Qsp_syntax.Check
module S = Qsp_syntax.S
let location_id, e1 = Check.build (module Tree)
module Parser = Check.Make (struct
let t = [| e1 |]
end)
let _position = (Lexing.dummy_pos, Lexing.dummy_pos)
type 'a location = 'a * 'a Ast.statement list [@@deriving eq, show]
let get_location :
(S.pos location, Qsp_syntax.Report.t) result -> S.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 -> (S.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 Parser) lexing
|> Result.map (fun (location, _report) ->
(* Uncatched excteptions here, but we are in the tests…
If it’s fail here I have an error in the code. *)
Array.get location 0 |> Check.get location_id |> Option.get)
let location : S.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 -> S.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 = { Ast.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, Qsp_syntax.T.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,
Qsp_syntax.T.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,
Qsp_syntax.T.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, Qsp_syntax.T.Gosub, [ Literal (_position, "123") ]));
]
let test_gt () =
_test_instruction "gt $curloc"
[
Ast.Call
( _position,
Qsp_syntax.T.Goto,
[ Ast.Ident { Ast.pos = _position; name = "$CURLOC"; index = None } ]
);
]
let test_nl () =
_test_instruction "*NL 'It'"
[
Ast.Call (_position, Qsp_syntax.T.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, Qsp_syntax.T.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 nested_string () =
_test_instruction
{|'Delete'|}
[
Tree.Ast.Expression
(Tree.Ast.Literal
( _position,
{|Delete|}
));
]
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;
Alcotest.test_case "Nested string" `Quick nested_string;
] )