mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 20:59:36 +02:00
codetools: added function to find empty method bodies
git-svn-id: trunk@14969 -
This commit is contained in:
parent
0a4bef06a1
commit
cc954306a9
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -85,6 +85,7 @@ components/codetools/definetemplates.pas svneol=native#text/pascal
|
||||
components/codetools/directivestree.pas svneol=native#text/plain
|
||||
components/codetools/directorycacher.pas svneol=native#text/plain
|
||||
components/codetools/eventcodetool.pas svneol=native#text/pascal
|
||||
components/codetools/examples/README.txt svneol=native#text/plain
|
||||
components/codetools/examples/addclass.lpi svneol=native#text/plain
|
||||
components/codetools/examples/addclass.lpr svneol=native#text/plain
|
||||
components/codetools/examples/addeventmethod.lpi svneol=native#text/plain
|
||||
@ -115,6 +116,8 @@ components/codetools/examples/methodjumping.lpi svneol=native#text/plain
|
||||
components/codetools/examples/methodjumping.pas svneol=native#text/plain
|
||||
components/codetools/examples/reduceifdefs.lpi svneol=native#text/plain
|
||||
components/codetools/examples/reduceifdefs.lpr svneol=native#text/plain
|
||||
components/codetools/examples/removeemptymethods.lpi svneol=native#text/plain
|
||||
components/codetools/examples/removeemptymethods.lpr svneol=native#text/plain
|
||||
components/codetools/examples/replaceresourcedirectives.lpi svneol=native#text/plain
|
||||
components/codetools/examples/replaceresourcedirectives.lpr svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/BigLettersUnit.pas svneol=native#text/plain
|
||||
@ -124,6 +127,7 @@ components/codetools/examples/scanexamples/brokenfilenames.pas svneol=native#tex
|
||||
components/codetools/examples/scanexamples/brokenincfiles.inc svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/completion1.pas svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/empty.inc svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/emptymethods1.pas svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/getcontextexample.pas svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/identcomplexample.pas svneol=native#text/plain
|
||||
components/codetools/examples/scanexamples/missingh2pasdirectives.pas svneol=native#text/plain
|
||||
|
@ -97,12 +97,19 @@ const
|
||||
NewClassPartProcs = [ncpPrivateProcs,ncpProtectedProcs,ncpPublicProcs,ncpPublishedProcs];
|
||||
NewClassPartVars = [ncpPrivateVars,ncpProtectedVars,ncpPublicVars,ncpPublishedVars];
|
||||
|
||||
NewClassPartVisibilty: array[TNewClassPart] of TPascalClassSection = (
|
||||
NewClassPartVisibility: array[TNewClassPart] of TPascalClassSection = (
|
||||
pcsPrivate, pcsPrivate,
|
||||
pcsProtected, pcsProtected,
|
||||
pcsPublic, pcsPublic,
|
||||
pcsPublished, pcsPublished
|
||||
);
|
||||
|
||||
PascalClassSectionToNodeDesc: array[TPascalClassSection] of TCodeTreeNodeDesc = (
|
||||
ctnClassPrivate, // pcsPrivate
|
||||
ctnClassProtected, // pcsProtected
|
||||
ctnClassPublic, // pcsPublic
|
||||
ctnClassPublished // pcsPublished
|
||||
);
|
||||
|
||||
type
|
||||
TCodeCompletionCodeTool = class;
|
||||
@ -233,6 +240,15 @@ type
|
||||
out DefinitionsTreeOfCodeTreeNodeExt: TAVLTree;
|
||||
out Graph: TCodeGraph; OnlyInterface: boolean): boolean;
|
||||
procedure WriteCodeGraphDebugReport(Graph: TCodeGraph);
|
||||
function FindEmptyMethods(CursorPos: TCodeXYPosition;
|
||||
const Sections: TPascalClassSections;
|
||||
ListOfPCodeXYPosition: TFPList): boolean;
|
||||
function FindEmptyMethods(CursorPos: TCodeXYPosition;
|
||||
const Sections: TPascalClassSections;
|
||||
CodeTreeNodeExtensions: TAVLTree): boolean;
|
||||
function RemoveEmptyMethods(CursorPos: TCodeXYPosition;
|
||||
const Sections: TPascalClassSections;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
|
||||
// custom class completion
|
||||
function InitClassCompletion(const UpperClassName: string;
|
||||
@ -325,7 +341,12 @@ procedure TCodeCompletionCodeTool.SetCodeCompleteClassNode(
|
||||
const AClassNode: TCodeTreeNode);
|
||||
begin
|
||||
FreeClassInsertionList;
|
||||
FJumpToProcName:='';
|
||||
FCodeCompleteClassNode:=AClassNode;
|
||||
if FCodeCompleteClassNode=nil then begin
|
||||
FCompletingStartNode:=nil;
|
||||
exit;
|
||||
end;
|
||||
BuildSubTreeForClass(FCodeCompleteClassNode);
|
||||
if FCodeCompleteClassNode.Desc=ctnClassInterface then
|
||||
FCompletingStartNode:=FCodeCompleteClassNode
|
||||
@ -335,7 +356,6 @@ begin
|
||||
FCompletingStartNode:=FCompletingStartNode.NextBrother;
|
||||
if FCompletingStartNode<>nil then
|
||||
FCompletingStartNode:=FCompletingStartNode.FirstChild;
|
||||
FJumpToProcName:='';
|
||||
end;
|
||||
|
||||
procedure TCodeCompletionCodeTool.SetCodeCompleteSrcChgCache(
|
||||
@ -3989,6 +4009,134 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeCompletionCodeTool.FindEmptyMethods(CursorPos: TCodeXYPosition;
|
||||
const Sections: TPascalClassSections; ListOfPCodeXYPosition: TFPList
|
||||
): boolean;
|
||||
var
|
||||
ProcBodyNodes: TAVLTree;
|
||||
AVLNode: TAVLTreeNode;
|
||||
NodeExt: TCodeTreeNodeExtension;
|
||||
Caret: TCodeXYPosition;
|
||||
CaretP: PCodeXYPosition;
|
||||
begin
|
||||
Result:=false;
|
||||
ProcBodyNodes:=TAVLTree.Create(@CompareCodeTreeNodeExt);
|
||||
try
|
||||
Result:=FindEmptyMethods(CursorPos,Sections,ProcBodyNodes);
|
||||
if Result then begin
|
||||
AVLNode:=ProcBodyNodes.FindLowest;
|
||||
while AVLNode<>nil do begin
|
||||
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
|
||||
if CleanPosToCaret(NodeExt.Node.StartPos,Caret) then begin
|
||||
New(CaretP);
|
||||
CaretP^:=Caret;
|
||||
ListOfPCodeXYPosition.Add(CaretP);
|
||||
end;
|
||||
AVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
|
||||
end;
|
||||
end;
|
||||
Result:=true;
|
||||
finally
|
||||
ProcBodyNodes.FreeAndClear;
|
||||
ProcBodyNodes.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeCompletionCodeTool.FindEmptyMethods(CursorPos: TCodeXYPosition;
|
||||
const Sections: TPascalClassSections; CodeTreeNodeExtensions: TAVLTree
|
||||
): boolean;
|
||||
var
|
||||
CleanCursorPos: integer;
|
||||
CursorNode: TCodeTreeNode;
|
||||
TypeSectionNode: TCodeTreeNode;
|
||||
ProcBodyNodes, ClassProcs: TAVLTree;
|
||||
AVLNode: TAVLTreeNode;
|
||||
NodeExt: TCodeTreeNodeExtension;
|
||||
NextAVLNode: TAVLTreeNode;
|
||||
DefAVLNode: TAVLTreeNode;
|
||||
DefNodeExt: TCodeTreeNodeExtension;
|
||||
Desc: TCodeTreeNodeDesc;
|
||||
Fits: Boolean;
|
||||
s: TPascalClassSection;
|
||||
|
||||
procedure GatherClassProcs;
|
||||
begin
|
||||
// gather existing proc definitions in the class
|
||||
if ClassProcs=nil then begin
|
||||
ClassProcs:=GatherProcNodes(FCompletingStartNode,
|
||||
[phpInUpperCase,phpAddClassName],
|
||||
ExtractClassName(FCodeCompleteClassNode,true));
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result:=false;
|
||||
BuildTreeAndGetCleanPos(trAll,CursorPos,CleanCursorPos,[]);
|
||||
CursorNode:=FindDeepestNodeAtPos(CleanCursorPos,true);
|
||||
CodeCompleteClassNode:=FindClassNode(CursorNode);
|
||||
if FCodeCompleteClassNode=nil then begin
|
||||
DebugLn(['TCodeCompletionCodeTool.FindEmptyMethods no class at ',DbgsCXY(CursorPos)]);
|
||||
exit;
|
||||
end;
|
||||
ProcBodyNodes:=nil;
|
||||
ClassProcs:=nil;
|
||||
try
|
||||
// gather body nodes
|
||||
TypeSectionNode:=FCodeCompleteClassNode.GetNodeOfType(ctnTypeSection);
|
||||
ProcBodyNodes:=GatherProcNodes(TypeSectionNode,
|
||||
[phpInUpperCase,phpIgnoreForwards,phpOnlyWithClassname],
|
||||
ExtractClassName(FCodeCompleteClassNode,true));
|
||||
// collect all emtpy bodies
|
||||
AVLNode:=ProcBodyNodes.FindLowest;
|
||||
while AVLNode<>nil do begin
|
||||
NextAVLNode:=ProcBodyNodes.FindSuccessor(AVLNode);
|
||||
NodeExt:=TCodeTreeNodeExtension(AVLNode.Data);
|
||||
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;
|
||||
// search the corresponding node in the class
|
||||
DefAVLNode:=ClassProcs.Find(NodeExt);
|
||||
if (DefAVLNode<>nil) then begin
|
||||
DefNodeExt:=TCodeTreeNodeExtension(DefAVLNode.Data);
|
||||
// check visibility section
|
||||
if (DefNodeExt.Node.Parent<>nil) then begin
|
||||
Desc:=DefNodeExt.Node.Parent.Desc;
|
||||
Fits:=false;
|
||||
for s:=Low(TPascalClassSection) to High(TPascalClassSection) do
|
||||
if (s in Sections) and (PascalClassSectionToNodeDesc[s]=Desc) then
|
||||
Fits:=true;
|
||||
if Fits then begin
|
||||
// empty and right section => add to tree
|
||||
ProcBodyNodes.Delete(AVLNode);
|
||||
CodeTreeNodeExtensions.Add(NodeExt);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
AVLNode:=NextAVLNode;
|
||||
end;
|
||||
Result:=true;
|
||||
finally
|
||||
if ClassProcs<>nil then begin
|
||||
ClassProcs.FreeAndClear;
|
||||
ClassProcs.Free;
|
||||
end;
|
||||
if ProcBodyNodes<>nil then begin
|
||||
ProcBodyNodes.FreeAndClear;
|
||||
ProcBodyNodes.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeCompletionCodeTool.RemoveEmptyMethods(CursorPos: TCodeXYPosition;
|
||||
const Sections: TPascalClassSections; SourceChangeCache: TSourceChangeCache
|
||||
): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
// ToDo
|
||||
end;
|
||||
|
||||
function TCodeCompletionCodeTool.InitClassCompletion(
|
||||
const UpperClassName: string;
|
||||
SourceChangeCache: TSourceChangeCache): boolean;
|
||||
@ -4591,7 +4739,7 @@ var ANodeExt: TCodeTreeNodeExtension;
|
||||
Visibility: TPascalClassSection;
|
||||
begin
|
||||
ANodeExt:=FirstInsert;
|
||||
Visibility:=NewClassPartVisibilty[PartType];
|
||||
Visibility:=NewClassPartVisibility[PartType];
|
||||
// insert all nodes of specific type
|
||||
while ANodeExt<>nil do begin
|
||||
IsVariable:=NodeExtIsVariable(ANodeExt);
|
||||
|
@ -472,6 +472,11 @@ type
|
||||
TreeOfCodeTreeNodeExt: TAVLTree): boolean;
|
||||
function ReplaceAllTypeCastFunctions(Code: TCodeBuffer): boolean;
|
||||
function FixForwardDefinitions(Code: TCodeBuffer): boolean;
|
||||
function FindEmptyMethods(Code: TCodeBuffer; X,Y: integer;
|
||||
const Sections: TPascalClassSections;
|
||||
ListOfPCodeXYPosition: TFPList): boolean;
|
||||
function RemoveEmptyMethods(Code: TCodeBuffer; X,Y: integer;
|
||||
const Sections: TPascalClassSections): boolean;
|
||||
|
||||
// custom class completion
|
||||
function InitClassCompletion(Code: TCodeBuffer;
|
||||
@ -3312,6 +3317,48 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.FindEmptyMethods(Code: TCodeBuffer; X, Y: integer;
|
||||
const Sections: TPascalClassSections; ListOfPCodeXYPosition: TFPList
|
||||
): boolean;
|
||||
var
|
||||
CursorPos: TCodeXYPosition;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeToolManager.FindEmptyMethods A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
Result:=false;
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
CursorPos.X:=X;
|
||||
CursorPos.Y:=Y;
|
||||
CursorPos.Code:=Code;
|
||||
try
|
||||
Result:=FCurCodeTool.FindEmptyMethods(CursorPos,Sections,
|
||||
ListOfPCodeXYPosition);
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.RemoveEmptyMethods(Code: TCodeBuffer; X,Y: integer;
|
||||
const Sections: TPascalClassSections): boolean;
|
||||
var
|
||||
CursorPos: TCodeXYPosition;
|
||||
begin
|
||||
{$IFDEF CTDEBUG}
|
||||
DebugLn('TCodeToolManager.RemoveEmptyMethods A ',Code.Filename);
|
||||
{$ENDIF}
|
||||
Result:=false;
|
||||
if not InitCurCodeTool(Code) then exit;
|
||||
CursorPos.X:=X;
|
||||
CursorPos.Y:=Y;
|
||||
CursorPos.Code:=Code;
|
||||
try
|
||||
Result:=FCurCodeTool.RemoveEmptyMethods(CursorPos,Sections,SourceChangeCache);
|
||||
except
|
||||
on e: Exception do Result:=HandleException(e);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeToolManager.InitClassCompletion(Code: TCodeBuffer;
|
||||
const UpperClassName: string; out CodeTool: TCodeTool): boolean;
|
||||
begin
|
||||
|
@ -51,6 +51,7 @@ type
|
||||
pcsPublic,
|
||||
pcsPublished
|
||||
);
|
||||
TPascalClassSections = set of TPascalClassSection;
|
||||
|
||||
{ TCodeXYPositions - a list of PCodeXYPosition }
|
||||
|
||||
|
38
components/codetools/examples/README.txt
Normal file
38
components/codetools/examples/README.txt
Normal file
@ -0,0 +1,38 @@
|
||||
Examples for the CodeTools
|
||||
|
||||
Some basic examples run out of the box.
|
||||
Some examples require the path of the FPC sources, which can be given via the
|
||||
environment variable FPCDIR.
|
||||
If you see an error message like this:
|
||||
|
||||
Scanning FPC sources may take a while ...
|
||||
TDefinePool.CreateFPCSrcTemplate FPCSrcDir does not exist: ...
|
||||
|
||||
Then you must set the FPCDIR variable and start the example again. For example:
|
||||
Under linux:
|
||||
export FPCDIR=/home/username/freepascal/fpc
|
||||
|
||||
For instance the FPC 2.2.0 source directory looks like this:
|
||||
compiler
|
||||
fv
|
||||
ide
|
||||
installer
|
||||
Makefile
|
||||
Makefile.fpc
|
||||
packages
|
||||
rtl
|
||||
tests
|
||||
utils
|
||||
|
||||
See here for more information:
|
||||
http://wiki.lazarus.freepascal.org/Installing_Lazarus#FPC_Sources
|
||||
|
||||
The examples will scan the directories and store the result in a file named
|
||||
'codetools.config'. So the next time you start any of the examples it does
|
||||
not need to scan.
|
||||
|
||||
List of environment variables:
|
||||
FPCDIR = path to FPC source directory
|
||||
PP = path of the Free Pascal compiler. For example /usr/bin/ppc386.
|
||||
LAZARUSDIR = path of the lazarus sources
|
||||
|
58
components/codetools/examples/removeemptymethods.lpi
Normal file
58
components/codetools/examples/removeemptymethods.lpi
Normal file
@ -0,0 +1,58 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="/"/>
|
||||
<Version Value="6"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=""/>
|
||||
<Title Value="finddeclaration"/>
|
||||
</General>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="CodeTools"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="removeemptymethods.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="RemoveEmptyMethods"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="scanexamples/emptymethods1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="EmptyMethods1"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="README.txt"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="scanexamples/"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
90
components/codetools/examples/removeemptymethods.lpr
Normal file
90
components/codetools/examples/removeemptymethods.lpr
Normal file
@ -0,0 +1,90 @@
|
||||
{
|
||||
***************************************************************************
|
||||
* *
|
||||
* This source is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU General Public License as published by *
|
||||
* the Free Software Foundation; either version 2 of the License, or *
|
||||
* (at your option) any later version. *
|
||||
* *
|
||||
* This code is distributed in the hope that it will be useful, but *
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
||||
* General Public License for more details. *
|
||||
* *
|
||||
* A copy of the GNU General Public License is available on the World *
|
||||
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
|
||||
Author: Mattias Gaertner
|
||||
|
||||
Abstract:
|
||||
Simple demonstration, how to setup the codetools, FPC and Lazarus Source
|
||||
directory to remove empty methods.
|
||||
}
|
||||
program RemoveEmptyMethods;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, CodeCache, CodeToolManager, DefineTemplates,
|
||||
CodeAtom, CodeToolsConfig, CodeToolsStructs, EmptyMethods1;
|
||||
|
||||
const
|
||||
ConfigFilename = 'codetools.config';
|
||||
var
|
||||
Code: TCodeBuffer;
|
||||
X: Integer;
|
||||
Y: Integer;
|
||||
Filename: String;
|
||||
ListOfPCodeXYPosition: TFPList;
|
||||
i: Integer;
|
||||
P: PCodeXYPosition;
|
||||
begin
|
||||
if (ParamCount>=1) and (Paramcount<>3) then begin
|
||||
writeln('Usage:');
|
||||
writeln(' ',ParamStr(0));
|
||||
writeln(' ',ParamStr(0),' <filename> <X> <Y>');
|
||||
end;
|
||||
|
||||
try
|
||||
CodeToolBoss.SimpleInit(ConfigFilename);
|
||||
|
||||
X:=10;
|
||||
Y:=16;
|
||||
Filename:=ExpandFileName('scanexamples'+PathDelim+'emptymethods1.pas');
|
||||
|
||||
if (ParamCount>=3) then begin
|
||||
Filename:=ExpandFileName(ParamStr(1));
|
||||
X:=StrToInt(ParamStr(2));
|
||||
Y:=StrToInt(ParamStr(3));
|
||||
end;
|
||||
|
||||
// Step 1: load the file
|
||||
Code:=CodeToolBoss.LoadFile(Filename,false,false);
|
||||
if Code=nil then
|
||||
raise Exception.Create('loading failed '+Filename);
|
||||
|
||||
// complete code
|
||||
ListOfPCodeXYPosition:=TFPList.Create;
|
||||
if CodeToolBoss.FindEmptyMethods(Code,X,Y,[pcsPublished],
|
||||
ListOfPCodeXYPosition)
|
||||
then begin
|
||||
writeln('Found ',ListOfPCodeXYPosition.Count,' empty methods:');
|
||||
for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
|
||||
P:=PCodeXYPosition(ListOfPCodeXYPosition[i]);
|
||||
writeln(i,' ',DbgsCXY(P^));
|
||||
end;
|
||||
end else begin
|
||||
writeln('FindEmptyMethods failed: ',CodeToolBoss.ErrorMessage);
|
||||
end;
|
||||
CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
|
||||
except
|
||||
on E: Exception do begin
|
||||
writeln('EXCEPTION: '+E.Message);
|
||||
end;
|
||||
end;
|
||||
end.
|
||||
|
35
components/codetools/examples/scanexamples/emptymethods1.pas
Normal file
35
components/codetools/examples/scanexamples/emptymethods1.pas
Normal file
@ -0,0 +1,35 @@
|
||||
unit EmptyMethods1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TSmallDirtyClass }
|
||||
|
||||
TSmallDirtyClass = class(TPersistent)
|
||||
published
|
||||
procedure DoSomething;
|
||||
end;
|
||||
|
||||
TDirtyClass = class(TPersistent)
|
||||
published
|
||||
private
|
||||
public
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TSmallDirtyClass }
|
||||
|
||||
procedure TSmallDirtyClass.DoSomething;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -98,6 +98,7 @@ type
|
||||
function FindCorrespondingProcNode(ProcNode: TCodeTreeNode;
|
||||
Attr: TProcHeadAttributes): TCodeTreeNode;
|
||||
function FindProcBody(ProcNode: TCodeTreeNode): TCodeTreeNode;
|
||||
function ProcBodyIsEmpty(ProcNode: TCodeTreeNode): boolean;
|
||||
procedure MoveCursorToFirstProcSpecifier(ProcNode: TCodeTreeNode);
|
||||
function MoveCursorToProcSpecifier(ProcNode: TCodeTreeNode;
|
||||
ProcSpec: TProcedureSpecifier): boolean;
|
||||
@ -610,7 +611,7 @@ begin
|
||||
StartNode:=ClassNode.GetNodeOfType(ctnTypeSection)
|
||||
end else if NodeIsMethodBody(ProcNode) then begin
|
||||
//debugln('TPascalReaderTool.FindCorrespondingProcNode Method');
|
||||
// in a method body -> search class
|
||||
// in a method body -> search in class
|
||||
StartNode:=FindClassNodeInUnit(ExtractClassNameOfProcNode(ProcNode),true,
|
||||
false,false,true);
|
||||
BuildSubTreeForClass(StartNode);
|
||||
@ -645,6 +646,7 @@ function TPascalReaderTool.FindProcBody(ProcNode: TCodeTreeNode
|
||||
begin
|
||||
Result:=ProcNode;
|
||||
if Result=nil then exit;
|
||||
if Result.Desc<>ctnProcedure then exit;
|
||||
Result:=Result.FirstChild;
|
||||
while Result<>nil do begin
|
||||
if Result.Desc in [ctnBeginBlock,ctnAsmBlock] then
|
||||
@ -653,6 +655,41 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPascalReaderTool.ProcBodyIsEmpty(ProcNode: TCodeTreeNode): boolean;
|
||||
var
|
||||
BodyNode: TCodeTreeNode;
|
||||
LastPos: LongInt;
|
||||
begin
|
||||
Result:=false;
|
||||
BodyNode:=FindProcBody(ProcNode);
|
||||
if (BodyNode=nil) then exit;
|
||||
// check if there are nodes in front (e.g. local variables)
|
||||
if (BodyNode.PriorBrother<>nil)
|
||||
and (BodyNode.PriorBrother.Desc<>ctnProcedureHead) then
|
||||
exit;
|
||||
// check if there are child nodes
|
||||
if BodyNode.FirstChild<>nil then exit;
|
||||
// check if bodynode is only 'asm end' or 'begin end'
|
||||
// not even a comment should be there, only spaces are allowed
|
||||
if ProcNode.FirstChild.Desc<>ctnProcedureHead then exit;
|
||||
MoveCursorToCleanPos(ProcNode.FirstChild.EndPos);
|
||||
LastPos:=CurPos.EndPos;
|
||||
ReadNextAtom;
|
||||
if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
|
||||
if CurPos.Flag=cafSemicolon then begin
|
||||
// semicolon is allowed
|
||||
LastPos:=CurPos.EndPos;
|
||||
ReadNextAtom;
|
||||
if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
|
||||
end;
|
||||
if not (UpAtomIs('ASM') or UpAtomIs('BEGIN')) then exit;
|
||||
LastPos:=CurPos.EndPos;
|
||||
ReadNextAtom;
|
||||
if FindNextNonSpace(Src,LastPos)<>CurPos.StartPos then exit;
|
||||
if not UpAtomIs('END') then exit;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
procedure TPascalReaderTool.MoveCursorToFirstProcSpecifier(
|
||||
ProcNode: TCodeTreeNode);
|
||||
// After the call,
|
||||
|
Loading…
Reference in New Issue
Block a user