173 lines
11 KiB
Haskell
173 lines
11 KiB
Haskell
module TestParser(tests) where
|
|
|
|
import Test.HUnit
|
|
import Parser.Lexer
|
|
import Parser.JavaParser
|
|
import Ast
|
|
|
|
|
|
testSingleEmptyClass = TestCase $
|
|
assertEqual "expect single empty class hello" [Class "Hello" [] []] $
|
|
parse [CLASS, IDENTIFIER "Hello", LBRACKET, RBRACKET]
|
|
testTwoEmptyClasses = TestCase $
|
|
assertEqual "expect two empty classes" [Class "Class1" [] [], Class "Class2" [] []] $
|
|
parse [CLASS,IDENTIFIER "Class1",LBRACKET,RBRACKET,CLASS,IDENTIFIER "Class2",LBRACKET,RBRACKET]
|
|
testBooleanField = TestCase $
|
|
assertEqual "expect class with boolean field" [Class "WithBool" [] [VariableDeclaration "boolean" "value" Nothing]] $
|
|
parse [CLASS,IDENTIFIER "WithBool",LBRACKET,BOOLEAN,IDENTIFIER "value",SEMICOLON,RBRACKET]
|
|
testIntField = TestCase $
|
|
assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $
|
|
parse [CLASS,IDENTIFIER "WithInt",LBRACKET,INT,IDENTIFIER "value",SEMICOLON,RBRACKET]
|
|
testCustomTypeField = TestCase $
|
|
assertEqual "expect class with foo field" [Class "WithFoo" [] [VariableDeclaration "Foo" "value" Nothing]] $
|
|
parse [CLASS,IDENTIFIER "WithFoo",LBRACKET,IDENTIFIER "Foo",IDENTIFIER "value",SEMICOLON,RBRACKET]
|
|
testMultipleDeclarationSameLine = TestCase $
|
|
assertEqual "expect class with two int fields" [Class "TwoInts" [] [VariableDeclaration "int" "num1" Nothing, VariableDeclaration "int" "num2" Nothing]] $
|
|
parse [CLASS,IDENTIFIER "TwoInts",LBRACKET,INT,IDENTIFIER "num1",COMMA,IDENTIFIER "num2",SEMICOLON,RBRACKET]
|
|
testMultipleDeclarations = TestCase $
|
|
assertEqual "expect class with int and char field" [Class "Multiple" [] [VariableDeclaration "int" "value" Nothing, VariableDeclaration "char" "letter" Nothing]] $
|
|
parse [CLASS,IDENTIFIER "Multiple",LBRACKET,INT,IDENTIFIER "value",SEMICOLON,CHAR,IDENTIFIER "letter",SEMICOLON,RBRACKET]
|
|
testWithModifier = TestCase $
|
|
assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $
|
|
parse [ABSTRACT,CLASS,IDENTIFIER "WithInt",LBRACKET,PUBLIC,INT,IDENTIFIER "value",SEMICOLON,RBRACKET]
|
|
|
|
testEmptyMethod = TestCase $
|
|
assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "int" "foo" [] (Block [])] []] $
|
|
parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,INT,IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON,RBRACKET]
|
|
testEmptyPrivateMethod = TestCase $
|
|
assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "int" "foo" [] (Block [])] []] $
|
|
parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,PRIVATE,INT,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET]
|
|
testEmptyVoidMethod = TestCase $
|
|
assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "void" "foo" [] (Block [])] []] $
|
|
parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET]
|
|
testEmptyMethodWithParam = TestCase $
|
|
assertEqual "expect class with method with param" [Class "WithParam" [MethodDeclaration "void" "foo" [ParameterDeclaration "int" "param"] (Block [])] []] $
|
|
parse [CLASS,IDENTIFIER "WithParam",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,INT,IDENTIFIER "param",RBRACE,SEMICOLON,RBRACKET]
|
|
testEmptyMethodWithParams = TestCase $
|
|
assertEqual "expect class with multiple params" [Class "WithParams" [MethodDeclaration "void" "foo" [ParameterDeclaration "int" "p1",ParameterDeclaration "Custom" "p2"] (Block [])] []] $
|
|
parse [CLASS,IDENTIFIER "WithParams",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,INT,IDENTIFIER "p1",COMMA,IDENTIFIER "Custom",IDENTIFIER "p2",RBRACE,SEMICOLON,RBRACKET]
|
|
testClassWithMethodAndField = TestCase $
|
|
assertEqual "expect class with method and field" [Class "WithMethodAndField" [MethodDeclaration "void" "foo" [] (Block []), MethodDeclaration "int" "bar" [] (Block [])] [VariableDeclaration "int" "value" Nothing]] $
|
|
parse [CLASS,IDENTIFIER "WithMethodAndField",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,INT,IDENTIFIER "value",SEMICOLON,INT,IDENTIFIER "bar",LBRACE,RBRACE,SEMICOLON,RBRACKET]
|
|
testClassWithConstructor = TestCase $
|
|
assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "WithConstructor" "<init>" [] (Block [])] []] $
|
|
parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET]
|
|
|
|
|
|
testEmptyBlock = TestCase $ assertEqual "expect empty block" (Block []) $ parseBlock [LBRACKET,RBRACKET]
|
|
testBlockWithLocalVarDecl = TestCase $
|
|
assertEqual "expect block with local var delcaration" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]) $
|
|
parseBlock [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET]
|
|
testBlockWithMultipleLocalVarDecls = TestCase $
|
|
assertEqual "expect block with multiple local var declarations" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]) $
|
|
parseBlock [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET]
|
|
testNestedBlocks = TestCase $
|
|
assertEqual "expect block with block inside" (Block [Block []]) $
|
|
parseBlock [LBRACKET,LBRACKET,RBRACKET,RBRACKET]
|
|
testBlockWithEmptyStatement = TestCase $
|
|
assertEqual "expect empty block" (Block []) $
|
|
parseBlock [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET]
|
|
|
|
testExpressionIntLiteral = TestCase $
|
|
assertEqual "expect IntLiteral" (IntegerLiteral 3) $
|
|
parseExpression [INTEGERLITERAL 3]
|
|
testFieldWithInitialization = TestCase $
|
|
assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "int" "number" $ Just $ IntegerLiteral 3]] $
|
|
parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,INT,IDENTIFIER "number",ASSIGN,INTEGERLITERAL 3,SEMICOLON,RBRACKET]
|
|
testLocalBoolWithInitialization = TestCase $
|
|
assertEqual "expect block with with initialized local var" (Block [LocalVariableDeclaration $ VariableDeclaration "boolean" "b" $ Just $ BooleanLiteral False]) $
|
|
parseBlock [LBRACKET,BOOLEAN,IDENTIFIER "b",ASSIGN,BOOLLITERAL False,SEMICOLON,RBRACKET]
|
|
testFieldNullWithInitialization = TestCase $
|
|
assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "Object" "bar" $ Just NullLiteral]] $
|
|
parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,IDENTIFIER "Object",IDENTIFIER "bar",ASSIGN,NULLLITERAL,SEMICOLON,RBRACKET]
|
|
testReturnVoid = TestCase $
|
|
assertEqual "expect block with return nothing" (Block [Return Nothing]) $
|
|
parseBlock [LBRACKET,RETURN,SEMICOLON,RBRACKET]
|
|
|
|
testExpressionNot = TestCase $
|
|
assertEqual "expect expression not" (UnaryOperation Not (Reference "boar")) $
|
|
parseExpression [NOT,IDENTIFIER "boar"]
|
|
testExpressionMinus = TestCase $
|
|
assertEqual "expect expression minus" (UnaryOperation Minus (Reference "boo")) $
|
|
parseExpression [MINUS,IDENTIFIER "boo"]
|
|
testExpressionMultiplication = TestCase $
|
|
assertEqual "expect multiplication" (BinaryOperation Multiplication (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",TIMES,INTEGERLITERAL 3]
|
|
testExpressionDivision = TestCase $
|
|
assertEqual "expect division" (BinaryOperation Division (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",DIV,INTEGERLITERAL 3]
|
|
testExpressionModulo = TestCase $
|
|
assertEqual "expect modulo operation" (BinaryOperation Modulo (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",MODULO,INTEGERLITERAL 3]
|
|
testExpressionAddition = TestCase $
|
|
assertEqual "expect addition" (BinaryOperation Addition (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",PLUS,INTEGERLITERAL 3]
|
|
testExpressionSubtraction = TestCase $
|
|
assertEqual "expect subtraction" (BinaryOperation Subtraction (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",MINUS,INTEGERLITERAL 3]
|
|
testExpressionLessThan = TestCase $
|
|
assertEqual "expect comparision less than" (BinaryOperation CompareLessThan (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",LESS,INTEGERLITERAL 3]
|
|
testExpressionGreaterThan = TestCase $
|
|
assertEqual "expect comparision greater than" (BinaryOperation CompareGreaterThan (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",GREATER,INTEGERLITERAL 3]
|
|
testExpressionLessThanEqual = TestCase $
|
|
assertEqual "expect comparision less than or equal" (BinaryOperation CompareLessOrEqual (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",LESSEQUAL,INTEGERLITERAL 3]
|
|
testExpressionGreaterThanOrEqual = TestCase $
|
|
assertEqual "expect comparision greater than or equal" (BinaryOperation CompareGreaterOrEqual (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",GREATEREQUAL,INTEGERLITERAL 3]
|
|
testExpressionEqual = TestCase $
|
|
assertEqual "expect comparison equal" (BinaryOperation CompareEqual (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",EQUAL,INTEGERLITERAL 3]
|
|
testExpressionNotEqual = TestCase $
|
|
assertEqual "expect comparison equal" (BinaryOperation CompareNotEqual (Reference "bar") (IntegerLiteral 3)) $
|
|
parseExpression [IDENTIFIER "bar",NOTEQUAL,INTEGERLITERAL 3]
|
|
testExpressionAnd = TestCase $
|
|
assertEqual "expect and expression" (BinaryOperation And (Reference "bar") (Reference "baz")) $
|
|
parseExpression [IDENTIFIER "bar",AND,IDENTIFIER "baz"]
|
|
testExpressionXor = TestCase $
|
|
assertEqual "expect xor expression" (BinaryOperation BitwiseXor (Reference "bar") (Reference "baz")) $
|
|
parseExpression [IDENTIFIER "bar",XOR,IDENTIFIER "baz"]
|
|
testExpressionOr = TestCase $
|
|
assertEqual "expect or expression" (BinaryOperation Or (Reference "bar") (Reference "baz")) $
|
|
parseExpression [IDENTIFIER "bar",OR,IDENTIFIER "baz"]
|
|
|
|
|
|
tests = TestList [
|
|
testSingleEmptyClass,
|
|
testTwoEmptyClasses,
|
|
testBooleanField,
|
|
testIntField,
|
|
testCustomTypeField,
|
|
testMultipleDeclarations,
|
|
testWithModifier,
|
|
testEmptyMethod,
|
|
testEmptyPrivateMethod,
|
|
testEmptyVoidMethod,
|
|
testEmptyMethodWithParam,
|
|
testEmptyMethodWithParams,
|
|
testClassWithMethodAndField,
|
|
testClassWithConstructor,
|
|
testEmptyBlock,
|
|
testBlockWithLocalVarDecl,
|
|
testBlockWithMultipleLocalVarDecls,
|
|
testNestedBlocks,
|
|
testBlockWithEmptyStatement,
|
|
testExpressionIntLiteral,
|
|
testFieldWithInitialization,
|
|
testLocalBoolWithInitialization,
|
|
testFieldNullWithInitialization,
|
|
testReturnVoid,
|
|
testExpressionNot,
|
|
testExpressionMinus,
|
|
testExpressionLessThan,
|
|
testExpressionGreaterThan,
|
|
testExpressionLessThanEqual,
|
|
testExpressionGreaterThanOrEqual,
|
|
testExpressionEqual,
|
|
testExpressionNotEqual,
|
|
testExpressionAnd,
|
|
testExpressionXor,
|
|
testExpressionOr
|
|
] |