paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:49:29 +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;
procedure ReplaceProcScopeImplArgsWithDeclArgs(ImplProcScope: TPasProcedureScope);
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 ComputeBinaryExpr(Bin: TBinaryExpr;
out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
@ -3699,7 +3699,7 @@ begin
if ProcNeedsImplProc(Proc) or (not ProcNeedsImplProc(DeclProc)) then
RaiseMsg(20170216151652,nDuplicateIdentifier,sDuplicateIdentifier,
[ProcName,GetElementSourcePosStr(DeclProc)],Proc.ProcType);
CheckProcSignatureMatch(DeclProc,Proc);
CheckProcSignatureMatch(DeclProc,Proc,true);
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
DeclProcScope.ImplProc:=Proc;
ProcScope:=Proc.CustomData as TPasProcedureScope;
@ -3779,7 +3779,7 @@ begin
RaiseMsg(20170216151708,nNoMethodInAncestorToOverride,
sNoMethodInAncestorToOverride,[GetProcTypeDescription(Proc.ProcType)],Proc.ProcType);
// override a virtual method
CheckProcSignatureMatch(OverloadProc,Proc);
CheckProcSignatureMatch(OverloadProc,Proc,false);
// check visibility
if Proc.Visibility<>OverloadProc.Visibility then
case Proc.Visibility of
@ -3863,7 +3863,7 @@ begin
RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
if DeclProc.IsExternal then
RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
CheckProcSignatureMatch(DeclProc,ImplProc);
CheckProcSignatureMatch(DeclProc,ImplProc,true);
ImplProcScope.DeclarationProc:=DeclProc;
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
DeclProcScope.ImplProc:=ImplProc;
@ -4714,8 +4714,8 @@ begin
[BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType]],El);
end;
procedure TPasResolver.CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure
);
procedure TPasResolver.CheckProcSignatureMatch(DeclProc,
ImplProc: TPasProcedure; CheckNames: boolean);
var
i: Integer;
DeclArgs, ImplArgs: TFPList;
@ -4737,16 +4737,19 @@ begin
[],DeclResult,ImplResult,ImplProc);
end;
// check argument names
DeclArgs:=DeclProc.ProcType.Args;
ImplArgs:=ImplProc.ProcType.Args;
for i:=0 to DeclArgs.Count-1 do
if CheckNames then
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);
// check argument names
DeclArgs:=DeclProc.ProcType.Args;
ImplArgs:=ImplProc.ProcType.Args;
for i:=0 to DeclArgs.Count-1 do
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;

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

@ -398,6 +398,7 @@ type
Procedure TestClass_MethodOverrideFixCase;
Procedure TestClass_MethodOverrideSameResultType;
Procedure TestClass_MethodOverrideDiffResultTypeFail;
Procedure TestClass_MethodOverrideDiffVarName;
Procedure TestClass_MethodOverloadAncestor;
Procedure TestClass_MethodOverloadArrayOfTClass;
Procedure TestClass_ConstructorOverride;
@ -5901,6 +5902,23 @@ begin
nResultTypeMismatchExpectedButFound);
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;
begin
StartProgram(false);