diff --git a/.gitattributes b/.gitattributes index c1c3c73e46..d1870f3c57 100644 --- a/.gitattributes +++ b/.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 diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index ad38831077..470253f571 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/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 = class(GObject2) + // ^^^^^^ + // SpecializeParams: GObject1 = class(GObject2) + // ^^^^^^ + 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; diff --git a/components/codetools/tests/moduletests/fdt_generics_guesstype.pas b/components/codetools/tests/moduletests/fdt_generics_guesstype.pas new file mode 100644 index 0000000000..5bd80522d4 --- /dev/null +++ b/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 = class abstract + public + property Current: T read DoGetCurrent; + end; + + { TEnumerable } + + generic TEnumerable = class abstract + public + function GetEnumerator: specialize TEnumerator; virtual; abstract; + end; + + { TEnumerableWithPointers } + + generic TEnumerableWithPointers = class(specialize TEnumerable) + end; + + { TCustomList } + + generic TCustomList = class abstract(specialize TEnumerableWithPointers) + end; + + { TCustomListEnumerator } + + generic TCustomListEnumerator = class abstract(specialize TEnumerator) + protected + function GetCurrent: T; virtual; abstract; + end; + + { TCustomListWithPointers } + + generic TCustomListWithPointers = class(specialize TCustomList) + end; + + { TListP1 } + + generic TListP1 = class(specialize TCustomListWithPointers) + public + type + TEnumerator = class(specialize TCustomListEnumerator); + function GetEnumerator: TEnumerator; virtual; abstract; + end; + + { TListP2 } + + generic TListP2 = class(specialize TCustomListWithPointers) + public + type + TEnumerator = class(specialize TCustomListEnumerator); + function GetEnumerator: TEnumerator; virtual; abstract; + end; + + { TListP3 } + + generic TListP3 = class(specialize TCustomListWithPointers) + public + type + TEnumerator = class(specialize TCustomListEnumerator); + function GetEnumerator: TEnumerator; virtual; abstract; + end; + + generic TObjectListP1_1 = class(specialize TListP1) + end; + generic TObjectListP1_2 = class(specialize TListP2) + end; + generic TObjectListP1_3 = class(specialize TListP3) + end; + + generic TObjectListP2_1 = class(specialize TListP1) + end; + generic TObjectListP2_2 = class(specialize TListP2) + end; + generic TObjectListP2_3 = class(specialize TListP3) + end; + + generic TObjectListP3_1 = class(specialize TListP1) + end; + generic TObjectListP3_2 = class(specialize TListP2) + end; + generic TObjectListP3_3 = class(specialize TListP3) + end; + + TObj = class + end; + TObj1 = class + end; + TObj2 = class + end; + + TOL_P1_1 = specialize TObjectListP1_1; + TOL_P1_2 = specialize TObjectListP1_2; + TOL_P1_3 = specialize TObjectListP1_3; + TOL_P2_1 = specialize TObjectListP2_1; + TOL_P2_2 = specialize TObjectListP2_2; + TOL_P2_3 = specialize TObjectListP2_3; + TOL_P3_1 = specialize TObjectListP3_1; + TOL_P3_2 = specialize TObjectListP3_2; + TOL_P3_3 = specialize TObjectListP3_3; + TOL2 = class(specialize TObjectListP1_1); + 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. + + diff --git a/components/codetools/tests/testfinddeclaration.pas b/components/codetools/tests/testfinddeclaration.pas index dd0ae48706..4c43db9727 100644 --- a/components/codetools/tests/testfinddeclaration.pas +++ b/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;