paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-04 13:37:22 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: check fpc paths: show duplicate souce files

Browse Source 
git-svn-id: trunk@26819 -
This commit is contained in:
mattias 2010-07-24 19:39:21 +00:00
parent d0e4b0f9f2
commit 215d412d9d
1 changed files with 28 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
components/codetools/examples/testfpcsrcunitrules.lpr
View File

@ -48,6 +48,7 @@ type
procedure WriteCompilerInfo(ConfigCache: TFPCTargetConfigCache);
procedure WriteDuplicatesInPPUPath(ConfigCache: TFPCTargetConfigCache);
procedure WriteMissingPPUSources(UnitSet: TFPCUnitSetCache);
procedure WriteDuplicateSources(UnitSet: TFPCUnitSetCache);
end;
{ TMyApplication }
@ -108,6 +109,7 @@ begin
WriteDuplicatesInPPUPath(ConfigCache);
WriteMissingPPUSources(UnitSet);
WriteDuplicateSources(UnitSet);
// stop program loop
Terminate;
@ -274,6 +276,32 @@ begin
end;
end;
procedure TTestFPCSourceUnitRules.WriteDuplicateSources(
UnitSet: TFPCUnitSetCache);
var
SrcDuplicates: TStringToStringTree;
Node: TAVLTreeNode;
Cnt: Integer;
Item: PStringToStringTreeItem;
aUnitName: String;
Files: String;
begin
SrcDuplicates:=UnitSet.GetSourceDuplicates(false);
if SrcDuplicates=nil then exit;
Cnt:=0;
Node:=SrcDuplicates.Tree.FindLowest;
while Node<>nil do begin
Item:=PStringToStringTreeItem(Node.Data);
if Cnt=0 then writeln;
inc(Cnt);
aUnitName:=Item^.Name;
Files:=Item^.Value;
writeln('WARNING: duplicate source files: unit=',aUnitName,' files=',Files);
Node:=SrcDuplicates.Tree.FindSuccessor(Node);
end;
if Cnt>0 then writeln;
end;
var
Application: TTestFPCSourceUnitRules;
begin