paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 08:30:54 +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);
if DeclProc=nil then
RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
// 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
RaiseMsg(20170216151722,nAbstractMethodsMustNotHaveImplementation,sAbstractMethodsMustNotHaveImplementation,[],ImplProc);
if DeclProc.IsExternal then
RaiseXExpectedButYFound(20170216151725,'method','external method',ImplProc);
CheckProcSignatureMatch(DeclProc,ImplProc,true);
ImplProcScope.DeclarationProc:=DeclProc;
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
DeclProcScope.ImplProc:=ImplProc;
// replace arguments in scope with declaration arguments

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

@ -429,6 +429,7 @@ type
Procedure TestClassForwardNotResolved;
Procedure TestClass_Method;
Procedure TestClass_ConstructorMissingDotFail;
Procedure TestClass_MethodImplDuplicateFail;
Procedure TestClass_MethodWithoutClassFail;
Procedure TestClass_MethodInOtherUnitFail;
Procedure TestClass_MethodWithParams;
@ -6550,6 +6551,22 @@ begin
nXExpectedButYFound);
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;
begin
StartProgram(false);