Browse Source

fcl-passrc: resolver: started generic type overload

git-svn-id: trunk@43206 -
Mattias Gaertner 5 years ago
parent
commit
b70c6cc344

+ 12 - 4
packages/fcl-passrc/src/pasresolver.pp

@@ -5428,8 +5428,16 @@ function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
     while Identifier<>nil do
     while Identifier<>nil do
       begin
       begin
       CurEl:=Identifier.Element;
       CurEl:=Identifier.Element;
-      if not (CurEl is TPasGenericType) then break;
-      if GetTypeParameterCount(TPasGenericType(CurEl))=TypeParamCnt then break;
+      if CurEl is TPasGenericType then
+        begin
+        if GetTypeParameterCount(TPasGenericType(CurEl))=TypeParamCnt then
+          break;
+        end
+      else
+        begin
+        if TypeParamCnt=0 then
+          break;
+        end;
       Identifier:=Identifier.NextSameIdentifier;
       Identifier:=Identifier.NextSameIdentifier;
       end;
       end;
     Result:=Identifier;
     Result:=Identifier;
@@ -5506,7 +5514,7 @@ begin
 
 
   // check duplicate in current scope
   // check duplicate in current scope
   OlderIdentifier:=Identifier.NextSameIdentifier;
   OlderIdentifier:=Identifier.NextSameIdentifier;
-  if IsGeneric then
+  if IsGeneric and (msDelphi in CurrentParser.CurrentModeswitches) then
     OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
     OlderIdentifier:=SkipGenericTypes(OlderIdentifier,TypeParamCnt);
   if OlderIdentifier<>nil then
   if OlderIdentifier<>nil then
     begin
     begin
@@ -20387,7 +20395,7 @@ begin
     else
     else
       NeedPop:=false;
       NeedPop:=false;
 
 
-    if (TypeParamCount>0) and (RightPath='') then
+    if (RightPath='') and (TypeParamCount>0) then
       begin
       begin
       NextEl:=FindGenericEl(CurName,TypeParamCount,FindData,ErrorEl);
       NextEl:=FindGenericEl(CurName,TypeParamCount,FindData,ErrorEl);
       if (FindData.StartScope<>nil) and (FindData.StartScope.ClassType=ScopeClass_WithExpr)
       if (FindData.StartScope<>nil) and (FindData.StartScope.ClassType=ScopeClass_WithExpr)

+ 24 - 0
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -58,6 +58,7 @@ type
     // generic class
     // generic class
     procedure TestGen_Class;
     procedure TestGen_Class;
     procedure TestGen_ClassDelphi;
     procedure TestGen_ClassDelphi;
+    procedure TestGen_ClassDelphi_TypeOverload; // ToDo
     procedure TestGen_ClassObjFPC;
     procedure TestGen_ClassObjFPC;
     procedure TestGen_ClassObjFPC_OverloadFail;
     procedure TestGen_ClassObjFPC_OverloadFail;
     procedure TestGen_ClassForward;
     procedure TestGen_ClassForward;
@@ -756,6 +757,29 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolveGenerics.TestGen_ClassDelphi_TypeOverload;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = word;',
+  '  TBird<T> = class',
+  '    v: T;',
+  '  end;',
+  '  TEagle = TBird<word>;',
+  'var',
+  '  b: TBird<word>;',
+  '  w: TBird;',
+  'begin',
+  '  b.v:=w;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_ClassObjFPC;
 procedure TTestResolveGenerics.TestGen_ClassObjFPC;
 begin
 begin
   StartProgram(false);
   StartProgram(false);