diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 23346f3..775de17 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -3,12 +3,19 @@ module TestParser(tests) where import Test.HUnit import Parser.Lexer import Parser.JavaParser +import Ast -testIntLiteral = TestCase $ assertEqual "IntLiteral 34" [IntLiteral 34] $ parse (INTLITERAL 34) +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] + -testAnd = TestCase $ assertEqual "scan '&&'" [AND] $ alexScanTokens "&&" tests = TestList [ - testIntLiteral + testSingleEmptyClass, + testTwoEmptyClasses ] \ No newline at end of file diff --git a/Test/TestSuite.hs b/Test/TestSuite.hs index 1fd2cbb..ff395c5 100644 --- a/Test/TestSuite.hs +++ b/Test/TestSuite.hs @@ -2,12 +2,12 @@ module Main where import Test.HUnit import TestLexer --- import TestParser +import TestParser tests = TestList [ - TestLabel "TestLexer" TestLexer.tests - -- TestLabel "TestParser" TestParser.tests + TestLabel "TestLexer" TestLexer.tests, + TestLabel "TestParser" TestParser.tests ] main = do runTestTTAndExit Main.tests \ No newline at end of file diff --git a/src/Ast.hs b/src/Ast.hs index 2c131c6..10d3d28 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -5,9 +5,13 @@ type DataType = String type Identifier = String data ParameterDeclaration = ParameterDeclaration DataType Identifier + deriving(Show, Eq) data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) + deriving(Show, Eq) data Class = Class DataType [MethodDeclaration] [VariableDeclaration] + deriving(Show, Eq) data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement + deriving(Show, Eq) data Statement = If Expression Statement (Maybe Statement) | LocalVariableDeclaration VariableDeclaration @@ -16,11 +20,13 @@ data Statement = If Expression Statement (Maybe Statement) | Return (Maybe Expression) | StatementExpressionStatement StatementExpression | TypedStatement DataType Statement + deriving(Show, Eq) data StatementExpression = Assignment Identifier Expression | ConstructorCall DataType [Expression] | MethodCall Identifier [Expression] | TypedStatementExpression DataType StatementExpression + deriving(Show, Eq) data BinaryOperator = Addition | Subtraction @@ -38,9 +44,11 @@ data BinaryOperator = Addition | And | Or | NameResolution + deriving(Show, Eq) data UnaryOperator = Not | Minus + deriving(Show, Eq) data Expression = IntegerLiteral Int | CharacterLiteral Char @@ -51,4 +59,5 @@ data Expression = IntegerLiteral Int | UnaryOperation UnaryOperator Expression | StatementExpressionExpression StatementExpression | TypedExpression DataType Expression + deriving(Show, Eq) \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index fc4ce89..f673532 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -14,7 +14,7 @@ import Parser.Lexer CASE { CASE } CHAR { CHAR } CLASS { CLASS} - IDENTIFIER { IDENTIFIER $$} + IDENTIFIER { IDENTIFIER $$ } INTLITERAL { INTEGERLITERAL $$} DOT { DOT } MOD { MODULO } @@ -75,25 +75,25 @@ import Parser.Lexer LESS { LESS } %% -compilationunit : typedeclarations { } +compilationunit : typedeclarations { $1 } -typedeclarations : typedeclaration { } - | typedeclarations typedeclaration { } +typedeclarations : typedeclaration { [$1] } + | typedeclarations typedeclaration { $1 ++ [$2] } name : qualifiedname { } | simplename { } -typedeclaration : classdeclaration { } +typedeclaration : classdeclaration { $1 } qualifiedname : name DOT IDENTIFIER { } simplename : IDENTIFIER { } -classdeclaration : CLASS IDENTIFIER classbody { } - | modifiers CLASS IDENTIFIER classbody { } +classdeclaration : CLASS IDENTIFIER classbody { case $3 of (methods, attributes) -> Class $2 methods attributes } + | modifiers CLASS IDENTIFIER classbody { case $4 of (methods, attributes) -> Class $3 methods attributes } classbody : LBRACKET RBRACKET { ([], []) } - | LBRACKET classbodydeclarations RBRACKET { } + | LBRACKET classbodydeclarations RBRACKET { ([], []) } modifiers : modifier { } | modifiers modifier { }