added tests

This commit is contained in:

View File

@ -1,10 +1,11 @@
module Example where
import Ast
import Typecheck
import Control.Exception (catch, evaluate, SomeException, displayException)
import Control.Exception.Base
import System.IO (stderr, hPutStrLn)
-- ANSI color codes
green, red, yellow, blue, magenta, cyan, white :: String -> String
green str = "\x1b[32m" ++ str ++ "\x1b[0m"
red str = "\x1b[31m" ++ str ++ "\x1b[0m"
@ -14,7 +15,6 @@ magenta str = "\x1b[35m" ++ str ++ "\x1b[0m"
cyan str = "\x1b[36m" ++ str ++ "\x1b[0m"
white str = "\x1b[37m" ++ str ++ "\x1b[0m"
-- Custom print function
printSuccess :: String -> IO ()
printSuccess msg = putStrLn $ green "Success:" ++ white msg
@ -26,33 +26,23 @@ printResult title result = do
putStrLn $ green title
print result
-- Example classes and their methods and fields
sampleClasses :: [Class]
sampleClasses = [
Class "Person" [
MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
(Block [
LocalVariableDeclaration (VariableDeclaration "Int" "age" (Just (Reference "newAge")))
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
]),
MethodDeclaration "Int" "getAge" [] (Return (Just (Reference "age"))),
MethodDeclaration "int" "getAge" [] (Return (Just (Reference "age"))),
MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] (Block [])
] [
VariableDeclaration "Int" "age" (Just (IntegerLiteral 25)),
VariableDeclaration "String" "name" (Just (CharacterLiteral 'A'))
VariableDeclaration "int" "age" (Just (IntegerLiteral 25))
]
]
-- Symbol table, mapping identifiers to their data types
initialSymtab :: [(DataType, Identifier)]
initialSymtab = []
exampleBlock :: Statement
exampleBlock = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [])))),
BinaryOperation NameResolution (Reference "bob") (StatementExpressionExpression (MethodCall "setAge" [IntegerLiteral 30])),
Return (Just (StatementExpressionExpression (MethodCall "getAge" [])))
]
exampleExpression :: Expression
exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age")
@ -60,20 +50,30 @@ exampleAssignment :: Expression
exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30))
exampleMethodCall :: Statement
exampleMethodCall = StatementExpressionStatement (MethodCall "setAge" [IntegerLiteral 30])
exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30])
exampleConstructorCall :: Statement
exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30]))))
-- Function to perform type checking and handle errors
exampleNameResolution :: Expression
exampleNameResolution = BinaryOperation NameResolution (Reference "b") (Reference "age")
exampleBlockResolution :: Statement
exampleBlockResolution = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))),
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30])
]
exampleBlockResolutionFail :: Statement
exampleBlockResolutionFail = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))),
LocalVariableDeclaration (VariableDeclaration "bool" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30])
]
runTypeCheck :: IO ()
runTypeCheck = do
-- Evaluate the block of statements
--evaluatedBlock <- evaluate (typeCheckStatement exampleBlock initialSymtab sampleClasses)
--putStrLn "Type checking of block completed successfully:"
--print evaluatedBlock
-- Evaluate the expression
catch (do
print "====================================================================================="
evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person")] sampleClasses)
@ -102,3 +102,24 @@ runTypeCheck = do
printResult "Result Constructor Call:" evaluatedConstructorCall
) handleError
catch (do
print "====================================================================================="
evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("b", "Person")] sampleClasses)
printSuccess "Type checking of name resolution completed successfully"
printResult "Result Name Resolution:" evaluatedNameResolution
) handleError
catch (do
print "====================================================================================="
evaluatedBlockResolution <- evaluate (typeCheckStatement exampleBlockResolution [] sampleClasses)
printSuccess "Type checking of block resolution completed successfully"
printResult "Result Block Resolution:" evaluatedBlockResolution
) handleError
catch (do
print "====================================================================================="
evaluatedBlockResolutionFail <- evaluate (typeCheckStatement exampleBlockResolutionFail [] sampleClasses)
printSuccess "Type checking of block resolution failed"
printResult "Result Block Resolution:" evaluatedBlockResolutionFail
) handleError