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

fcl-passrc: resolver: check duplicate method implementation

Browse Source 
git-svn-id: trunk@38217 -
This commit is contained in:
Mattias Gaertner 2018-02-12 08:49:59 +00:00
parent 6400d612e8
commit 83cfd30768
2 changed files with 22 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4514,15 +4514,19 @@ begin
DeclProc:=FindProcOverload(ProcName,ImplProc,CurClassScope); DeclProc:=FindProcOverload(ProcName,ImplProc,CurClassScope);
if DeclProc=nil then if DeclProc=nil then
RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType); RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
// connect method declaration and body // connect method declaration and body
if DeclProcScope.ImplProc<>nil then
RaiseMsg(20180212094546,nDuplicateIdentifier,sDuplicateIdentifier,
[DeclProcScope.ImplProc.Name,GetElementSourcePosStr(DeclProcScope.ImplProc)],
ImplProc);
if DeclProc.IsAbstract then if DeclProc.IsAbstract then
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,true); CheckProcSignatureMatch(DeclProc,ImplProc,true);
ImplProcScope.DeclarationProc:=DeclProc; ImplProcScope.DeclarationProc:=DeclProc;
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
DeclProcScope.ImplProc:=ImplProc; DeclProcScope.ImplProc:=ImplProc;
// replace arguments in scope with declaration arguments // replace arguments in scope with declaration arguments

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

@ -429,6 +429,7 @@ type
Procedure TestClassForwardNotResolved; Procedure TestClassForwardNotResolved;
Procedure TestClass_Method; Procedure TestClass_Method;
Procedure TestClass_ConstructorMissingDotFail; Procedure TestClass_ConstructorMissingDotFail;
Procedure TestClass_MethodImplDuplicateFail;
Procedure TestClass_MethodWithoutClassFail; Procedure TestClass_MethodWithoutClassFail;
Procedure TestClass_MethodInOtherUnitFail; Procedure TestClass_MethodInOtherUnitFail;
Procedure TestClass_MethodWithParams; Procedure TestClass_MethodWithParams;
@ -6550,6 +6551,22 @@ begin
nXExpectedButYFound); nXExpectedButYFound);
end; end;
procedure TTestResolver.TestClass_MethodImplDuplicateFail;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' procedure DoIt;',
' end;',
'procedure TObject.DoIt; begin end;',
'procedure TObject.DoIt; begin end;',
'begin',
'']);
CheckResolverException('Duplicate identifier "TObject.DoIt" at afile.pp(6,23) at afile.pp (7,23)',
nDuplicateIdentifier);
end;
procedure TTestResolver.TestClass_MethodWithoutClassFail; procedure TTestResolver.TestClass_MethodWithoutClassFail;
begin begin
StartProgram(false); StartProgram(false);