codetools: code completion for FOR-var-IN with generic class, from Pascal Riekenberg

git-svn-id: branches/fixes_2_0@63492 -

.gitattributes

@@ -964,6 +964,7 @@ components/codetools/tests/moduletests/fdt_classhelper.pas svneol=native#text/pl
 components/codetools/tests/moduletests/fdt_classof.pas svneol=native#text/plain
 components/codetools/tests/moduletests/fdt_for_in.pas svneol=native#text/plain
 components/codetools/tests/moduletests/fdt_generics.pas svneol=native#text/plain
+components/codetools/tests/moduletests/fdt_generics_guesstype.pas svneol=native#text/plain
 components/codetools/tests/moduletests/fdt_guesstype1.pas svneol=native#text/plain
 components/codetools/tests/moduletests/fdt_nestedclasses.pas svneol=native#text/plain
 components/codetools/tests/moduletests/fdt_objccategory.pas svneol=native#text/plain

components/codetools/finddeclarationtool.pas

@@ -537,6 +537,25 @@ type
     property Tree: TAVLTree read FTree;
   end;
 
+  { TGenericParamValueMapping }
+
+  TGenericParamValueMapping = packed class
+    NextBrother: TGenericParamValueMapping;
+    GenericParamNode,
+    SpecializeValueNode: TCodeTreeNode;
+    constructor Create(pPrevBrother: TGenericParamValueMapping; pParam, pValue: TCodeTreeNode);
+    destructor Destroy; override;
+  end;
+
+  { TGenericParamValueMappings }
+
+  TGenericParamValueMappings = record
+    SpecializeParamsTool: TFindDeclarationTool;
+    SpecializeParamsNode: TCodeTreeNode;
+    SpecializeValuesTool: TFindDeclarationTool;
+    FirstParamValueMapping: TGenericParamValueMapping;
+  end;
+
   { TGenericParams }
 
   TGenericParams = record
@@ -582,6 +601,7 @@ type
     FHelpers: array[TFDHelpersListKind] of TFDHelpersList;
     FFreeHelpers: array[TFDHelpersListKind] of Boolean;
     FNeedHelpers: Boolean;
+    GenParamValueMappings: TGenericParamValueMappings;
     procedure ClearFoundProc;
     procedure FreeFoundProc(aFoundProc: PFoundProc; FreeNext: boolean);
     procedure RemoveFoundProcFromList(aFoundProc: PFoundProc);
@@ -593,6 +613,9 @@ type
   private
     procedure SetGenericParamValues(SpecializeParamsTool: TFindDeclarationTool;
                 SpecializeNode: TCodeTreeNode);
+    procedure UpdateGenericParamMapping(SpecializeParamsTool: TFindDeclarationTool;
+                SpecializeParamsNode: TCodeTreeNode; GenericParamsNode: TCodeTreeNode);
+    procedure UpdateContexWithGenParamValue(var SpecializeParamContext: TFindContext);
     function FindGenericParamType: Boolean;
     procedure AddOperandPart(aPart: string);
     property ExtractedOperand: string read FExtractedOperand;
@@ -1525,6 +1548,23 @@ begin
   ListOfPFindContext:=nil;
 end;
 
+{ TGenericParamValueMapping }
+
+constructor TGenericParamValueMapping.Create(pPrevBrother: TGenericParamValueMapping; pParam, pValue: TCodeTreeNode);
+begin
+  if pPrevBrother <> nil then
+    pPrevBrother.NextBrother := Self;
+  GenericParamNode := pParam;
+  SpecializeValueNode := pValue;
+end;
+
+destructor TGenericParamValueMapping.Destroy;
+begin
+  if NextBrother <> nil then
+    NextBrother.Free;
+  inherited Destroy;
+end;
+
 { TFindIdentifierInUsesSection_FindMissingFPCUnit }
 
 constructor TFindIdentifierInUsesSection_FindMissingFPCUnit.Create;
@@ -5565,6 +5605,7 @@ begin
         Result.Node:=NameNode;
         if Result.Node=nil then break;
         Params.SetGenericParamValues(Self, SpecializeNode);
+        Params.UpdateGenericParamMapping(Self, SpecializeNode.FirstChild.NextBrother, Nil);
         SearchIdentifier(SpecializeNode,NameNode.StartPos,IsPredefined,Result);
         if (Result.Node=nil) or (Result.Node.Desc<>ctnGenericType) then begin
           // not a generic
@@ -7499,7 +7540,7 @@ function TFindDeclarationTool.FindAncestorOfClassInheritance(
 var
   InheritanceNode: TCodeTreeNode;
   ClassNode: TCodeTreeNode;
-  SpecializeNode : TCodeTreeNode;
+  SpecializeNode , GenericParamsNode: TCodeTreeNode;
   AncestorContext: TFindContext;
   AncestorStartPos: LongInt;
   ExprType: TExpressionType;
@@ -7542,7 +7583,7 @@ begin
   AncestorStartPos:=CurPos.StartPos;
   ReadNextAtom;
 
-  Params:=TFindDeclarationParams.Create;
+  Params:=TFindDeclarationParams.Create(ResultParams);
   try
     Params.Flags:=fdfDefaultForExpressions;
     Params.ContextNode:=IdentifierNode;
@@ -7582,6 +7623,13 @@ begin
       if IdentifierNode.Desc=ctnSpecialize then begin
          SpecializeNode:=IdentifierNode;
          Params.SetGenericParamValues(Self, SpecializeNode);
+         if (ClassNode <> nil) then begin
+           GenericParamsNode := nil;
+           if (ClassNode.Parent <> nil)
+           and (ClassNode.Parent.Desc = ctnGenericType) then
+             GenericParamsNode:=ClassNode.Parent.FirstChild.NextBrother;
+           ResultParams.UpdateGenericParamMapping(Self, SpecializeNode.FirstChild.NextBrother, GenericParamsNode);
+         end;
       end;
       try
         Params.Flags:=fdfDefaultForExpressions+[fdfFindChildren];
@@ -10150,7 +10198,8 @@ begin
     ResolveChildren;
 
   Result:=ExprType;
-  if (Result.Desc=xtContext) and (not (fdfFindVariable in StartFlags)) then
+  if (Result.Desc=xtContext) and (not (fdfFindVariable in StartFlags))
+  and (not (Result.Context.Node.Desc = ctnSpecialize)) then
     Result:=Result.Context.Tool.ConvertNodeToExpressionType(
                  Result.Context.Node,Params);
   {$IFDEF ShowExprEval}
@@ -12668,13 +12717,18 @@ function TFindDeclarationTool.FindForInTypeAsString(TermPos: TAtomPosition;
       xtContext:
         begin
           case SubExprType.Context.Node.Desc of
-          ctnClass, ctnRecordType, ctnClassHelper, ctnRecordHelper, ctnTypeHelper:
+          ctnSpecialize, ctnClass, ctnRecordType,
+          ctnClassHelper, ctnRecordHelper, ctnTypeHelper, ctnClassInterface:
             begin
               AliasType:=CleanFindContext;
               if not SubExprType.Context.Tool.FindEnumeratorOfClass(
                 SubExprType.Context.Node,true,ExprType,@AliasType, Params)
               then
                 RaiseTermHasNoIterator(20170421211210,SubExprType);
+              if (ExprType.Desc = xtContext)
+              and (ExprType.Context.Node.Desc = ctnGenericParameter) then begin
+                Params.UpdateContexWithGenParamValue(ExprType.Context);
+              end;
               Result:=FindExprTypeAsString(ExprType,TermPos.StartPos,@AliasType);
             end;
           ctnEnumerationType:
@@ -12815,6 +12869,8 @@ function TFindDeclarationTool.FindEnumeratorOfClass(ClassNode: TCodeTreeNode;
   AliasType: PFindContext; ParentParams: TFindDeclarationParams): boolean;
 var
   Params: TFindDeclarationParams;
+  ClassTool: TFindDeclarationTool;
+  ClassContext: TFindContext;
   ProcTool: TFindDeclarationTool;
   ProcNode: TCodeTreeNode;
   EnumeratorContext: TFindContext;
@@ -12828,6 +12884,23 @@ begin
   ExprType:=CleanExpressionType;
   Params:=TFindDeclarationParams.Create(ParentParams);
   try
+    if ClassNode.Desc = ctnSpecialize then begin
+      Params.ContextNode:=ClassNode;
+      Params.Flags:=[fdfEnumIdentifier,fdfTopLvlResolving];
+      ClassContext := FindBaseTypeOfNode(Params, ClassNode, AliasType);
+      if (ClassContext.Node = nil)
+      or not (ClassContext.Node.Desc in [ctnClass,ctnClassInterface,ctnRecordType]) then begin
+        if ExceptionOnNotFound then begin
+          MoveCursorToCleanPos(ClassNode.StartPos);
+          RaiseExceptionFmt(20200505081501,ctsBaseTypeOfNotFound,[GetIdentifier(@Src[ClassNode.StartPos])]);
+        end else
+          exit;
+      end;
+      ClassTool := ClassContext.Tool;
+      ClassNode := ClassContext.Node;
+    end else begin
+      ClassTool := Self;
+    end;
     // search function 'GetEnumerator'
     Params.ContextNode:=ClassNode;
     Params.Flags:=[fdfSearchInAncestors,fdfSearchInHelpers];
@@ -12835,7 +12908,7 @@ begin
     {$IFDEF ShowForInEval}
     DebugLn(['TFindDeclarationTool.FindEnumeratorOfClass searching GetEnumerator for ',ExtractClassName(ClassNode,false),' ...']);
     {$ENDIF}
-    if not FindIdentifierInContext(Params) then begin
+    if not ClassTool.FindIdentifierInContext(Params) then begin
       if ExceptionOnNotFound then begin
         MoveCursorToCleanPos(ClassNode.StartPos);
         RaiseException(20170421200638,ctsFunctionGetEnumeratorNotFoundInThisClass);
@@ -13687,6 +13760,7 @@ begin
   for HelperKind in TFDHelpersListKind do
     if FFreeHelpers[HelperKind] then
       FreeAndNil(FHelpers[HelperKind]);
+  GenParamValueMappings.FirstParamValueMapping.Free;
   inherited Destroy;
 end;
 
@@ -13900,6 +13974,117 @@ begin
   GenParams.SpecializeParamsNode := SpecializeNode.FirstChild.NextBrother;
 end;
 
+procedure TFindDeclarationParams.UpdateGenericParamMapping(SpecializeParamsTool: TFindDeclarationTool;
+  SpecializeParamsNode: TCodeTreeNode; GenericParamsNode: TCodeTreeNode);
+
+  procedure ForwardParamMapping;
+  var
+    lGenericParamNode,
+    lSpecializeParamNode,
+    lGenericParamValueNode: TCodeTreeNode;
+    lFirstMapping,
+    lMapping,
+    lLoopMapping: TGenericParamValueMapping;
+    lFound: Boolean;
+  begin
+    lFirstMapping := nil;
+    lMapping := nil;
+    // GenericParams: GObject1<V1, V2> = class(GObject2<V2, V1>)
+    //                         ^^^^^^
+    // SpecializeParams: GObject1<V1, V2> = class(GObject2<V2, V1>)
+    //                                                     ^^^^^^
+    if GenParamValueMappings.FirstParamValueMapping = nil then begin
+      // first mapping: values from GenParamValueMappings.SpecializeParamsNode
+      lSpecializeParamNode := SpecializeParamsNode.FirstChild;
+      while lSpecializeParamNode <> nil do begin
+        //find generic param / generic param value
+        lGenericParamNode := GenericParamsNode.FirstChild;
+        lGenericParamValueNode := GenParamValueMappings.SpecializeParamsNode.FirstChild;
+        lFound := false;
+        while (lGenericParamNode <> nil)
+        and (lGenericParamValueNode <> nil) do begin
+          if SpecializeParamsTool.CompareSrcIdentifiers(lSpecializeParamNode.StartPos, lGenericParamNode.StartPos) then begin
+            // found generic param
+            lMapping := TGenericParamValueMapping.Create(lMapping, lSpecializeParamNode, lGenericParamValueNode);
+            if lFirstMapping = nil then
+              lFirstMapping := lMapping;
+            lFound := true;
+            break;
+          end;
+          lGenericParamNode := lGenericParamNode.NextBrother;
+          lGenericParamValueNode := lGenericParamValueNode.NextBrother;
+        end;
+        if not lFound then begin
+
+        end;
+        lSpecializeParamNode := lSpecializeParamNode.NextBrother;
+      end;
+      GenParamValueMappings.FirstParamValueMapping := lFirstMapping;
+      GenParamValueMappings.SpecializeValuesTool := GenParamValueMappings.SpecializeParamsTool;
+    end else begin
+      // further mapping: values from GenParamValueMappings.FirstParamValueMapping
+      lSpecializeParamNode := SpecializeParamsNode.FirstChild;
+      while lSpecializeParamNode <> nil do begin
+        //find generic param / generic param value
+        lLoopMapping := GenParamValueMappings.FirstParamValueMapping;
+        lGenericParamNode := GenericParamsNode.FirstChild;
+        lFound := false;
+        while (lLoopMapping <> nil) do begin
+          lGenericParamValueNode := lLoopMapping.SpecializeValueNode;
+          if SpecializeParamsTool.CompareSrcIdentifiers(lSpecializeParamNode.StartPos, lGenericParamNode.StartPos) then begin
+            // found generic param
+            lMapping := TGenericParamValueMapping.Create(lMapping, lSpecializeParamNode, lGenericParamValueNode);
+            if lFirstMapping = nil then
+              lFirstMapping := lMapping;
+            lFound := true;
+            break;
+          end;
+          lGenericParamNode := lGenericParamNode.NextBrother;
+          lLoopMapping := lLoopMapping.NextBrother;
+        end;
+        if not lFound then begin
+
+        end;
+        lSpecializeParamNode := lSpecializeParamNode.NextBrother;
+      end;
+      GenParamValueMappings.FirstParamValueMapping.Free;
+      GenParamValueMappings.FirstParamValueMapping := lFirstMapping;
+    end;
+  end;
+
+begin
+  if Parent <> nil then begin
+    Parent.UpdateGenericParamMapping(SpecializeParamsTool, SpecializeParamsNode, GenericParamsNode);
+    exit;
+  end;
+  if (GenericParamsNode <> nil)
+  and (GenParamValueMappings.SpecializeParamsNode <> nil) then
+    ForwardParamMapping;
+  GenParamValueMappings.SpecializeParamsTool := SpecializeParamsTool;
+  GenParamValueMappings.SpecializeParamsNode := SpecializeParamsNode;
+end;
+
+procedure TFindDeclarationParams.UpdateContexWithGenParamValue(var SpecializeParamContext: TFindContext);
+var
+  lMapping: TGenericParamValueMapping;
+  lPNode, lVNode: TCodeTreeNode;
+  lPTool, lVTool: TFindDeclarationTool;
+begin
+  lMapping := GenParamValueMappings.FirstParamValueMapping;
+  while lMapping <> nil do begin
+    lPNode := lMapping.GenericParamNode;
+    lPTool := GenParamValueMappings.SpecializeParamsTool;
+    lVNode := lMapping.SpecializeValueNode;
+    lVTool := GenParamValueMappings.SpecializeValuesTool;
+    if SpecializeParamContext.Tool.CompareSrcIdentifiers(SpecializeParamContext.Node.StartPos, @lPTool.Src[lPNode.StartPos]) then begin
+      SpecializeParamContext.Node := lVNode;
+      SpecializeParamContext.Tool := lVTool;
+      exit;
+    end;
+    lMapping := lMapping.NextBrother;
+  end;
+end;
+
 function TFindDeclarationParams.FindGenericParamType: Boolean;
 var
   i, n: integer;

components/codetools/tests/moduletests/fdt_generics_guesstype.pas

@@ -0,0 +1,143 @@
+{
+  ./testcodetools --format=plain --suite=TestFindDeclaration_Generics_GuessType
+}
+program fdt_generics_guesstype;
+
+{$mode objfpc}{$H+}
+
+type
+
+  { TEnumerator }
+
+  generic TEnumerator<T> = class abstract
+  public
+    property Current: T read DoGetCurrent;
+  end;
+
+  { TEnumerable }
+
+  generic TEnumerable<T> = class abstract
+  public
+    function GetEnumerator: specialize TEnumerator<T>; virtual; abstract;
+  end;
+
+  { TEnumerableWithPointers }
+
+  generic TEnumerableWithPointers<T> = class(specialize TEnumerable<T>)
+  end;
+
+  { TCustomList }
+
+  generic TCustomList<T> = class abstract(specialize TEnumerableWithPointers<T>)
+  end;
+
+  { TCustomListEnumerator }
+
+  generic TCustomListEnumerator<T> = class abstract(specialize TEnumerator<T>)
+  protected
+    function GetCurrent: T; virtual; abstract;
+  end;
+
+  { TCustomListWithPointers }
+
+  generic TCustomListWithPointers<T> = class(specialize TCustomList<T>)
+  end;
+
+  { TListP1 }
+
+  generic TListP1<B, B2, B3> = class(specialize TCustomListWithPointers<B>)
+  public
+    type
+      TEnumerator = class(specialize TCustomListEnumerator<B>);
+    function GetEnumerator: TEnumerator; virtual; abstract;
+  end;
+
+  { TListP2 }
+
+  generic TListP2<B2, B, B3> = class(specialize TCustomListWithPointers<B>)
+  public
+    type
+      TEnumerator = class(specialize TCustomListEnumerator<B>);
+    function GetEnumerator: TEnumerator; virtual; abstract;
+  end;
+
+  { TListP3 }
+
+  generic TListP3<B2, B3, B> = class(specialize TCustomListWithPointers<B>)
+  public
+    type
+      TEnumerator = class(specialize TCustomListEnumerator<B>);
+    function GetEnumerator: TEnumerator; virtual; abstract;
+  end;
+
+  generic TObjectListP1_1<A: class; A2, A3> = class(specialize TListP1<A, A2, A3>)
+  end;
+  generic TObjectListP1_2<A: class; A2, A3> = class(specialize TListP2<A2, A, A3>)
+  end;
+  generic TObjectListP1_3<A: class; A2, A3> = class(specialize TListP3<A2, A3, A>)
+  end;
+
+  generic TObjectListP2_1<A2; A: class; A3> = class(specialize TListP1<A, A2, A3>)
+  end;
+  generic TObjectListP2_2<A2; A: class; A3> = class(specialize TListP2<A2, A, A3>)
+  end;
+  generic TObjectListP2_3<A2; A: class; A3> = class(specialize TListP3<A2, A3, A>)
+  end;
+
+  generic TObjectListP3_1<A2, A3; A: class> = class(specialize TListP1<A, A2, A3>)
+  end;
+  generic TObjectListP3_2<A2, A3; A: class> = class(specialize TListP2<A2, A, A3>)
+  end;
+  generic TObjectListP3_3<A2, A3; A: class> = class(specialize TListP3<A2, A3, A>)
+  end;
+
+  TObj = class
+  end;
+  TObj1 = class
+  end;
+  TObj2 = class
+  end;
+
+  TOL_P1_1 = specialize TObjectListP1_1<TObj, TObj1, TObj2>;
+  TOL_P1_2 = specialize TObjectListP1_2<TObj, TObj1, TObj2>;
+  TOL_P1_3 = specialize TObjectListP1_3<TObj, TObj1, TObj2>;
+  TOL_P2_1 = specialize TObjectListP2_1<TObj1, TObj, TObj2>;
+  TOL_P2_2 = specialize TObjectListP2_2<TObj1, TObj, TObj2>;
+  TOL_P2_3 = specialize TObjectListP2_3<TObj1, TObj, TObj2>;
+  TOL_P3_1 = specialize TObjectListP3_1<TObj1, TObj2, TObj>;
+  TOL_P3_2 = specialize TObjectListP3_2<TObj1, TObj2, TObj>;
+  TOL_P3_3 = specialize TObjectListP3_3<TObj1, TObj2, TObj>;
+  TOL2 = class(specialize TObjectListP1_1<TObj, TObj1, TObj2>);
+  TOL3 = TOL2;
+  TOL4 = class(TOL2);
+
+var
+  OL_P1_1: TOL_P1_1;
+  OL_P1_2: TOL_P1_2;
+  OL_P1_3: TOL_P2_3;
+  OL_P2_1: TOL_P2_1;
+  OL_P2_2: TOL_P2_2;
+  OL_P2_3: TOL_P2_3;
+  OL_P3_1: TOL_P3_1;
+  OL_P3_2: TOL_P3_2;
+  OL_P3_3: TOL_P3_3;
+  OL2: TOL2;
+  OL3: TOL3;
+  OL4: TOL4;
+
+begin
+  for o_p1_1{guesstype:TObj} in OL_P1_1 do ;
+  for o_p1_2{guesstype:TObj} in OL_P1_2 do ;
+  for o_p1_3{guesstype:TObj} in OL_P1_3 do ;
+  for o_p2_1{guesstype:TObj} in OL_P2_1 do ;
+  for o_p2_2{guesstype:TObj} in OL_P2_2 do ;
+  for o_p2_3{guesstype:TObj} in OL_P2_3 do ;
+  for o_p3_1{guesstype:TObj} in OL_P3_1 do ;
+  for o_p3_2{guesstype:TObj} in OL_P3_2 do ;
+  for o_p3_3{guesstype:TObj} in OL_P3_3 do ;
+  for o2{guesstype:TObj} in OL2 do ;
+  for o3{guesstype:TObj} in OL3 do ;
+  for o4{guesstype:TObj} in OL4 do ;
+end.
+
+

components/codetools/tests/testfinddeclaration.pas

@@ -93,6 +93,7 @@ type
     procedure TestFindDeclaration_GenericFunction;
     procedure TestFindDeclaration_Generics_Enumerator;
     procedure TestFindDeclaration_Generics;
+    procedure TestFindDeclaration_Generics_GuessType;
     procedure TestFindDeclaration_GenericsDelphi_InterfaceAncestor;
     procedure TestFindDeclaration_ForIn;
     procedure TestFindDeclaration_FileAtCursor;
@@ -643,6 +644,11 @@ begin
   FindDeclarations('moduletests/fdt_generics.pas');
 end;
 
+procedure TTestFindDeclaration.TestFindDeclaration_Generics_GuessType;
+begin
+  FindDeclarations('moduletests/fdt_generics_guesstype.pas');
+end;
+
 procedure TTestFindDeclaration.TestFindDeclaration_GenericsDelphi_InterfaceAncestor;
 begin
   StartProgram;