Browse Source

fcl-passrc: resolver: check duplicate method implementation

git-svn-id: trunk@38217 -
Mattias Gaertner 7 years ago
parent
commit
83cfd30768
2 changed files with 22 additions and 1 deletions
  1. 5 1
      packages/fcl-passrc/src/pasresolver.pp
  2. 17 0
      packages/fcl-passrc/tests/tcresolver.pas

+ 5 - 1
packages/fcl-passrc/src/pasresolver.pp

@@ -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 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -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);