paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 10:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: allow different arg names in override methods

Browse Source 
git-svn-id: trunk@37403 -
This commit is contained in:
Mattias Gaertner 2017-10-05 21:35:09 +00:00
parent 0c8f670ee0
commit a7265432eb
2 changed files with 36 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
packages/fcl-passrc/src/pasresolver.pp
View File

@ -1054,7 +1054,7 @@ type
function EmitElementHints(PosEl, El: TPasElement): boolean; virtual; function EmitElementHints(PosEl, El: TPasElement): boolean; virtual;
procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope); procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual; procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure); procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure; CheckNames: boolean);
procedure CheckPendingForwards(El: TPasElement); procedure CheckPendingForwards(El: TPasElement);
procedure ComputeBinaryExpr(Bin: TBinaryExpr; procedure ComputeBinaryExpr(Bin: TBinaryExpr;
out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags; out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
@ -3699,7 +3699,7 @@ begin
if ProcNeedsImplProc(Proc) or (not ProcNeedsImplProc(DeclProc)) then if ProcNeedsImplProc(Proc) or (not ProcNeedsImplProc(DeclProc)) then
RaiseMsg(20170216151652,nDuplicateIdentifier,sDuplicateIdentifier, RaiseMsg(20170216151652,nDuplicateIdentifier,sDuplicateIdentifier,
[ProcName,GetElementSourcePosStr(DeclProc)],Proc.ProcType); [ProcName,GetElementSourcePosStr(DeclProc)],Proc.ProcType);
CheckProcSignatureMatch(DeclProc,Proc); CheckProcSignatureMatch(DeclProc,Proc,true);
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope; DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
DeclProcScope.ImplProc:=Proc; DeclProcScope.ImplProc:=Proc;
ProcScope:=Proc.CustomData as TPasProcedureScope; ProcScope:=Proc.CustomData as TPasProcedureScope;
@ -3779,7 +3779,7 @@ begin
RaiseMsg(20170216151708,nNoMethodInAncestorToOverride, RaiseMsg(20170216151708,nNoMethodInAncestorToOverride,
sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType); sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
// override a virtual method // override a virtual method
CheckProcSignatureMatch(OverloadProc,Proc); CheckProcSignatureMatch(OverloadProc,Proc,false);
// check visibility // check visibility
if Proc.Visibility<>OverloadProc.Visibility then if Proc.Visibility<>OverloadProc.Visibility then
case Proc.Visibility of case Proc.Visibility of
@ -3863,7 +3863,7 @@ begin
RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc); RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
if DeclProc.IsExternal then if DeclProc.IsExternal then
RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc); RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
CheckProcSignatureMatch(DeclProc,ImplProc); CheckProcSignatureMatch(DeclProc,ImplProc,true);
ImplProcScope.DeclarationProc:=DeclProc; ImplProcScope.DeclarationProc:=DeclProc;
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope; DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
DeclProcScope.ImplProc:=ImplProc; DeclProcScope.ImplProc:=ImplProc;
@ -4714,8 +4714,8 @@ begin
[BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType]],El); [BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType]],El);
end; end;
procedure TPasResolver.CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure procedure TPasResolver.CheckProcSignatureMatch(DeclProc,
); ImplProc: TPasProcedure; CheckNames: boolean);
var var
i: Integer; i: Integer;
DeclArgs, ImplArgs: TFPList; DeclArgs, ImplArgs: TFPList;
@ -4737,16 +4737,19 @@ begin
[],DeclResult,ImplResult,ImplProc); [],DeclResult,ImplResult,ImplProc);
end; end;
// check argument names if CheckNames then
DeclArgs:=DeclProc.ProcType.Args;
ImplArgs:=ImplProc.ProcType.Args;
for i:=0 to DeclArgs.Count-1 do
begin begin
DeclName:=TPasArgument(DeclArgs[i]).Name; // check argument names
ImplName:=TPasArgument(ImplArgs[i]).Name; DeclArgs:=DeclProc.ProcType.Args;
if CompareText(DeclName,ImplName)<>0 then ImplArgs:=ImplProc.ProcType.Args;
RaiseMsg(20170216151738,nFunctionHeaderMismatchForwardVarName, for i:=0 to DeclArgs.Count-1 do
sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc); begin
DeclName:=TPasArgument(DeclArgs[i]).Name;
ImplName:=TPasArgument(ImplArgs[i]).Name;
if CompareText(DeclName,ImplName)<>0 then
RaiseMsg(20170216151738,nFunctionHeaderMismatchForwardVarName,
sFunctionHeaderMismatchForwardVarName,[DeclProc.Name,DeclName,ImplName],ImplProc);
end;
end; end;
end; end;

18
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -398,6 +398,7 @@ type
Procedure TestClass_MethodOverrideFixCase; Procedure TestClass_MethodOverrideFixCase;
Procedure TestClass_MethodOverrideSameResultType; Procedure TestClass_MethodOverrideSameResultType;
Procedure TestClass_MethodOverrideDiffResultTypeFail; Procedure TestClass_MethodOverrideDiffResultTypeFail;
Procedure TestClass_MethodOverrideDiffVarName;
Procedure TestClass_MethodOverloadAncestor; Procedure TestClass_MethodOverloadAncestor;
Procedure TestClass_MethodOverloadArrayOfTClass; Procedure TestClass_MethodOverloadArrayOfTClass;
Procedure TestClass_ConstructorOverride; Procedure TestClass_ConstructorOverride;
@ -5901,6 +5902,23 @@ begin
nResultTypeMismatchExpectedButFound); nResultTypeMismatchExpectedButFound);
end; end;
procedure TTestResolver.TestClass_MethodOverrideDiffVarName;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' procedure DoIt(aName: string); virtual; abstract;',
' end;',
' TCar = class',
' procedure DoIt(aCaption: string); override;',
' end;',
'procedure TCar.DoIt(aCaption: string); begin end;',
'begin'
]);
ParseProgram;
end;
procedure TTestResolver.TestClass_MethodOverloadAncestor; procedure TTestResolver.TestClass_MethodOverloadAncestor;
begin begin
StartProgram(false); StartProgram(false);