diff --git a/.gitattributes b/.gitattributes index e431b6b1bd..84d4bd85e1 100644 --- a/.gitattributes +++ b/.gitattributes @@ -185,6 +185,7 @@ components/codetools/multikeywordlisttool.pas svneol=native#text/pascal components/codetools/nonpascalcodetools.pas svneol=native#text/plain components/codetools/pascalparsertool.pas svneol=native#text/pascal components/codetools/pascalreadertool.pas svneol=native#text/pascal +components/codetools/ppugraph.pas svneol=native#text/plain components/codetools/ppuparser.pas svneol=native#text/plain components/codetools/resourcecodetool.pas svneol=native#text/pascal components/codetools/sourcechanger.pas svneol=native#text/pascal diff --git a/components/codetools/allcodetoolunits.pp b/components/codetools/allcodetoolunits.pp index 250d003ab0..77feaf4559 100644 --- a/components/codetools/allcodetoolunits.pp +++ b/components/codetools/allcodetoolunits.pp @@ -24,7 +24,7 @@ uses CodeCache, KeywordFuncLists, SourceLog, ExprEval, DefineTemplates, FileProcs, CodeToolsStrConsts, DirectoryCacher, CCodeParserTool, H2PasTool, MultiKeyWordListTool, ResourceCodeTool, CodeToolsStructs, CacheCodeTools, - PPUParser, + PPUParser, PPUGraph, // fast xml units, changes not merged in current fpc Laz_DOM, Laz_XMLCfg, Laz_XMLRead, Laz_XMLWrite, Laz_XMLStreaming; diff --git a/components/codetools/codegraph.pas b/components/codetools/codegraph.pas index b9ac470fa0..7b9f42642d 100644 --- a/components/codetools/codegraph.pas +++ b/components/codetools/codegraph.pas @@ -123,12 +123,12 @@ type end; function CompareGraphNodeByNode(GraphNode1, GraphNode2: Pointer): integer; -function ComparePointerWithGraphNodeNode(p, GraphNode: Pointer): integer; +function CompareNodeWithGraphNodeNode(p, GraphNode: Pointer): integer; function CompareGraphEdgeByFromNode(GraphEdge1, GraphEdge2: Pointer): integer; -function ComparePointerWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer; +function CompareNodeWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer; function CompareGraphEdgeByToNode(GraphEdge1, GraphEdge2: Pointer): integer; -function ComparePointerWithGraphEdgeToNode(p, GraphEdge: Pointer): integer; +function CompareNodeWithGraphEdgeToNode(p, GraphEdge: Pointer): integer; function CompareGraphEdgeByNodes(GraphEdge1, GraphEdge2: Pointer): integer; function CompareEdgeKeyWithGraphEdge(EdgeKey, GraphEdge: Pointer): integer; @@ -151,7 +151,7 @@ begin //DebugLn(['CompareGraphNodeByNode ',Node1.DescAsString,' ',Node2.DescAsString,' ',Result]); end; -function ComparePointerWithGraphNodeNode(p, GraphNode: Pointer): integer; +function CompareNodeWithGraphNodeNode(p, GraphNode: Pointer): integer; var Node: TCodeTreeNode; begin @@ -180,7 +180,7 @@ begin Result:=0; end; -function ComparePointerWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer; +function CompareNodeWithGraphEdgeFromNode(p, GraphEdge: Pointer): integer; var Node: TCodeTreeNode; begin @@ -208,7 +208,7 @@ begin Result:=0; end; -function ComparePointerWithGraphEdgeToNode(p, GraphEdge: Pointer): integer; +function CompareNodeWithGraphEdgeToNode(p, GraphEdge: Pointer): integer; var Node: TCodeTreeNode; begin @@ -382,6 +382,8 @@ var begin if Source=Self then exit; Clear; + FNodeClass:=Source.FNodeClass; + FEdgeClass:=Source.FEdgeClass; // copy nodes AVLNode:=Source.Nodes.FindLowest; while AVLNode<>nil do begin @@ -841,14 +843,14 @@ end; function TCodeGraph.FindAVLNodeOfNode(Node: TCodeTreeNode): TAVLTreeNode; begin - Result:=Nodes.FindKey(Node,@ComparePointerWithGraphNodeNode); + Result:=Nodes.FindKey(Node,@CompareNodeWithGraphNodeNode); end; function TCodeGraph.FindAVLNodeOfToNode(InTree: TAVLTree; ToNode: TCodeTreeNode ): TAVLTreeNode; begin if InTree<>nil then - Result:=InTree.FindKey(ToNode,@ComparePointerWithGraphEdgeToNode) + Result:=InTree.FindKey(ToNode,@CompareNodeWithGraphEdgeToNode) else Result:=nil; end; @@ -857,7 +859,7 @@ function TCodeGraph.FindAVLNodeOfFromNode(OutTree: TAVLTree; FromNode: TCodeTreeNode): TAVLTreeNode; begin if OutTree<>nil then - Result:=OutTree.FindKey(FromNode,@ComparePointerWithGraphEdgeFromNode) + Result:=OutTree.FindKey(FromNode,@CompareNodeWithGraphEdgeFromNode) else Result:=nil; end; diff --git a/components/codetools/examples/ppudependencies.lpr b/components/codetools/examples/ppudependencies.lpr index a926285107..53d1d7013b 100644 --- a/components/codetools/examples/ppudependencies.lpr +++ b/components/codetools/examples/ppudependencies.lpr @@ -28,39 +28,34 @@ program PPUDependencies; {$mode objfpc}{$H+} uses - Classes, SysUtils, PPUParser, FileProcs; + Classes, SysUtils, PPUParser, FileProcs, PPUGraph; var - PPU: TPPU; Filename: String; - UsedUnits: TStringList; + Groups: TPPUGroups; + Group: TPPUGroup; + i: Integer; + Member: TPPUMember; begin if (Paramcount<1) then begin writeln('Usage:'); - writeln(' ',ParamStr(0),' '); + writeln(' ',ParamStr(0),' ...'); Halt; end; - - Filename:=ParamStr(1); - - PPU:=TPPU.Create; - UsedUnits:=TStringList.Create; + + Groups:=TPPUGroups.Create; try - PPU.LoadFromFile(Filename); - debugln('================================================================'); - PPU.Dump(''); - debugln('================================================================'); - UsedUnits.Clear; - PPU.GetMainUsesSectionNames(UsedUnits); - debugln('Main used units: ',UsedUnits.DelimitedText); - UsedUnits.Clear; - PPU.GetImplementationUsesSectionNames(UsedUnits); - debugln('Implementation used units: ',UsedUnits.DelimitedText); - debugln('Intialization proc: ',PPU.GetInitProcName); - debugln('Finalization proc: ',PPU.GetFinalProcName); + Group:=Groups.AddGroup('Default'); + for i:=1 to Paramcount do begin + Filename:=ParamStr(i); + debugln(Filename); + Member:=Group.AddMember(ExtractFileNameOnly(Filename)); + Member.PPUFilename:=Filename; + end; + + Groups.UpdateDependencies; finally - PPU.Free; - UsedUnits.Free; + Groups.Free; end; end. diff --git a/components/codetools/ppugraph.pas b/components/codetools/ppugraph.pas new file mode 100644 index 0000000000..f3b77eeeab --- /dev/null +++ b/components/codetools/ppugraph.pas @@ -0,0 +1,338 @@ +{ + *************************************************************************** + * * + * 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 . 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: + Functions and classes to build dependency graphs for ppu files. +} +unit PPUGraph; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, PPUParser, CodeTree, AVL_Tree, FileProcs, BasicCodeTools; + +type + TPPUGroup = class; + + { TPPUMember } + + TPPUMember = class + public + Unitname: string; + PPUFilename: string; + KeyNode: TCodeTreeNode; + InitializationMangledName: string; + FinalizationMangledName: string; + Group: TPPUGroup; + constructor Create; + destructor Destroy; override; + function UpdateDependencies: boolean; + end; + + TPPUGroups = class; + + { TPPUGroup } + + TPPUGroup = class + private + FMembers: TAVLTree;// tree of TPPUMember sorted for unitname + function FindAVLNodeOfMemberWithUnitName(const AName: string): TAVLTreeNode; + procedure InternalRemoveMember(AMember: TPPUMember); + public + Name: string; + KeyNode: TCodeTreeNode; + Groups: TPPUGroups; + constructor Create; + destructor Destroy; override; + procedure Clear; + function AddMember(const NewUnitName: string): TPPUMember; + function FindMemberWithUnitName(const AName: string): TPPUMember; + function UpdateDependencies: boolean; + end; + + { TPPUGroups } + + TPPUGroups = class + private + FGroups: TAVLTree;// tree of TPPUGroup sorted for name + FMembers: TAVLTree;// tree of TPPUMember sorted for unitname + function FindAVLNodeOfGroupWithName(const AName: string): TAVLTreeNode; + function FindAVLNodeOfMemberWithName(const AName: string): TAVLTreeNode; + procedure InternalRemoveMember(AMember: TPPUMember); + procedure InternalRemoveGroup(AGroup: TPPUGroup); + public + Name: string; + constructor Create; + destructor Destroy; override; + procedure Clear; + function AddGroup(const NewName: string): TPPUGroup; + function FindGroupWithName(const AName: string): TPPUGroup; + function FindMemberWithUnitName(const AName: string): TPPUMember; + function UpdateDependencies: boolean; + end; + +function ComparePPUMembersByUnitName(Member1, Member2: Pointer): integer; +function CompareNameWithPPUMemberName(NamePChar, Member: Pointer): integer; + +function ComparePPUGroupsByName(Group1, Group2: Pointer): integer; +function CompareNameWithPPUGroupName(NamePChar, Group: Pointer): integer; + + +implementation + +function ComparePPUMembersByUnitName(Member1, Member2: Pointer): integer; +begin + Result:=CompareIdentifierPtrs(Pointer(TPPUMember(Member1).Unitname), + Pointer(TPPUMember(Member2).Unitname)); +end; + +function CompareNameWithPPUMemberName(NamePChar, Member: Pointer): integer; +begin + Result:=CompareIdentifierPtrs(NamePChar,Pointer(TPPUMember(Member).Unitname)); +end; + +function ComparePPUGroupsByName(Group1, Group2: Pointer): integer; +begin + Result:=CompareIdentifierPtrs(Pointer(TPPUGroup(Group1).Name), + Pointer(TPPUGroup(Group2).Name)); +end; + +function CompareNameWithPPUGroupName(NamePChar, Group: Pointer): integer; +begin + Result:=CompareIdentifierPtrs(NamePChar,Pointer(TPPUGroup(Group).Name)); +end; + +{ TPPUMember } + +constructor TPPUMember.Create; +begin + KeyNode:=NodeMemManager.NewNode; +end; + +destructor TPPUMember.Destroy; +begin + if KeyNode<>nil then + NodeMemManager.DisposeNode(KeyNode); + KeyNode:=nil; + if Group<>nil then + Group.InternalRemoveMember(Self); + inherited Destroy; +end; + +function TPPUMember.UpdateDependencies: boolean; +var + PPU: TPPU; + UsedUnits: TStringList; +begin + Result:=false; + PPU:=TPPU.Create; + UsedUnits:=TStringList.Create; + try + PPU.LoadFromFile(PPUFilename); + debugln('================================================================'); + DebugLn(['TPPUMember.UpdateDependencies UnitName=',Unitname,' Filename=',PPUFilename]); + PPU.Dump(''); + debugln('================================================================'); + UsedUnits.Clear; + PPU.GetMainUsesSectionNames(UsedUnits); + debugln('Main used units: ',UsedUnits.DelimitedText); + UsedUnits.Clear; + PPU.GetImplementationUsesSectionNames(UsedUnits); + debugln('Implementation used units: ',UsedUnits.DelimitedText); + InitializationMangledName:=PPU.GetInitProcName; + debugln('Initialization proc: ',InitializationMangledName); + FinalizationMangledName:=PPU.GetFinalProcName; + debugln('Finalization proc: ',FinalizationMangledName); + finally + PPU.Free; + UsedUnits.Free; + end; + Result:=true; +end; + +{ TPPUGroup } + +function TPPUGroup.FindAVLNodeOfMemberWithUnitName(const AName: string + ): TAVLTreeNode; +begin + Result:=FMembers.FindKey(PChar(AName),@CompareNameWithPPUMemberName); +end; + +procedure TPPUGroup.InternalRemoveMember(AMember: TPPUMember); +begin + FMembers.RemovePointer(AMember); + if Groups<>nil then + Groups.InternalRemoveMember(AMember); +end; + +constructor TPPUGroup.Create; +begin + FMembers:=TAVLTree.Create(@ComparePPUMembersByUnitName); + KeyNode:=NodeMemManager.NewNode; +end; + +destructor TPPUGroup.Destroy; +begin + Clear; + FreeAndNil(FMembers); + if KeyNode<>nil then + NodeMemManager.DisposeNode(KeyNode); + KeyNode:=nil; + if Groups<>nil then + Groups.InternalRemoveGroup(Self); + inherited Destroy; +end; + +procedure TPPUGroup.Clear; +begin + while FMembers.Count>0 do + TPPUMember(FMembers.Root.Data).Free; +end; + +function TPPUGroup.AddMember(const NewUnitName: string): TPPUMember; +begin + Result:=FindMemberWithUnitName(NewUnitName); + if Result<>nil then exit; + Result:=TPPUMember.Create; + Result.Unitname:=NewUnitName; + FMembers.Add(Result); + Result.Group:=Self; + Groups.FMembers.Add(Result); +end; + +function TPPUGroup.FindMemberWithUnitName(const AName: string): TPPUMember; +var + AVLNode: TAVLTreeNode; +begin + AVLNode:=FindAVLNodeOfMemberWithUnitName(AName); + if AVLNode<>nil then + Result:=TPPUMember(AVLNode.Data) + else + Result:=nil; +end; + +function TPPUGroup.UpdateDependencies: boolean; +var + AVLNode: TAVLTreeNode; +begin + Result:=false; + AVLNode:=FMembers.FindLowest; + while AVLNode<>nil do begin + if not TPPUMember(AVLNode.Data).UpdateDependencies then exit; + AVLNode:=FMembers.FindSuccessor(AVLNode); + end; + Result:=true; +end; + +{ TPPUGroups } + +function TPPUGroups.FindAVLNodeOfGroupWithName(const AName: string + ): TAVLTreeNode; +begin + Result:=FGroups.FindKey(PChar(AName),@CompareNameWithPPUGroupName); +end; + +function TPPUGroups.FindAVLNodeOfMemberWithName(const AName: string + ): TAVLTreeNode; +begin + Result:=FMembers.FindKey(PChar(AName),@CompareNameWithPPUMemberName); +end; + +procedure TPPUGroups.InternalRemoveMember(AMember: TPPUMember); +begin + FMembers.RemovePointer(AMember); +end; + +procedure TPPUGroups.InternalRemoveGroup(AGroup: TPPUGroup); +begin + FGroups.RemovePointer(AGroup); +end; + +constructor TPPUGroups.Create; +begin + FGroups:=TAVLTree.Create(@ComparePPUGroupsByName); + FMembers:=TAVLTree.Create(@ComparePPUMembersByUnitName); +end; + +destructor TPPUGroups.Destroy; +begin + Clear; + FreeAndNil(FGroups); + FreeAndNil(FMembers); + inherited Destroy; +end; + +procedure TPPUGroups.Clear; +begin + while FGroups.Count>0 do + TPPUGroup(FGroups.Root.Data).Free; +end; + +function TPPUGroups.AddGroup(const NewName: string): TPPUGroup; +begin + Result:=FindGroupWithName(NewName); + if Result<>nil then exit; + Result:=TPPUGroup.Create; + Result.Name:=NewName; + FGroups.Add(Result); + Result.Groups:=Self; +end; + +function TPPUGroups.FindGroupWithName(const AName: string): TPPUGroup; +var + AVLNode: TAVLTreeNode; +begin + AVLNode:=FindAVLNodeOfGroupWithName(AName); + if AVLNode<>nil then + Result:=TPPUGroup(AVLNode.Data) + else + Result:=nil; +end; + +function TPPUGroups.FindMemberWithUnitName(const AName: string): TPPUMember; +var + AVLNode: TAVLTreeNode; +begin + AVLNode:=FindAVLNodeOfMemberWithName(AName); + if AVLNode<>nil then + Result:=TPPUMember(AVLNode.Data) + else + Result:=nil; +end; + +function TPPUGroups.UpdateDependencies: boolean; +var + AVLNode: TAVLTreeNode; +begin + Result:=false; + AVLNode:=FGroups.FindLowest; + while AVLNode<>nil do begin + if not TPPUGroup(AVLNode.Data).UpdateDependencies then exit; + AVLNode:=FGroups.FindSuccessor(AVLNode); + end; + Result:=true; +end; + +end. +