fcl-passrc: resolver: check duplicate class forwards

git-svn-id: trunk@38224 -

packages/fcl-passrc/src/pasresolver.pp

@@ -5191,9 +5191,24 @@ var
   aModifier: String;
   IsSealed: Boolean;
   CanonicalSelf: TPasClassOfType;
+  ParentDecls: TPasDeclarations;
+  Decl: TPasElement;
 begin
   if aClass.IsForward then
+    begin
+    // check for duplicate forwards
+    ParentDecls:=aClass.Parent as TPasDeclarations;
+    for i:=0 to ParentDecls.Declarations.Count-1 do
+      begin
+      Decl:=TPasElement(ParentDecls.Declarations[i]);
+      if (CompareText(Decl.Name,aClass.Name)=0)
+          and (Decl<>aClass) then
+        RaiseMsg(20180212144132,nDuplicateIdentifier,sDuplicateIdentifier,
+          [Decl.Name,GetElementSourcePosStr(Decl)],aClass);
+      end;
     exit;
+    end;
+
   if aClass.ObjKind<>okClass then
     begin
     if (aClass.ObjKind=okInterface)
@@ -7103,7 +7118,7 @@ begin
   if not (TopScope is TPasSectionScope) then
     RaiseNotYetImplemented(20171225110934,El,'nested classes');
 
-  Duplicate:=TPasIdentifierScope(TopScope).FindIdentifier(El.Name);
+  Duplicate:=TPasIdentifierScope(TopScope).FindLocalIdentifier(El.Name);
   //if Duplicate<>nil then
     //writeln('  Duplicate=',GetObjName(Duplicate.Element),' ',ord(Duplicate.Kind));
 

packages/fcl-passrc/tests/tcresolver.pas

@@ -427,6 +427,7 @@ type
     Procedure TestClassForward;
     Procedure TestClassForwardAsAncestorFail;
     Procedure TestClassForwardNotResolved;
+    Procedure TestClassForwardDuplicateFail;
     Procedure TestClass_Method;
     Procedure TestClass_ConstructorMissingDotFail;
     Procedure TestClass_MethodImplDuplicateFail;
@@ -6518,6 +6519,19 @@ begin
     nForwardTypeNotResolved);
 end;
 
+procedure TTestResolver.TestClassForwardDuplicateFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class;',
+  '  TObject = class;',
+  '  TObject = class',
+  '  end;',
+  'begin']);
+  CheckResolverException('Duplicate identifier "TObject" at afile.pp(3,10)',nDuplicateIdentifier);
+end;
+
 procedure TTestResolver.TestClass_Method;
 begin
   StartProgram(false);