paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 14:38:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: fixed class completion of objfpc generic method

Browse Source
This commit is contained in:
mattias 2025-01-26 14:55:50 +01:00
parent 9d425ed90b
commit b7aafac192
11 changed files with 176 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
components/codetools/codecompletiontool.pas
View File

@ -509,7 +509,7 @@ begin
// search in new nodes, which will be inserted
ANodeExt:=FirstInsert;
while ANodeExt<>nil do begin
if CompareTextIgnoringSpace(ANodeExt.Signature,NameAndParamsUpCase,true)=0 then
if CompareTextIgnoringSpace(ANodeExt.Txt,NameAndParamsUpCase,true)=0 then
begin
Result.Tool:=Self;
Result.Node:=CodeCompleteClassNode;
@ -658,7 +658,7 @@ begin
// search in new nodes, which will be inserted
ANodeExt:=FirstInsert;
while ANodeExt<>nil do begin
if CompareTextIgnoringSpace(ANodeExt.Signature,UpperName,true)=0 then
if CompareTextIgnoringSpace(ANodeExt.Txt,UpperName,true)=0 then
exit(true);
ANodeExt:=ANodeExt.Next;
end;
@ -721,7 +721,7 @@ begin
NewInsert:=TCodeTreeNodeExtension.Create;
with NewInsert do begin
Node:=PosNode;
Signature:=CleanDef;
Txt:=CleanDef;
Code:=Def;
Identifier:=IdentifierName;
ProcBody:=Body;
@ -743,9 +743,9 @@ begin
// insert alphabetically
InsertPos:=FirstInsert;
LastInsertPos:=nil;
//DebugLn('GGG "',InsertPos.Signature,'" "',CleanDef,'" ',CompareTextIgnoringSpace(InsertPos.Signature,CleanDef,false));
//DebugLn('GGG "',InsertPos.Txt,'" "',CleanDef,'" ',CompareTextIgnoringSpace(InsertPos.Txt,CleanDef,false));
while (InsertPos<>nil)
and (CompareTextIgnoringSpace(InsertPos.Signature,CleanDef,false)>=0) do begin
and (CompareTextIgnoringSpace(InsertPos.Txt,CleanDef,false)>=0) do begin
LastInsertPos:=InsertPos;
InsertPos:=InsertPos.Next;
end;
@ -760,7 +760,7 @@ begin
end;
{InsertPos:=FirstInsert;
while InsertPos<>nil do begin
DebugLn(' HHH ',InsertPos.Signature);
DebugLn(' HHH ',InsertPos.Txt);
InsertPos:=InsertPos.Next;
end;}
end;
@ -3434,7 +3434,7 @@ var
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Node:=Redefinition;
NodeExt.Data:=Definition;
NodeExt.Signature:=NodeText;
NodeExt.Txt:=NodeText;
if TreeOfCodeTreeNodeExt=nil then
TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
TreeOfCodeTreeNodeExt.Add(NodeExt);
@ -3446,7 +3446,7 @@ var
begin
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Node:=Node;
NodeExt.Signature:=NodeText;
NodeExt.Txt:=NodeText;
AllNodes.Add(NodeExt);
end;
@ -3696,7 +3696,7 @@ var
TreeOfCodeTreeNodeExt:=TAVLTree.Create(@CompareCodeTreeNodeExt);
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Node:=Node;
NodeExt.Signature:=GetRedefinitionNodeText(Node);
NodeExt.Txt:=GetRedefinitionNodeText(Node);
NodeExt.Data:=ReferingNode;
NodeExt.Flags:=NeededType;
TreeOfCodeTreeNodeExt.Add(NodeExt);
@ -3712,7 +3712,7 @@ var
// add new node
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Node:=Node;
NodeExt.Signature:=NodeText;
NodeExt.Txt:=NodeText;
AllNodes.Add(NodeExt);
end else begin
// update node
@ -4001,7 +4001,7 @@ begin
else if DefNode.Desc=ctnProcedure then
ProcName:=ExtractProcName(DefNode,[])
else
ProcName:=NodeExt.Signature;
ProcName:=NodeExt.Txt;
NewSrc:=copy(NewSrc,1,FromPos-1)+ProcName
+copy(NewSrc,FromPos+length(OldProcName),length(NewSrc));
FromPos:=DefNode.StartPos;
@ -4195,7 +4195,7 @@ var
// save values
ResultNodeExt:=TCodeTreeNodeExtension.Create;
ResultNodeExt.Signature:=NodeText;
ResultNodeExt.Txt:=NodeText;
ResultNodeExt.Node:=NodeExt.Node;
ResultNodeExt.Data:=ProcNode;
ResultNodeExt.Code:=ExtractCode(ExprStart,ExprEnd,[]);
@ -4286,7 +4286,7 @@ begin
AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
while AVLNode<>nil do begin
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
DebugLn(['TCodeCompletionCodeTool.ReplaceConstFunctions ',NodeExt.Signature]);
DebugLn(['TCodeCompletionCodeTool.ReplaceConstFunctions ',NodeExt.Txt]);
DefNode:=NodeExt.Node;
BodyNode:=TCodeTreeNode(NodeExt.Data);
Expr:=NodeExt.Code;
@ -4448,7 +4448,7 @@ var
// save values
ResultNodeExt:=TCodeTreeNodeExtension.Create;
ResultNodeExt.Signature:=NodeText;
ResultNodeExt.Txt:=NodeText;
ResultNodeExt.Node:=NodeExt.Node;
ResultNodeExt.Data:=ProcNode;
ResultNodeExt.Code:=GetIdentifier(ResultType);
@ -4537,7 +4537,7 @@ begin
AVLNode:=TreeOfCodeTreeNodeExt.FindLowest;
while AVLNode<>nil do begin
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
DebugLn(['TCodeCompletionCodeTool.ReplaceTypeCastFunctions ',NodeExt.Signature]);
DebugLn(['TCodeCompletionCodeTool.ReplaceTypeCastFunctions ',NodeExt.Txt]);
DefNode:=NodeExt.Node;
BodyNode:=TCodeTreeNode(NodeExt.Data);
Expr:=NodeExt.Code;
@ -5531,7 +5531,7 @@ function TCodeCompletionCodeTool.GatherUnitDefinitions(out
RaiseRedefinition(NodeExt.Node,Node);
end;
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Signature:=NodeText;
NodeExt.Txt:=NodeText;
TreeOfCodeTreeNodeExt.Add(NodeExt);
NodeExt.Node:=Node;
end;
@ -5861,7 +5861,7 @@ begin
while AVLNode<>nil do begin
NextAVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
//DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods ',NodeExt.Signature,' ',ProcBodyIsEmpty(NodeExt.Node)]);
//DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods ',NodeExt.Txt,' ',ProcBodyIsEmpty(NodeExt.Node)]);
// check if proc body is empty (no code, no comments)
if ProcBodyIsEmpty(NodeExt.Node) then begin
GatherClassProcs;
@ -6075,9 +6075,9 @@ function TCodeCompletionCodeTool.FindAssignMethod(CursorPos: TCodeXYPosition;
NodeExt.Node:=Child;
NodeExt.Position:=Child.StartPos;
if Child.Desc=ctnVarDefinition then
NodeExt.Signature:=ExtractDefinitionName(Child)
NodeExt.Txt:=ExtractDefinitionName(Child)
else
NodeExt.Signature:=ExtractPropName(Child,false);
NodeExt.Txt:=ExtractPropName(Child,false);
MemberNodeExts.Add(NodeExt);
end;
@ -6296,7 +6296,7 @@ begin
for i:=0 to MemberNodeExts.Count-1 do begin
NodeExt:=TCodeTreeNodeExtension(MemberNodeExts[i]);
// add assignment
ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+NodeExt.Signature+':='+SrcVar+'.'+NodeExt.Signature+';'+e;
ProcBody:=ProcBody+Beauty.GetIndentStr(Indent)+NodeExt.Txt+':='+SrcVar+'.'+NodeExt.Txt+';'+e;
end;
end;
@ -7815,7 +7815,7 @@ begin
if IsVariable then begin
// the insertion is a new variable
if (ANode.Desc<>ctnVarDefinition)
or (CompareNodeIdentChars(ANode,ANodeExt.Signature)<0) then
or (CompareNodeIdentChars(ANode,ANodeExt.Txt)<0) then
break;
end else begin
// the insertion is a new method
@ -8354,10 +8354,10 @@ begin
ANodeExt:=FirstInsert;
while ANodeExt<>nil do begin
if not NodeExtIsVariable(ANodeExt) then begin
if FindNodeExtInTree(ClassProcs,ANodeExt.Signature)=nil then begin
if FindNodeExtInTree(ClassProcs,ANodeExt.Txt)=nil then begin
NewNodeExt:=TCodeTreeNodeExtension.Create;
with NewNodeExt do begin
Signature:=UpperCaseStr(TheClassName)+'.'+ANodeExt.Signature; // Name+ParamTypeList
Txt:=UpperCaseStr(TheClassName)+'.'+ANodeExt.Txt; // Name+ParamTypeList
Code:=Beauty.AddClassAndNameToProc(
ANodeExt.Code,TheClassName,''); // complete proc head code
ProcBody:=ANodeExt.ProcBody;
@ -8413,7 +8413,7 @@ begin
// update body signature in tree,
// so that no new body is created for this definition
ProcBodyNodes.RemovePointer(BodyNodeExt);
BodyNodeExt.Signature:=DefNodeExt.Signature;
BodyNodeExt.Txt:=DefNodeExt.Txt;
ProcBodyNodes.Add(BodyNodeExt);
end;
@ -8585,7 +8585,7 @@ procedure TCodeCompletionCodeTool.GuessProcDefBodyMapping(ProcDefNodes,
ProcNode:=NodeExt.Node;
NewNodeExt:=TCodeTreeNodeExtension.Create;
NewNodeExt.Node:=ProcNode;
NewNodeExt.Signature:=ExtractProcName(ProcNode,[phpWithoutClassName]);
NewNodeExt.Txt:=ExtractProcName(ProcNode,[phpWithoutClassName]);
NewNodeExt.Data:=NodeExt;
NewNodeExt.Flags:=Integer(ExtractProcedureGroup(ProcNode));
if Result=nil then
@ -8788,7 +8788,7 @@ begin
FSourceChangeCache.Replace(gtEmptyLine,gtEmptyLine,InsertPos,InsertPos,ProcCode);
if FJumpToProcHead.Name='' then begin
// remember one proc body to jump to after the completion
FJumpToProcHead.Name:=ANodeExt.Signature;
FJumpToProcHead.Name:=ANodeExt.Txt;
FJumpToProcHead.Group:=TPascalMethodGroup(ANodeExt.Flags);
FJumpToProcHead.ResultType:=ANodeExt.ResultType;
if System.Pos('.',FJumpToProcHead.Name)<1 then
@ -8796,7 +8796,7 @@ begin
if FJumpToProcHead.Name[length(FJumpToProcHead.Name)]<>';' then
FJumpToProcHead.Name:=FJumpToProcHead.Name+';';
{$IFDEF CTDEBUG}
DebugLn('CreateMethodBodies_Insert FJumpToProcHead.Name="',FJumpToProcHead.Name,'"');
DebugLn('CreateMethodBodies_Insert FJumpToProcHead.Name="',dbgs(FJumpToProcHead),'"');
{$ENDIF}
end;
end;
@ -9040,7 +9040,7 @@ var
FirstExistingProcBody:=ANode;
if ANode.StartPos>LastExistingProcBody.StartPos then
LastExistingProcBody:=ANode;
//DebugLn(['FindTopMostAndBottomMostProcBodies ',TCodeTreeNodeExtension(ExistingNode.Data).Signature]);
//DebugLn(['FindTopMostAndBottomMostProcBodies ',TCodeTreeNodeExtension(ExistingNode.Data).Txt]);
ExistingNode:=ProcBodyNodes.FindSuccessor(ExistingNode);
end;
end;
@ -9064,8 +9064,8 @@ var
ANode2:=ANodeExt.Node;
end;
debugln(['CheckForDoubleDefinedMethods redefined']);
debugln(' 1. ',ANodeExt.Signature,' ',CleanPosToStr(ANodeExt.Node.StartPos));
debugln(' 2. ',ANodeExt2.Signature,' ',CleanPosToStr(ANodeExt2.Node.StartPos));
debugln(' 1. ',ANodeExt.Txt,' ',CleanPosToStr(ANodeExt.Node.StartPos));
debugln(' 2. ',ANodeExt2.Txt,' ',CleanPosToStr(ANodeExt2.Node.StartPos));
CleanPosToCaret(ANode.FirstChild.StartPos,Caret1);
CleanPosToCaret(ANode2.FirstChild.StartPos,Caret2);
s:=IntToStr(Caret2.Y)+','+IntToStr(Caret2.X);
@ -9145,13 +9145,13 @@ begin
debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ClassProcs=',ClassProcs.Count]);
AnAVLNode:=ClassProcs.FindLowest;
while AnAVLNode<>nil do begin
DebugLn(' Gathered ProcDef ',TCodeTreeNodeExtension(AnAVLNode.Data).Signature);
DebugLn(' Gathered ProcDef ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
end;
debugln(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ProcBodyNodes=',ProcBodyNodes.Count]);
AnAVLNode:=ProcBodyNodes.FindLowest;
while AnAVLNode<>nil do begin
DebugLn(' Gathered ProcBody ',TCodeTreeNodeExtension(AnAVLNode.Data).Signature);
DebugLn(' Gathered ProcBody ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
AnAVLNode:=ProcBodyNodes.FindSuccessor(AnAVLNode);
end;
{$ENDIF}
@ -9189,7 +9189,7 @@ begin
{$IFDEF VerboseCreateMissingClassProcBodies}
AnAVLNode:=ClassProcs.FindLowest;
while AnAVLNode<>nil do begin
DebugLn(' SignaturesUpdated ProcDef ',TCodeTreeNodeExtension(AnAVLNode.Data).Signature);
DebugLn(' SignaturesUpdated ProcDef ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
end;
{$ENDIF}
@ -9199,7 +9199,7 @@ begin
{$IFDEF VerboseCreateMissingClassProcBodies}
AnAVLNode:=ClassProcs.FindLowest;
while AnAVLNode<>nil do begin
DebugLn(' AfterPropsCompleted ',TCodeTreeNodeExtension(AnAVLNode.Data).Signature);
DebugLn(' AfterPropsCompleted ',TCodeTreeNodeExtension(AnAVLNode.Data).Txt);
AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
end;
{$ENDIF}
@ -9228,12 +9228,12 @@ begin
{$IFDEF VerboseCreateMissingClassProcBodies}
AnAVLNode:=ClassProcs.FindLowest;
while AnAVLNode<>nil do begin
DebugLn(' BeforeAddMissing ProcDef "',TCodeTreeNodeExtension(AnAVLNode.Data).Signature,'"');
DebugLn(' BeforeAddMissing ProcDef "',TCodeTreeNodeExtension(AnAVLNode.Data).Txt,'"');
AnAVLNode:=ClassProcs.FindSuccessor(AnAVLNode);
end;
AnAVLNode:=ProcBodyNodes.FindLowest;
while AnAVLNode<>nil do begin
DebugLn(' BeforeAddMissing ProcBody "',TCodeTreeNodeExtension(AnAVLNode.Data).Signature,'"');
DebugLn(' BeforeAddMissing ProcBody "',TCodeTreeNodeExtension(AnAVLNode.Data).Txt,'"');
AnAVLNode:=ProcBodyNodes.FindSuccessor(AnAVLNode);
end;
{$ENDIF}
@ -9279,13 +9279,13 @@ begin
MissingNode:=ClassProcs.FindPrecessor(MissingNode);
ExistingNode:=ProcBodyNodes.Find(ANodeExt);
{$IFDEF VerboseCreateMissingClassProcBodies}
DebugLn(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ANodeExt.Txt=',ANodeExt.Signature,' ExistingNode=',ExistingNode<>nil]);
DebugLn(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ANodeExt.Txt=',ANodeExt.Txt,' ExistingNode=',ExistingNode<>nil]);
{$ENDIF}
if (ExistingNode=nil) and (not ProcNodeHasSpecifier(ANodeExt.Node,psEXTERNAL))
then begin
{$IFDEF VerboseCreateMissingClassProcBodies}
//generates AV:
//DebugLn(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ANodeExt.Txt=',ANodeExt.Signature,' ExistingNode=',TCodeTreeNodeExtension(ExistingNode.Data).Signature]);
//DebugLn(['TCodeCompletionCodeTool.CreateMissingClassProcBodies ANodeExt.Txt=',ANodeExt.Txt,' ExistingNode=',TCodeTreeNodeExtension(ExistingNode.Data).Txt]);
{$ENDIF}
// MissingNode does not have a body -> insert proc body
case MethodInsertPolicy of
@ -9861,7 +9861,7 @@ begin
// add method data
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Signature:=CleanProcCode;
NodeExt.Txt:=CleanProcCode;
NodeExt.Code:=FullProcCode;
NodeExt.Identifier:=ProcName;
NodeExt.ProcBody:=ProcCode;
@ -9900,7 +9900,7 @@ begin
AVLNode:=NewMethods.FindLowest;
while AVLNode<>nil do begin
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
CleanProcCode:=NodeExt.Signature;
CleanProcCode:=NodeExt.Txt;
FullProcCode:=NodeExt.Code;
ProcName:=NodeExt.Identifier;
ProcCode:=NodeExt.ProcBody;

16
components/codetools/codetree.pas
View File

@ -351,7 +351,7 @@ type
TCodeTreeNodeExtension = class
public
Node: TCodeTreeNode;
Signature: string; // was Txt
Txt: string;
Identifier: string; // the name of the variable or method, was ExtTxt2
Code: string; // was ExtTxt1
ProcBody: string; // was ExtTxt3
@ -629,7 +629,7 @@ function CompareTxtWithCodeTreeNodeExt(p: Pointer; NodeData: pointer
var
NodeExt: TCodeTreeNodeExtension absolute NodeData;
begin
Result:=CompareTextIgnoringSpace(Ansistring(p),NodeExt.Signature,false);
Result:=CompareTextIgnoringSpace(Ansistring(p),NodeExt.Txt,false);
end;
function CompareIdentifierWithCodeTreeNodeExt(p: Pointer; NodeData: pointer
@ -638,7 +638,7 @@ var
NodeExt: TCodeTreeNodeExtension absolute NodeData;
begin
NodeExt:=TCodeTreeNodeExtension(NodeData);
Result:=CompareIdentifiers(p,PChar(NodeExt.Signature));
Result:=CompareIdentifiers(p,PChar(NodeExt.Txt));
end;
function CompareCodeTreeNodeExt(NodeData1, NodeData2: pointer): integer;
@ -646,7 +646,7 @@ var
NodeExt1: TCodeTreeNodeExtension absolute NodeData1;
NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
begin
Result:=CompareTextIgnoringSpace(NodeExt1.Signature,NodeExt2.Signature,false);
Result:=CompareTextIgnoringSpace(NodeExt1.Txt,NodeExt2.Txt,false);
end;
function CompareCodeTreeNodeExtWithPos(NodeData1, NodeData2: pointer): integer;
@ -682,7 +682,7 @@ var
NodeExt1: TCodeTreeNodeExtension absolute NodeData1;
NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
begin
Result:=CompareTextIgnoringSpace(NodeExt1.Signature,NodeExt2.Signature,false);
Result:=CompareTextIgnoringSpace(NodeExt1.Txt,NodeExt2.Txt,false);
if Result<>0 then exit;
if NodeExt1.Position<NodeExt2.Position then
Result:=1
@ -1182,7 +1182,7 @@ end;
procedure TCodeTreeNodeExtension.Clear;
begin
Next:=nil;
Signature:='';
Txt:='';
Code:='';
Identifier:='';
ProcBody:='';
@ -1212,14 +1212,14 @@ begin
DbgOut('Node=',NodeDescriptionAsString(Node.Desc))
else
DbgOut('Node=nil');
DbgOut(' Position=',dbgs(Position),' Txt="'+Signature+'" ExtTxt1="'+Code+'" ExtTxt2="'+Identifier+'" ExtTxt3="'+ProcBody+'" ExtTxt4="'+ResultType+'"');
DbgOut(' Position=',dbgs(Position),' Txt="'+Txt+'" ExtTxt1="'+Code+'" ExtTxt2="'+Identifier+'" ExtTxt3="'+ProcBody+'" ExtTxt4="'+ResultType+'"');
debugln;
end;
function TCodeTreeNodeExtension.CalcMemSize: PtrUInt;
begin
Result:=PtrUInt(InstanceSize)
+MemSizeString(Signature)
+MemSizeString(Txt)
+MemSizeString(Code)
+MemSizeString(Identifier)
+MemSizeString(ProcBody)

6
components/codetools/ide/addassignmethoddlg.pas
View File

@ -245,9 +245,9 @@ begin
NextAVLNode:=FMemberNodeExts.FindSuccessor(AVLNode);
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
AssignIt:=true;
if (NodeExt.Signature='') then AssignIt:=false;
if (NodeExt.Txt='') then AssignIt:=false;
if AssignIt then begin
FoundAVLNode:=FItems.FindKey(PChar(NodeExt.Signature),@CompareAnsistringWithAAMDItemName);
FoundAVLNode:=FItems.FindKey(PChar(NodeExt.Txt),@CompareAnsistringWithAAMDItemName);
if FoundAVLNode<>nil then begin
Item:=TAAMDItem(FoundAVLNode.Data);
AssignIt:=Item.Selected;
@ -503,7 +503,7 @@ begin
// kind
Item.Desc:=NodeExt.Node.Desc;
// name
Item.Name:=NodeExt.Signature;
Item.Name:=NodeExt.Txt;
// written by property
if NodeExt.Data<>nil then
Item.WrittenByProperty:=FTool.ExtractPropName(TCodeTreeNode(NodeExt.Data),false)

2
components/codetools/identcompletiontool.pas
View File

@ -3857,7 +3857,7 @@ var
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Node:=ProcNode;
NodeExt.Data:=ATool;
NodeExt.Signature:=ProcText;
NodeExt.Txt:=ProcText;
if IsAbstract then
NodeExt.Flags:=FlagIsAbstract
else

18
components/codetools/methodjumptool.pas
View File

@ -143,7 +143,7 @@ begin
NodeExt1:=TCodeTreeNodeExtension(AVLNode1.Data);
if AVLNode2<>nil then begin
NodeExt2:=TCodeTreeNodeExtension(AVLNode2.Data);
cmp:=CompareTextIgnoringSpace(NodeExt1.Signature,NodeExt2.Signature,false);
cmp:=CompareTextIgnoringSpace(NodeExt1.Txt,NodeExt2.Txt,false);
if cmp<0 then begin
// node of tree1 does not exist in tree2
// -> delete
@ -836,10 +836,10 @@ begin
NewNodeExt:=TCodeTreeNodeExtension.Create;
with NewNodeExt do begin
Node:=ANode;
Signature:=CurProcName;
Txt:=CurProcName;
Flags:=Ord(ExtractProcedureGroup(ANode));
if TPascalMethodGroup(Flags)=mgClassOperator then
// for class operator the result type is part of the signature
// for class operator the result type is part of the Txt
ResultType:=ExtractFuncResultType(ANode,Attr);
end;
Result.Add(NewNodeExt);
@ -884,15 +884,15 @@ begin
//DebugLn('[TMethodJumpingCodeTool.FindFirstDifferenceNode] B ',SearchInNode<>nil);
cmp:=CompareCodeTreeNodeExt(Result.Data,SearchInNode.Data);
//NodeTxt1:=TCodeTreeNodeExtension(Result.Data).Signature;
//NodeTxt2:=TCodeTreeNodeExtension(SearchInNode.Data).Signature;
//NodeTxt1:=TCodeTreeNodeExtension(Result.Data).Txt;
//NodeTxt2:=TCodeTreeNodeExtension(SearchInNode.Data).Txt;
//DebugLn('[TMethodJumpingCodeTool.FindFirstDifferenceNode] ',NodeTxt1,' ?',cmp,'= ',NodeTxt2);
if cmp<0 then begin
// result node not found in SearchInNodes
// -> search for first difference
//NodeTxt1:=TCodeTreeNodeExtension(Result.Data).Signature;
//NodeTxt2:=TCodeTreeNodeExtension(SearchInNode.Data).Signature;
//NodeTxt1:=TCodeTreeNodeExtension(Result.Data).Txt;
//NodeTxt2:=TCodeTreeNodeExtension(SearchInNode.Data).Txt;
Attr:=[phpWithStart, phpWithoutClassName, phpWithVarModifiers,
phpWithResultType, phpInUpperCase];
NodeTxt1:=ExtractProcHead(TCodeTreeNodeExtension(Result.Data).Node,Attr);
@ -938,7 +938,7 @@ begin
ANode:=ATree.Root;
while ANode<>nil do begin
Result:=TCodeTreeNodeExtension(ANode.Data);
cmp:=CompareTextIgnoringSpace(UpperCode,Result.Signature,true);
cmp:=CompareTextIgnoringSpace(UpperCode,Result.Txt,true);
if cmp<0 then
ANode:=ANode.Left
else if cmp>0 then
@ -1210,7 +1210,7 @@ begin
end else
DbgOut('Node=nil');
DbgOut(' Position=',Dbgs(ANodeExt.Position));
DbgOut(' Txt="',ANodeExt.Signature,'"');
DbgOut(' Txt="',ANodeExt.Txt,'"');
DbgOut(' ExtTxt1="',ANodeExt.Code,'"');
DbgOut(' ExtTxt2="',ANodeExt.Identifier,'"');
DebugLn();

11
components/codetools/pascalparsertool.pas
View File

@ -542,7 +542,7 @@ begin
then exit(KeyWordFuncClassFinal);
end;
'G':
if CompareSrcIdentifiers(p,'GENERIC') and (Scanner.CompilerMode in [cmDELPHI,cmOBJFPC])
if CompareSrcIdentifiers(p,'GENERIC') and (Scanner.CompilerMode=cmOBJFPC)
and (CurNode.Desc <> ctnTypeSection)
then
exit(KeyWordFuncClassMethod);
@ -1384,7 +1384,7 @@ begin
// create class method node
CreateChildNode;
CurNode.Desc:=ctnProcedure;
if UpAtomIs('GENERIC') then begin
if (Scanner.CompilerMode=cmOBJFPC) and UpAtomIs('GENERIC') then begin
IsGeneric:=true;
ReadNextAtom;
end else
@ -2823,9 +2823,11 @@ var
HasForwardModifier, IsClassProc: boolean;
ProcNode: TCodeTreeNode;
ParseAttr: TParseProcHeadAttributes;
StartPos: Integer;
begin
ParseAttr:=[pphCreateNodes];
if UpAtomIs('GENERIC') then begin
StartPos:=CurPos.StartPos;
if (Scanner.CompilerMode=cmOBJFPC) and UpAtomIs('GENERIC') then begin
Include(ParseAttr,pphIsGeneric);
ReadNextAtom;
end;
@ -2843,8 +2845,7 @@ begin
IsClassProc:=false;
// create node for procedure
CreateChildNode;
if IsClassProc then
CurNode.StartPos:=LastAtoms.GetPriorAtom.StartPos;
CurNode.StartPos:=StartPos;
ProcNode:=CurNode;
ProcNode.Desc:=ctnProcedure;
if CurSection=ctnInterface then

42
components/codetools/pascalreadertool.pas
View File

@ -399,8 +399,8 @@ var
NodeExt2: TCodeTreeNodeExtension absolute NodeData2;
begin
Result := CompareMethodHeaders(
NodeExt1.Signature,TPascalMethodGroup(NodeExt1.Flags),NodeExt1.ResultType,
NodeExt2.Signature,TPascalMethodGroup(NodeExt2.Flags),NodeExt2.ResultType);
NodeExt1.Txt,TPascalMethodGroup(NodeExt1.Flags),NodeExt1.ResultType,
NodeExt2.Txt,TPascalMethodGroup(NodeExt2.Flags),NodeExt2.ResultType);
end;
@ -629,7 +629,7 @@ function TPascalReaderTool.ExtractProcHead(ProcNode: TCodeTreeNode;
Attr: TProcHeadAttributes): string;
var
TheClassName, s: string;
IsClassName, IsProcType, IsProcedure, IsFunction, IsOperator: Boolean;
IsClassName, IsProcType, IsProcedure, IsFunction, IsOperator, IsGeneric, CanGeneric: Boolean;
EndPos: Integer;
ParentNode: TCodeTreeNode;
OldPos: TAtomPosition;
@ -685,9 +685,13 @@ begin
// parse procedure head = start + name + parameterlist + result type ;
ExtractNextAtom(false,Attr);
// read procedure start keyword
if UpAtomIs('GENERIC') then
if (Scanner.CompilerMode in [cmOBJFPC]) and UpAtomIs('GENERIC') then begin
ExtractNextAtom((phpWithStart in Attr)
and not (phpWithoutClassKeyword in Attr),Attr);
IsGeneric:=true;
end else
IsGeneric:=false;
CanGeneric:=IsGeneric or (Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE]);
if (UpAtomIs('CLASS') or UpAtomIs('STATIC')) then
ExtractNextAtom((phpWithStart in Attr)
and not (phpWithoutClassKeyword in Attr),Attr);
@ -719,17 +723,10 @@ begin
// read classname and name
repeat
ExtractNextAtom(true,Attr);
if Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE] then
begin
// delphi generics
if AtomIsChar('<') then
begin
//writeln('TPascalReaderTool.ExtractProcHead B ',GetAtom);
if not ExtractNextSpecializeParams(not (phpWithoutGenericParams in Attr),Attr) then
exit;
//writeln('TPascalReaderTool.ExtractProcHead C ',GetAtom);
ExtractNextAtom(not (phpWithoutGenericParams in Attr),Attr);
end;
if CanGeneric and AtomIsChar('<') then begin
if not ExtractNextSpecializeParams(not (phpWithoutGenericParams in Attr),Attr) then
exit;
ExtractNextAtom(not (phpWithoutGenericParams in Attr),Attr);
end;
if CurPos.Flag<>cafPoint then break;
ExtractNextAtom(true,Attr);
@ -742,7 +739,7 @@ begin
repeat
OldPos:=CurPos;
ReadNextAtom;
if (Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE]) and AtomIsChar('<') then
if CanGeneric and AtomIsChar('<') then
begin
repeat
ReadNextAtom;
@ -754,7 +751,7 @@ begin
if IsClassName then begin
// read class name
ExtractNextAtom(not (phpWithoutClassName in Attr),Attr);
if (Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE]) and AtomIsChar('<') then
if CanGeneric and AtomIsChar('<') then
begin
if not ExtractNextSpecializeParams(false,Attr) then
exit;
@ -768,7 +765,7 @@ begin
end else begin
// read name
ExtractNextAtom(not (phpWithoutName in Attr),Attr);
if (Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE]) and AtomIsChar('<') then
if CanGeneric and AtomIsChar('<') then
begin
if not ExtractNextSpecializeParams(false,Attr) then
exit;
@ -1040,15 +1037,14 @@ begin
if (not ((phpIgnoreForwards in Attr)
and ((Result.SubDesc and ctnsForwardDeclaration)>0)))
and (not ((phpIgnoreProcsWithBody in Attr)
and (FindProcBody(Result)<>nil)))
and (FindProcBody(Result)<>nil)))
and (not InClass or IdentNodeIsInVisibleClassSection(Result, Visibility))
then
begin
CurProcHead:=ExtractProcHeadWithGroup(Result,Attr);
//DebugLn(['TPascalReaderTool.FindProcNode B "',CurProcHead,'" =? "',AProcHead,'" Result=',CompareTextIgnoringSpace(CurProcHead,AProcHead,false)]);
if (CurProcHead.Name<>'') and
SameMethodHeaders(AProcHead, CurProcHead)
then
//DebugLn(['TPascalReaderTool.FindProcNode B Cur="',dbgs(CurProcHead),'" =? "',dbgs(AProcHead),'" Result=',SameMethodHeaders(AProcHead, CurProcHead)]);
if (CurProcHead.Name<>'')
and SameMethodHeaders(AProcHead, CurProcHead) then
exit;
end;
end;

6
components/codetools/stdcodetools.pas
View File

@ -4818,7 +4818,7 @@ function TStandardCodeTool.GatherPublishedClassElements(
NewNodeExt:=TCodeTreeNodeExtension.Create;
with NewNodeExt do begin
Node:=ANode;
Signature:=CurProcName;
Txt:=CurProcName;
end;
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
end
@ -4827,7 +4827,7 @@ function TStandardCodeTool.GatherPublishedClassElements(
NewNodeExt:=TCodeTreeNodeExtension.Create;
with NewNodeExt do begin
Node:=ANode;
Signature:=CurVarName;
Txt:=CurVarName;
end;
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
end
@ -4836,7 +4836,7 @@ function TStandardCodeTool.GatherPublishedClassElements(
NewNodeExt:=TCodeTreeNodeExtension.Create;
with NewNodeExt do begin
Node:=ANode;
Signature:=CurPropName;
Txt:=CurPropName;
end;
TreeOfCodeTreeNodeExtension.Add(NewNodeExt);
end;

94
components/codetools/tests/testcodecompletion.pas
View File

@ -21,7 +21,9 @@ type
// class completion: add missing method body
procedure TestCompleteMethodBody_GenericObjFPC;
procedure TestCompleteMethodBody_GenericDelphi;
procedure TestCompleteMethodBody_GenericMethod;
procedure TestCompleteMethodBody_GenericMethodObjFPC;
procedure TestCompleteMethodBody_SpecializedFunctionResultObjFPC;
procedure TestCompleteMethodBody_SpecializedFunctionResultDelphi;
procedure TestCompleteMethodBody_GenericFunctionResultObjFPC;
procedure TestCompleteMethodBody_GenericFunctionResultDelphi;
procedure TestCompleteMethodBody_ParamGenericObjFPC;
@ -513,32 +515,32 @@ begin
'end.']);
end;
procedure TTestCodeCompletion.TestCompleteMethodBody_GenericMethod;
procedure TTestCodeCompletion.TestCompleteMethodBody_GenericMethodObjFPC;
begin
Test('TestCompleteMethodBody_GenericMethod',
Test('TestCompleteMethodBody_GenericMethodObjFPC',
['unit test1;',
'{$mode delphi}',
'{$mode objfpc}',
'interface',
'type',
' TBird<T: class> = class',
' TBird = class',
' generic class procedure DoIt<P>(i: P);',
' end;',
'implementation',
'end.'],
6,1,
['unit test1;',
'{$mode delphi}',
'{$mode objfpc}',
'interface',
'type',
'',
' { TBird }',
'',
' TBird<T: class> = class',
' TBird = class',
' generic class procedure DoIt<P>(i: P);',
' end;',
'implementation',
'',
'generic class procedure TBird<T>.DoIt<P>(i: P);',
'generic class procedure TBird.DoIt<P>(i: P);',
'begin',
'',
'end;',
@ -546,9 +548,9 @@ begin
'end.']);
end;
procedure TTestCodeCompletion.TestCompleteMethodBody_GenericFunctionResultObjFPC;
procedure TTestCodeCompletion.TestCompleteMethodBody_SpecializedFunctionResultObjFPC;
begin
Test('TestCompleteMethodBody_GenericFunctionResultObjFPC',
Test('TestCompleteMethodBody_SpecializedFunctionResultObjFPC',
['unit test1;',
'{$mode objfpc}{$H+}',
'interface',
@ -578,9 +580,9 @@ begin
'end.']);
end;
procedure TTestCodeCompletion.TestCompleteMethodBody_GenericFunctionResultDelphi;
procedure TTestCodeCompletion.TestCompleteMethodBody_SpecializedFunctionResultDelphi;
begin
Test('TestCompleteMethodBody_GenericFunctionResultDelphi',
Test('TestCompleteMethodBody_SpecializedFunctionResultDelphi',
['unit test1;',
'{$mode delphi}{$H+}',
'interface',
@ -610,6 +612,74 @@ begin
'end.']);
end;
procedure TTestCodeCompletion.TestCompleteMethodBody_GenericFunctionResultObjFPC;
begin
Test('TestCompleteMethodBody_GenericFunctionResultObjFPC',
['unit test1;',
'{$mode objfpc}{$H+}',
'{$ModeSwitch advancedrecords}',
'interface',
'type',
' TBird = class',
' Generic Function Fly<T> : T;',
' end;',
'implementation',
'end.'],
7,1,
['unit test1;',
'{$mode objfpc}{$H+}',
'{$ModeSwitch advancedrecords}',
'interface',
'type',
'',
' { TBird }',
'',
' TBird = class',
' Generic Function Fly<T> : T;',
' end;',
'implementation',
'',
'generic function TBird.Fly<T>: T;',
'begin',
'end;',
'',
'end.']);
end;
procedure TTestCodeCompletion.TestCompleteMethodBody_GenericFunctionResultDelphi;
begin
Test('TestCompleteMethodBody_GenericFunctionResultDelphi',
['unit test1;',
'{$mode delphi}{$H+}',
'{$ModeSwitch advancedrecords}',
'interface',
'type',
' TBird = record',
' Function Fly<T> : T;',
' end;',
'implementation',
'end.'],
7,1,
['unit test1;',
'{$mode delphi}{$H+}',
'{$ModeSwitch advancedrecords}',
'interface',
'type',
'',
' { TBird }',
'',
' TBird = record',
' Function Fly<T> : T;',
' end;',
'implementation',
'',
'function TBird.Fly<T> : T;',
'begin',
'end;',
'',
'end.']);
end;
procedure TTestCodeCompletion.TestCompleteMethodBody_ParamGenericObjFPC;
begin
Test('TestCompleteMethodBody_ParamGenericObjFPC',

6
components/codetools/tests/testmethodjumptool.pas
View File

@ -322,11 +322,11 @@ begin
'interface',
'type',
' TBird = class',
' generic class procedure {a}DoIt<T>(s: T);',
' class procedure {a}DoIt<T>(s: T);',
' procedure DoIt;',
' end;',
'implementation',
'generic class procedure TBird.{b}Do2It<T>(s: T);',
'class procedure TBird.{b}Do2It<T>(s: T);',
'begin',
'end;',
'procedure TBird.DoIt;',
@ -340,7 +340,7 @@ procedure TTestMethodJumpTool.TestMethodJump_ObjFPCGenericMethod;
begin
Add([
'unit Test1;',
'{$mode delphi}',
'{$mode objfpc}',
'interface',
'type',
' TBird = class',

4
components/codetools/tests/testpascalparser.pas
View File

@ -466,7 +466,7 @@ begin
' TBird<B> = class(TAnimal<B>)',
' procedure DoIt;', // normal proc inside generic class
' procedure DoSome<T>;', // generic proc inside generic class
' generic class procedure DoGen<P>(i: P);',
' class procedure DoGen<P>(i: P);',
' end;',
'procedure TRec.Proc<T>;', // generic proc inside normal record
'begin',
@ -477,7 +477,7 @@ begin
'procedure TBird<B>.DoSome<T>;', // generic proc inside generic class
'begin',
'end;',
'generic class procedure TBird<B>.DoGen<P>(i: P);',
'class procedure TBird<B>.DoGen<P>(i: P);',
'begin',
'end;',
'begin']);