143 lines
6.0 KiB
Haskell
143 lines
6.0 KiB
Haskell
module Language.Elna.ParserSpec
|
|
( spec
|
|
) where
|
|
|
|
import Test.Hspec (Spec, describe, it)
|
|
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn, parseSatisfies)
|
|
import Language.Elna.Parser (programP)
|
|
import Text.Megaparsec (parse)
|
|
import Language.Elna.AST
|
|
( Declaration(..)
|
|
, Expression(..)
|
|
, Literal(..)
|
|
, Statement(..)
|
|
, Parameter(..)
|
|
, Program(..)
|
|
, VariableDeclaration(..)
|
|
, TypeExpression(..)
|
|
)
|
|
|
|
spec :: Spec
|
|
spec =
|
|
describe "programP" $ do
|
|
it "parses an empty main function" $
|
|
parse programP "" `shouldSucceedOn` "proc main() {}"
|
|
|
|
it "parses type definition for a type starting like array" $
|
|
let expected = Program [TypeDefinition "t" $ NamedType "arr"]
|
|
actual = parse programP "" "type t = arr"
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses array type definition" $
|
|
let expected = Program [TypeDefinition "t" $ ArrayType 10 (NamedType "int")]
|
|
actual = parse programP "" "type t = array[10] of int"
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses parameters" $
|
|
let given = "proc main(x: int) {}"
|
|
parameters = [Parameter "x" (NamedType "int") False]
|
|
expected = Program [ProcedureDefinition "main" parameters [] []]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses ref parameters" $
|
|
let given = "proc main(x: int, ref y: boolean) {}"
|
|
parameters =
|
|
[ Parameter "x" (NamedType "int") False
|
|
, Parameter "y" (NamedType "boolean") True
|
|
]
|
|
expected = Program [ProcedureDefinition "main" parameters [] []]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses variable declaration" $
|
|
let given = "proc main() { var x: int; }"
|
|
expected (Program [ProcedureDefinition _ _ variables _]) =
|
|
not $ null variables
|
|
expected _ = False
|
|
actual = parse programP "" given
|
|
in actual `parseSatisfies` expected
|
|
|
|
it "parses negation" $
|
|
let given = "proc main(x: int) { var y: int; y := -x; }"
|
|
parameters = pure $ Parameter "x" (NamedType "int") False
|
|
variables = pure
|
|
$ VariableDeclaration "y"
|
|
$ NamedType "int"
|
|
body = pure
|
|
$ AssignmentStatement (VariableExpression "y")
|
|
$ NegationExpression
|
|
$ VariableExpression "x"
|
|
expected = Program
|
|
[ProcedureDefinition "main" parameters variables body]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses comparison with lower precedence than other binary operators" $
|
|
let given = "proc main() { var x: boolean; x := 1 + 2 = 3 * 4; }"
|
|
variables = pure
|
|
$ VariableDeclaration "x"
|
|
$ NamedType "boolean"
|
|
lhs = SumExpression (LiteralExpression (IntegerLiteral 1))
|
|
$ LiteralExpression (IntegerLiteral 2)
|
|
rhs = ProductExpression (LiteralExpression (IntegerLiteral 3))
|
|
$ LiteralExpression (IntegerLiteral 4)
|
|
body = pure
|
|
$ AssignmentStatement (VariableExpression "x")
|
|
$ EqualExpression lhs rhs
|
|
expected = Program
|
|
[ProcedureDefinition "main" [] variables body]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses hexadecimals" $
|
|
let given = "proc main() { var x: int; x := 0x10; }"
|
|
variables = pure
|
|
$ VariableDeclaration "x"
|
|
$ NamedType "int"
|
|
body = pure
|
|
$ AssignmentStatement (VariableExpression "x")
|
|
$ LiteralExpression (HexadecimalLiteral 16)
|
|
expected = Program
|
|
[ProcedureDefinition "main" [] variables body]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses procedure calls" $
|
|
let given = "proc main() { f('c'); }"
|
|
body = pure
|
|
$ CallStatement "f" [LiteralExpression (CharacterLiteral 99)]
|
|
expected = Program
|
|
[ProcedureDefinition "main" [] [] body]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses an if statement" $
|
|
let given = "proc main() { if (true) ; }"
|
|
body = pure
|
|
$ IfStatement (LiteralExpression $ BooleanLiteral True) EmptyStatement Nothing
|
|
expected = Program
|
|
[ProcedureDefinition "main" [] [] body]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|
|
|
|
it "associates else with the nearst if statement" $
|
|
let given = "proc main() { if (true) if (false) ; else ; }"
|
|
if' = IfStatement (LiteralExpression $ BooleanLiteral False) EmptyStatement
|
|
$ Just EmptyStatement
|
|
body = pure
|
|
$ IfStatement (LiteralExpression $ BooleanLiteral True) if' Nothing
|
|
expected = Program
|
|
[ProcedureDefinition "main" [] [] body]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|
|
|
|
it "parses a while statement" $
|
|
let given = "proc main() { while (true) ; }"
|
|
body = pure
|
|
$ WhileStatement (LiteralExpression $ BooleanLiteral True) EmptyStatement
|
|
expected = Program
|
|
[ProcedureDefinition "main" [] [] body]
|
|
actual = parse programP "" given
|
|
in actual `shouldParse` expected
|