paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 16:49:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: check fpc paths: show ppu files without source

Browse Source 
git-svn-id: trunk@26818 -
This commit is contained in:
mattias 2010-07-24 19:33:10 +00:00
parent cd9bcbc7d0
commit d0e4b0f9f2
1 changed files with 42 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -47,6 +47,7 @@ type
procedure Error(Msg: string; DoWriteHelp: Boolean); procedure Error(Msg: string; DoWriteHelp: Boolean);
procedure WriteCompilerInfo(ConfigCache: TFPCTargetConfigCache); procedure WriteCompilerInfo(ConfigCache: TFPCTargetConfigCache);
procedure WriteDuplicatesInPPUPath(ConfigCache: TFPCTargetConfigCache); procedure WriteDuplicatesInPPUPath(ConfigCache: TFPCTargetConfigCache);
procedure WriteMissingPPUSources(UnitSet: TFPCUnitSetCache);
end; end;
{ TMyApplication } { TMyApplication }
@ -60,7 +61,6 @@ var
FPCSrcDir: String; FPCSrcDir: String;
UnitSet: TFPCUnitSetCache; UnitSet: TFPCUnitSetCache;
ConfigCache: TFPCTargetConfigCache; ConfigCache: TFPCTargetConfigCache;
SourceCache: TFPCSourceCache;
begin begin
// quick check parameters // quick check parameters
ErrorMsg:=CheckOptions('hcTPF','help compiler targetos targetcpu fpcsrcdir'); ErrorMsg:=CheckOptions('hcTPF','help compiler targetos targetcpu fpcsrcdir');
@ -101,13 +101,13 @@ begin
UnitSet:=CodeToolBoss.FPCDefinesCache.FindUnitSet(CompilerFilename, UnitSet:=CodeToolBoss.FPCDefinesCache.FindUnitSet(CompilerFilename,
TargetOS,TargetCPU,'',FPCSrcDir,true); TargetOS,TargetCPU,'',FPCSrcDir,true);
ConfigCache:=UnitSet.GetConfigCache(true); UnitSet.Init;
ConfigCache:=UnitSet.GetConfigCache(false);
WriteCompilerInfo(ConfigCache); WriteCompilerInfo(ConfigCache);
WriteDuplicatesInPPUPath(ConfigCache); WriteDuplicatesInPPUPath(ConfigCache);
SourceCache:=UnitSet.GetSourceCache(true); WriteMissingPPUSources(UnitSet);
// stop program loop // stop program loop
Terminate; Terminate;
@ -223,19 +223,57 @@ begin
writeln; writeln;
end; end;
Node:=Units.Tree.FindLowest; Node:=Units.Tree.FindLowest;
i:=0;
while Node<>nil do begin while Node<>nil do begin
Item:=PStringToStringTreeItem(Node.Data); Item:=PStringToStringTreeItem(Node.Data);
Filename:=Item^.Value; Filename:=Item^.Value;
if System.Pos(';',Filename)>0 then begin if System.Pos(';',Filename)>0 then begin
// duplicate units // duplicate units
if i=0 then writeln;
inc(i);
writeln('WARNING: duplicate unit in PPU path: '+Filename); writeln('WARNING: duplicate unit in PPU path: '+Filename);
end; end;
Node:=Units.Tree.FindSuccessor(Node); Node:=Units.Tree.FindSuccessor(Node);
end; end;
if i>0 then writeln;
Units.Free; Units.Free;
SourceFiles.Free; SourceFiles.Free;
end; end;
procedure TTestFPCSourceUnitRules.WriteMissingPPUSources(
UnitSet: TFPCUnitSetCache);
var
UnitToSrc: TStringToStringTree;
Node: TAVLTreeNode;
Item: PStringToStringTreeItem;
ConfigCache: TFPCTargetConfigCache;
aUnitName: String;
Cnt: Integer;
Filename: String;
begin
UnitToSrc:=UnitSet.GetUnitToSourceTree(false);
ConfigCache:=UnitSet.GetConfigCache(false);
if ConfigCache.Units<>nil then begin
Cnt:=0;
Node:=ConfigCache.Units.Tree.FindLowest;
while Node<>nil do begin
Item:=PStringToStringTreeItem(Node.Data);
aUnitName:=Item^.Name;
Filename:=Item^.Value;
if CompareFileExt(Filename,'ppu',false)=0 then begin
// a ppu in the PPU search path
if UnitToSrc[aUnitName]='' then begin
inc(Cnt);
if Cnt=1 then writeln;
writeln('WARNING: no source found for PPU file: '+Filename);
end;
end;
Node:=ConfigCache.Units.Tree.FindSuccessor(Node);
end;
if Cnt>0 then writeln;
end;
end;
var var
Application: TTestFPCSourceUnitRules; Application: TTestFPCSourceUnitRules;
begin begin