codetools: added function to find empty method bodies

git-svn-id: trunk@14969 -
This commit is contained in:
mattias 2008-04-25 12:11:17 +00:00
parent 0a4bef06a1
commit cc954306a9
9 changed files with 462 additions and 4 deletions

4
.gitattributes vendored
View File

@ -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

View File

@ -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);

View File

@ -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

View File

@ -51,6 +51,7 @@ type
pcsPublic,
pcsPublished
);
TPascalClassSections = set of TPascalClassSection;
{ TCodeXYPositions - a list of PCodeXYPosition }

View 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

View 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>

View 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.

View 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.

View File

@ -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,