fix constructor not handling nullliterals correctly
This commit is contained in:
parent
bcbec9209a
commit
faf3d1674e
@ -141,9 +141,9 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
|
|||||||
typeCheckStatementExpression (ConstructorCall className args) symtab classes =
|
typeCheckStatementExpression (ConstructorCall className args) symtab classes =
|
||||||
case find (\(Class name _ _) -> name == className) classes of
|
case find (\(Class name _ _) -> name == className) classes of
|
||||||
Nothing -> error $ "Class '" ++ className ++ "' not found."
|
Nothing -> error $ "Class '" ++ className ++ "' not found."
|
||||||
Just (Class _ methods fields) ->
|
Just (Class _ methods _) ->
|
||||||
-- Find constructor matching the class name with void return type
|
-- Find constructor matching the class name with void return type
|
||||||
case find (\(MethodDeclaration retType name params _) -> name == "<init>" && retType == "void") methods of
|
case find (\(MethodDeclaration _ name params _) -> name == "<init>") methods of
|
||||||
-- If no constructor is found, assume standard constructor with no parameters
|
-- If no constructor is found, assume standard constructor with no parameters
|
||||||
Nothing ->
|
Nothing ->
|
||||||
if null args then
|
if null args then
|
||||||
@ -151,21 +151,28 @@ typeCheckStatementExpression (ConstructorCall className args) symtab classes =
|
|||||||
else
|
else
|
||||||
error $ "No valid constructor found for class '" ++ className ++ "', but arguments were provided."
|
error $ "No valid constructor found for class '" ++ className ++ "', but arguments were provided."
|
||||||
Just (MethodDeclaration _ _ params _) ->
|
Just (MethodDeclaration _ _ params _) ->
|
||||||
let
|
let args' = zipWith
|
||||||
args' = map (\arg -> typeCheckExpression arg symtab classes) args
|
(\arg (ParameterDeclaration paramType _) ->
|
||||||
-- Extract expected parameter types from the constructor's parameters
|
let argTyped = typeCheckExpression arg symtab classes
|
||||||
|
in if getTypeFromExpr argTyped == "null" && isObjectType paramType
|
||||||
|
then TypedExpression paramType NullLiteral
|
||||||
|
else argTyped
|
||||||
|
) args params
|
||||||
expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
|
expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
|
||||||
argTypes = map getTypeFromExpr args'
|
argTypes = map getTypeFromExpr args'
|
||||||
-- Check if the types of the provided arguments match the expected types
|
typeMatches = zipWith
|
||||||
typeMatches = zipWith (\expected actual -> if expected == actual then Nothing else Just (expected, actual)) expectedTypes argTypes
|
(\expType argType -> (expType == argType || (argType == "null" && isObjectType expType), expType, argType))
|
||||||
mismatchErrors = map (\(exp, act) -> "Expected type '" ++ exp ++ "', found '" ++ act ++ "'.") (catMaybes typeMatches)
|
expectedTypes argTypes
|
||||||
|
mismatches = filter (not . fst3) typeMatches
|
||||||
|
fst3 (a, _, _) = a
|
||||||
in
|
in
|
||||||
if length args /= length params then
|
if null mismatches && length args == length params then
|
||||||
error $ "Constructor for class '" ++ className ++ "' expects " ++ show (length params) ++ " arguments, but got " ++ show (length args) ++ "."
|
|
||||||
else if not (null mismatchErrors) then
|
|
||||||
error $ unlines $ ("Type mismatch in constructor arguments for class '" ++ className ++ "':") : mismatchErrors
|
|
||||||
else
|
|
||||||
TypedStatementExpression className (ConstructorCall className args')
|
TypedStatementExpression className (ConstructorCall className args')
|
||||||
|
else if not (null mismatches) then
|
||||||
|
error $ unlines $ ("Type mismatch in constructor arguments for class '" ++ className ++ "':")
|
||||||
|
: [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ]
|
||||||
|
else
|
||||||
|
error $ "Incorrect number of arguments for constructor of class '" ++ className ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "."
|
||||||
|
|
||||||
typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
|
typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
|
||||||
let objExprTyped = typeCheckExpression expr symtab classes
|
let objExprTyped = typeCheckExpression expr symtab classes
|
||||||
|
Loading…
Reference in New Issue
Block a user