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

codetools: FindAbstractMethods: search class interfaces

Browse Source 
git-svn-id: trunk@45593 -
This commit is contained in:
mattias 2014-06-21 15:35:46 +00:00
parent c300707e90
commit 9ddf3d4196
6 changed files with 246 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/codetools/basiccodetools.pas
View File

@ -1726,7 +1726,8 @@ var
AtomStart: integer;
begin
Result:=FindFirstProcSpecifier(ProcText,NestedComments);
while Result<=length(ProcText) do begin
repeat
if Result>length(ProcText) then exit(-1);
ReadRawNextPascalAtom(ProcText,Result,AtomStart,NestedComments,true);
if AtomStart>length(ProcText) then exit(-1);
if CompareIdentifiers(@ProcText[AtomStart],@Specifier[1])=0 then begin
@ -1738,7 +1739,7 @@ begin
then
exit(-1);
end;
end;
until false;
SpecifierEndPosition:=Result;
while (SpecifierEndPosition<=length(ProcText))
and (ProcText[SpecifierEndPosition]<>';') do begin

1
components/codetools/codecompletiontool.pas
View File

@ -8943,6 +8943,7 @@ begin
if VirtualToOverride then begin
VirtualStartPos:=SearchProcSpecifier(FullProcCode,'virtual',
VirtualEndPos,NewCodeTool.Scanner.NestedComments);
debugln(['TCodeCompletionCodeTool.AddMethods FullProcCode="',FullProcCode,'" VirtualStartPos=',VirtualStartPos]);
if VirtualStartPos>=1 then begin
// replace virtual with override
FullProcCode:=copy(FullProcCode,1,VirtualStartPos-1)

33
components/codetools/finddeclarationtool.pas
View File

@ -26,7 +26,6 @@
ToDo:
- find declaration in dead code (started)
- high type expression evaluation
(i.e. at the moment: integer+integer=longint
wanted: integer+integer=integer)
@ -693,6 +692,7 @@ type
function FindClassMember(aClassNode: TCodeTreeNode; Identifier: PChar): TCodeTreeNode;
function FindForwardIdentifier(Params: TFindDeclarationParams;
var IsForward: boolean): boolean;
function FindNonForwardClass(ForwardNode: TCodeTreeNode): TCodeTreeNode;
function FindNonForwardClass(Params: TFindDeclarationParams): boolean;
function FindCodeToolForUsedUnit(const AnUnitName, AnUnitInFilename: string;
ExceptionOnNotFound: boolean): TFindDeclarationTool;
@ -5918,24 +5918,26 @@ begin
Params.Load(OldInput,true);
end;
function TFindDeclarationTool.FindNonForwardClass(Params: TFindDeclarationParams
): boolean;
function TFindDeclarationTool.FindNonForwardClass(ForwardNode: TCodeTreeNode
): TCodeTreeNode;
var
Node: TCodeTreeNode;
Identifier: PChar;
begin
Result:=false;
Node:=Params.NewNode;
Result:=nil;
Node:=ForwardNode;
if Node.Desc=ctnGenericType then begin
Node:=Node.FirstChild;
if Node=nil then exit;
end else if Node.Desc<>ctnTypeDefinition then
exit;
Node:=Node.FirstChild;
Identifier:=@Src[Node.StartPos];
if (Node=nil)
or (not (Node.Desc in AllClasses))
or ((ctnsForwardDeclaration and Node.SubDesc)=0) then
exit;
Node:=Params.NewNode;
Node:=ForwardNode;
repeat
//DebugLn(['TFindDeclarationTool.FindNonForwardClass Node=',dbgstr(copy(Src,Node.StartPos,20))]);
if Node.NextBrother<>nil then
@ -5952,14 +5954,27 @@ begin
if Node=nil then break;
Node:=Node.FirstChild;
end;
if CompareSrcIdentifiers(Node.StartPos,Params.Identifier) then begin
Params.SetResult(Self,Node,Node.StartPos);
Result:=true;
if CompareSrcIdentifiers(Node.StartPos,Identifier) then begin
Result:=Node;
exit;
end;
until false;
end;
function TFindDeclarationTool.FindNonForwardClass(Params: TFindDeclarationParams
): boolean;
var
Node: TCodeTreeNode;
begin
Node:=FindNonForwardClass(Params.NewNode);
if Node<>nil then begin
Params.SetResult(Self,Node,Node.StartPos);
Result:=true;
end else begin
Result:=false;
end;
end;
function TFindDeclarationTool.FindIdentifierInWithVarContext(
WithVarNode: TCodeTreeNode; Params: TFindDeclarationParams): boolean;
{ this function is internally used by FindIdentifierInContext }

274
components/codetools/identcompletiontool.pas
View File

@ -386,10 +386,6 @@ type
const FoundContext: TFindContext): TIdentifierFoundResult;
procedure AddCollectionContext(Tool: TFindDeclarationTool;
Node: TCodeTreeNode);
procedure InitFoundMethods;
procedure ClearFoundMethods;
function CollectMethods(Params: TFindDeclarationParams;
const FoundContext: TFindContext): TIdentifierFoundResult;
function IsInCompilerDirective(CursorPos: TCodeXYPosition): boolean;
procedure AddCompilerDirectiveMacros(Directive: string);
public
@ -2049,52 +2045,6 @@ begin
//DebugLn('TIdentCompletionTool.AddCollectionContext ',Node.DescAsString,' ',ExtractNode(Node,[]));
end;
procedure TIdentCompletionTool.InitFoundMethods;
begin
if FIDTFoundMethods<>nil then ClearFoundMethods;
FIDTFoundMethods:=TAVLTree.Create(@CompareCodeTreeNodeExt);
end;
procedure TIdentCompletionTool.ClearFoundMethods;
begin
if FIDTFoundMethods=nil then exit;
FreeAndNil(FIDTFoundMethods);
end;
function TIdentCompletionTool.CollectMethods(
Params: TFindDeclarationParams; const FoundContext: TFindContext
): TIdentifierFoundResult;
var
ProcText: String;
AVLNode: TAVLTreeNode;
NodeExt: TCodeTreeNodeExtension;
begin
// proceed searching ...
Result:=ifrProceedSearch;
{$IFDEF ShowFoundIdents}
//if FoundContext.Tool=Self then
DebugLn('::: COLLECT IDENT ',FoundContext.Node.DescAsString,
' "',StringToPascalConst(copy(FoundContext.Tool.Src,FoundContext.Node.StartPos,50)),'"');
{$ENDIF}
if FoundContext.Node.Desc=ctnProcedure then begin
ProcText:=FoundContext.Tool.ExtractProcHead(FoundContext.Node,
[phpWithoutClassKeyword,phpWithHasDefaultValues]);
AVLNode:=FindCodeTreeNodeExtAVLNode(FIDTFoundMethods,ProcText);
if AVLNode<>nil then begin
// method is overriden => ignore
end else begin
// new method
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Node:=FoundContext.Node;
NodeExt.Data:=FoundContext.Tool;
NodeExt.Txt:=ProcText;
FIDTFoundMethods.Add(NodeExt);
end;
end;
end;
function TIdentCompletionTool.IsInCompilerDirective(CursorPos: TCodeXYPosition
): boolean;
var
@ -2873,22 +2823,183 @@ end;
function TIdentCompletionTool.FindAbstractMethods(
const CursorPos: TCodeXYPosition; out ListOfPCodeXYPosition: TFPList;
SkipAbstractsInStartClass: boolean): boolean;
const
ProcAttr = [phpWithoutClassKeyword,phpWithHasDefaultValues];
FlagIsAbstract = 0;
FlagIsImplemented = 1;
var
ImplementedInterfaces: TStringToPointerTree;
SearchedAncestors: TAVLTree;
Procs: TAVLTree; // tree of TCodeTreeNodeExtension
procedure AddProc(ATool: TFindDeclarationTool; ProcNode: TCodeTreeNode;
IsAbstract: boolean);
var
ProcText: String;
AVLNode: TAVLTreeNode;
NodeExt: TCodeTreeNodeExtension;
begin
ProcText:=ATool.ExtractProcHead(ProcNode,ProcAttr);
AVLNode:=FindCodeTreeNodeExtAVLNode(Procs,ProcText);
if AVLNode<>nil then begin
// known proc
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
//debugln(['AddProc "',ProcText,'" WasImplemented=',NodeExt.Flags=1,' IsAbstract=',IsAbstract]);
if NodeExt.Flags=FlagIsImplemented then
exit; // already implemented
if IsAbstract then
exit; // already abstract
NodeExt.Flags:=FlagIsImplemented;
NodeExt.Node:=ProcNode;
NodeExt.Data:=ATool;
end else begin
// new method
//debugln(['AddProc "',ProcText,'" New IsAbstract=',IsAbstract]);
NodeExt:=TCodeTreeNodeExtension.Create;
NodeExt.Node:=ProcNode;
NodeExt.Data:=ATool;
NodeExt.Txt:=ProcText;
if IsAbstract then
NodeExt.Flags:=FlagIsAbstract
else
NodeExt.Flags:=FlagIsImplemented;
Procs.Add(NodeExt);
end;
end;
procedure CollectImplements(ClassNode: TCodeTreeNode);
var
Node: TCodeTreeNode;
StopNode: TCodeTreeNode;
InterfaceName: String;
begin
Node:=ClassNode.FirstChild;
StopNode:=ClassNode.NextSkipChilds;
while Node<>StopNode do begin
if Node.Desc in AllClassBaseSections then begin
Node:=Node.Next;
continue;
end else if Node.Desc=ctnProperty then begin
if PropertyHasSpecifier(Node,'IMPLEMENTS',false) then begin
ReadNextAtom;
while AtomIsIdentifier do begin
InterfaceName:=GetAtom;
ReadNextAtom;
if CurPos.Flag=cafPoint then begin
ReadNextAtom;
AtomIsIdentifierE(true);
InterfaceName+='.'+GetAtom;
ReadNextAtom;
end;
//debugln(['CollectImplements ',InterfaceName]);
ImplementedInterfaces[InterfaceName]:=Node;
if CurPos.Flag<>cafComma then break;
ReadNextAtom;
end;
end;
end else if Node.Desc=ctnProcedure then begin
if ProcNodeHasSpecifier(Node,psABSTRACT) then begin
if not SkipAbstractsInStartClass then
AddProc(Self,Node,true);
end else begin
AddProc(Self,Node,false);
end;
end;
Node:=Node.NextSkipChilds;
end;
end;
procedure CollectAncestors(aTool: TFindDeclarationTool;
ClassNode: TCodeTreeNode; IsStartClass: boolean); forward;
procedure CollectAncestor(ATool: TFindDeclarationTool;
InheritanceNode: TCodeTreeNode; SearchedAncestors: TAVLTree;
IsStartClass: boolean);
var
Params: TFindDeclarationParams;
ClassNode: TCodeTreeNode;
StopNode: TCodeTreeNode;
Node: TCodeTreeNode;
IsInterface: Boolean;
begin
//debugln(['CollectAncestor Ancestor=',ATool.ExtractIdentifierWithPoints(InheritanceNode.StartPos,false)]);
Params:=TFindDeclarationParams.Create;
try
if not ATool.FindAncestorOfClassInheritance(InheritanceNode,Params,true)
then exit;
ATool:=Params.NewCodeTool;
ClassNode:=Params.NewNode;
if SearchedAncestors.Find(ClassNode)<>nil then
exit; // already searched
SearchedAncestors.Add(ClassNode);
// check all procs of this ancestor
StopNode:=ClassNode.NextSkipChilds;
Node:=ClassNode.FirstChild;
IsInterface:=ClassNode.Desc in AllClassInterfaces;
if IsInterface and (not IsStartClass) then
exit;
while Node<>StopNode do begin
if Node.Desc in AllClassBaseSections then begin
Node:=Node.Next;
continue;
end else if Node.Desc=ctnProcedure then begin
if IsInterface
or ATool.ProcNodeHasSpecifier(Node,psABSTRACT) then
AddProc(ATool,Node,true)
else
AddProc(ATool,Node,false);
end;
Node:=Node.NextSkipChilds;
end;
CollectAncestors(ATool,ClassNode,false);
finally
Params.Free;
end;
end;
procedure CollectAncestors(aTool: TFindDeclarationTool;
ClassNode: TCodeTreeNode; IsStartClass: boolean);
var
InheritanceNode: TCodeTreeNode;
AncestorName: String;
Node: TCodeTreeNode;
begin
//debugln(['CollectAncestors of Class=',aTool.ExtractClassName(ClassNode,false)]);
InheritanceNode:=ATool.FindInheritanceNode(ClassNode);
if (InheritanceNode=nil)
or (InheritanceNode.FirstChild=nil) then begin
// no ancestors
exit;
end;
Node:=InheritanceNode.FirstChild;
while Node<>nil do begin
InheritanceNode:=Node;
Node:=Node.NextBrother;
if InheritanceNode.Desc=ctnIdentifier then begin
if IsStartClass then begin
AncestorName:=ATool.ExtractIdentifierWithPoints(InheritanceNode.StartPos,true);
if ImplementedInterfaces.FindNode(AncestorName)<>nil then
continue;
end;
CollectAncestor(ATool,InheritanceNode,SearchedAncestors,IsStartClass);
end;
end;
end;
var
CleanCursorPos: integer;
CursorNode: TCodeTreeNode;
Params: TFindDeclarationParams;
ClassNode: TCodeTreeNode;
AVLNode: TAVLTreeNode;
NodeExt: TCodeTreeNodeExtension;
ATool: TFindDeclarationTool;
ANode: TCodeTreeNode;
ProcXYPos: TCodeXYPosition;
Skip: Boolean;
ClassNode: TCodeTreeNode;
ATool: TFindDeclarationTool;
begin
Result:=false;
ListOfPCodeXYPosition:=nil;
ActivateGlobalWriteLock;
Params:=nil;
ImplementedInterfaces:=nil;
Procs:=nil;
SearchedAncestors:=nil;
try
BuildTreeAndGetCleanPos(trTillCursor,lsrEnd,CursorPos,CleanCursorPos,
[btSetIgnoreErrorPos]);
@ -2903,6 +3014,7 @@ begin
CursorNode:=CursorNode.LastChild
else
CursorNode:=FindClassOrInterfaceNode(CursorNode);
if (CursorNode=nil)
or (not (CursorNode.Desc in AllClassObjects))
or ((CursorNode.SubDesc and ctnsForwardDeclaration)>0) then begin
@ -2911,40 +3023,34 @@ begin
end;
ClassNode:=CursorNode;
Params:=TFindDeclarationParams.Create;
// gather all identifiers in context
Params.ContextNode:=ClassNode;
Params.SetIdentifier(Self,nil,@CollectMethods);
Params.Flags:=[fdfSearchInAncestors,fdfCollect,fdfFindVariable];
InitFoundMethods;
FindIdentifierInContext(Params);
// search class for implemented interfaces and method
ImplementedInterfaces:=TStringToPointerTree.Create(false);
Procs:=TAVLTree.Create(@CompareCodeTreeNodeExt);
CollectImplements(ClassNode);
if FIDTFoundMethods<>nil then begin
AVLNode:=FIDTFoundMethods.FindLowest;
while AVLNode<>nil do begin
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
ANode:=NodeExt.Node;
// search all ancestors
SearchedAncestors:=TAVLTree.Create;
SearchedAncestors.Add(ClassNode);
CollectAncestors(Self,ClassNode,true);
// AddCodePosition for each abstract method
AVLNode:=Procs.FindLowest;
while AVLNode<>nil do begin
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
if NodeExt.Flags=FlagIsAbstract then begin
ATool:=TFindDeclarationTool(NodeExt.Data);
//DebugLn(['TIdentCompletionTool.FindAbstractMethods ',NodeExt.Txt,' ',ATool.ProcNodeHasSpecifier(ANode,psABSTRACT)]);
Skip:=false;
if not ATool.ProcNodeHasSpecifier(ANode,psABSTRACT) then
Skip:=true;
if SkipAbstractsInStartClass and (ANode.HasAsParent(ClassNode)) then
Skip:=true;
if not Skip then begin
if not ATool.CleanPosToCaret(ANode.StartPos,ProcXYPos) then
raise Exception.Create('TIdentCompletionTool.FindAbstractMethods inconsistency');
AddCodePosition(ListOfPCodeXYPosition,ProcXYPos);
end;
AVLNode:=FIDTFoundMethods.FindSuccessor(AVLNode);
if not ATool.CleanPosToCaret(NodeExt.Node.StartPos,ProcXYPos) then
raise Exception.Create('TIdentCompletionTool.FindAbstractMethods inconsistency');
AddCodePosition(ListOfPCodeXYPosition,ProcXYPos);
end;
AVLNode:=Procs.FindSuccessor(AVLNode);
end;
Result:=true;
finally
Params.Free;
ClearFoundMethods;
DeactivateGlobalWriteLock;
DisposeAVLTree(Procs);
ImplementedInterfaces.Free;
SearchedAncestors.Free;
end;
end;

33
components/codetools/pascalreadertool.pas
View File

@ -80,6 +80,8 @@ type
Attr: TProcHeadAttributes): string;
function ExtractBrackets(BracketStartPos: integer;
Attr: TProcHeadAttributes): string;
function ExtractIdentifierWithPoints(StartPos: integer;
ExceptionOnError: boolean): string;
function ExtractIdentCharsFromStringConstant(
StartPos, MinPos, MaxPos, MaxLen: integer): string;
function ReadStringConstantValue(StartPos: integer): string;
@ -112,7 +114,7 @@ type
function PropertyNodeHasParamList(PropNode: TCodeTreeNode): boolean;
function PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean;
function PropertyHasSpecifier(PropNode: TCodeTreeNode;
s: string; ExceptionOnNotFound: boolean = true): boolean;
UpperKeyword: string; ExceptionOnNotFound: boolean = true): boolean;
// procs
function ExtractProcName(ProcNode: TCodeTreeNode;
@ -1392,6 +1394,24 @@ begin
Result:=GetExtraction(phpInUpperCase in Attr);
end;
function TPascalReaderTool.ExtractIdentifierWithPoints(StartPos: integer;
ExceptionOnError: boolean): string;
begin
Result:='';
MoveCursorToCleanPos(StartPos);
ReadNextAtom;
if not AtomIsIdentifierE(ExceptionOnError) then exit;
Result:=GetAtom;
repeat
ReadNextAtom;
if CurPos.Flag<>cafPoint then
exit;
ReadNextAtom;
if not AtomIsIdentifierE(ExceptionOnError) then exit;
Result+='.'+GetAtom;
until false;
end;
function TPascalReaderTool.ExtractPropName(PropNode: TCodeTreeNode;
InUpperCase: boolean): string;
begin
@ -2867,7 +2887,8 @@ begin
end;
function TPascalReaderTool.PropertyHasSpecifier(PropNode: TCodeTreeNode;
s: string; ExceptionOnNotFound: boolean): boolean;
UpperKeyword: string; ExceptionOnNotFound: boolean): boolean;
// true if cursor is on keyword
begin
// ToDo: ppu, dcu
@ -2892,12 +2913,12 @@ begin
end;
end;
s:=UpperCaseStr(s);
UpperKeyword:=UpperCaseStr(UpperKeyword);
// read specifiers
while not (CurPos.Flag in [cafSemicolon,cafNone]) do begin
if WordIsPropertySpecifier.DoIdentifier(@Src[CurPos.StartPos])
then begin
if UpAtomIs(s) then exit(true);
if UpAtomIs(UpperKeyword) then exit(true);
end else if CurPos.Flag=cafEdgedBracketOpen then begin
if not ReadTilBracketClose(ExceptionOnNotFound) then exit;
ReadNextAtom;
@ -2909,9 +2930,9 @@ begin
ReadNextAtom;
if UpAtomIs('DEFAULT') or UpAtomIs('NODEFAULT') or UpAtomIs('DEPRECATED')
then begin
if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(s))=0 then exit(true);
if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(UpperKeyword))=0 then exit(true);
end else if UpAtomIs('ENUMERATOR') then begin
if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(s))=0 then exit(true);
if CompareIdentifierPtrs(@Src[CurPos.StartPos],Pointer(UpperKeyword))=0 then exit(true);
ReadNextAtom;
if not AtomIsIdentifier then exit;
end else

2
ide/abstractsmethodsdlg.pas
View File

@ -117,7 +117,7 @@ begin
// check cursor is in a class
if not CodeToolBoss.FindAbstractMethods(Code,Caret.X,Caret.Y,
ListOfPCodeXYPosition,false) then
ListOfPCodeXYPosition,true) then
begin
DebugLn(['ShowAbstractMethodsDialog CodeToolBoss.FindAbstractMethods failed']);
if CodeToolBoss.ErrorMessage<>'' then begin