fcl-passrc: error on generic type overload

git-svn-id: trunk@43304 -

packages/fcl-passrc/src/pasresolver.pp

@@ -5433,9 +5433,12 @@ function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
 
   function SkipGenericTypes(Identifier: TPasIdentifier;
     TypeParamCnt: integer): TPasIdentifier;
+  {$IFDEF EnableGenTypeOverload}
   var
     CurEl: TPasElement;
+  {$ENDIF}
   begin
+    {$IFDEF EnableGenTypeOverload}
     while Identifier<>nil do
       begin
       CurEl:=Identifier.Element;
@@ -5451,6 +5454,9 @@ function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
         end;
       Identifier:=Identifier.NextSameIdentifier;
       end;
+    {$ELSE}
+    if TypeParamCnt=0 then ;
+    {$ENDIF}
     Result:=Identifier;
   end;
 

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -58,7 +58,7 @@ type
     // generic class
     procedure TestGen_Class;
     procedure TestGen_ClassDelphi;
-    procedure TestGen_ClassDelphi_TypeOverload; // ToDo
+    procedure TestGen_ClassDelphi_TypeOverload; // ToDo: type overload
     procedure TestGen_ClassObjFPC;
     procedure TestGen_ClassObjFPC_OverloadFail;
     procedure TestGen_ClassForward;
@@ -68,7 +68,7 @@ type
     procedure TestGen_ClassForwardConstraintTypeMismatch;
     procedure TestGen_ClassForward_Circle;
     procedure TestGen_Class_RedeclareInUnitImplFail;
-    procedure TestGen_Class_AnotherInUnitImpl;
+    procedure TestGen_Class_AnotherInUnitImpl; // ToDo: type overload
     procedure TestGen_Class_MethodObjFPC;
     procedure TestGen_Class_MethodOverride;
     procedure TestGen_Class_MethodDelphi;
@@ -763,8 +763,6 @@ end;
 
 procedure TTestResolveGenerics.TestGen_ClassDelphi_TypeOverload;
 begin
-  exit;
-
   StartProgram(false);
   Add([
   '{$mode delphi}',
@@ -774,14 +772,14 @@ begin
   '  TBird<T> = class',
   '    v: T;',
   '  end;',
-  '  TEagle = TBird<word>;',
-  'var',
-  '  b: TBird<word>;',
-  '  w: TBird;',
+  //'  TEagle = TBird<word>;',
+  //'var',
+  //'  b: TBird<word>;',
+  //'  w: TBird;',
   'begin',
-  '  b.v:=w;',
+  //'  b.v:=w;',
   '']);
-  ParseProgram;
+  CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier);
 end;
 
 procedure TTestResolveGenerics.TestGen_ClassObjFPC;
@@ -983,7 +981,7 @@ begin
   'implementation',
   'type generic TBird<T,U> = record x: T; y: U; end;',
   '']);
-  ParseUnit;
+  CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,16)',nDuplicateIdentifier);
 end;
 
 procedure TTestResolveGenerics.TestGen_Class_MethodObjFPC;