1{ 2 *************************************************************************** 3 * * 4 * This source is free software; you can redistribute it and/or modify * 5 * it under the terms of the GNU General Public License as published by * 6 * the Free Software Foundation; either version 2 of the License, or * 7 * (at your option) any later version. * 8 * * 9 * This code is distributed in the hope that it will be useful, but * 10 * WITHOUT ANY WARRANTY; without even the implied warranty of * 11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 12 * General Public License for more details. * 13 * * 14 * A copy of the GNU General Public License is available on the World * 15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 16 * obtain it by writing to the Free Software Foundation, * 17 * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. * 18 * * 19 *************************************************************************** 20 21 Author: Mattias Gaertner 22 23 Abstract: 24 Write all duplicate ppu files and all duplicate unit source files. 25} 26program TestFPCSrcUnitRules; 27 28{$mode objfpc}{$H+} 29 30uses 31 Classes, SysUtils, CustApp, Laz_AVL_Tree, 32 // LazUtils 33 LazFileUtils, AvgLvlTree, LazLogger, 34 // CodeTools 35 FileProcs, CodeToolManager, DefineTemplates, CodeToolsConfig; 36 37const 38 ConfigFilename = 'codetools.config'; 39type 40 41 { TTestFPCSourceUnitRules } 42 43 TTestFPCSourceUnitRules = class(TCustomApplication) 44 private 45 FCheckUnitName: string; 46 protected 47 procedure DoRun; override; 48 public 49 constructor Create(TheOwner: TComponent); override; 50 destructor Destroy; override; 51 procedure WriteHelp; virtual; 52 procedure Error(Msg: string; DoWriteHelp: Boolean); 53 procedure WriteCompilerInfo(ConfigCache: TPCTargetConfigCache); 54 procedure WriteNonExistingPPUPaths(ConfigCache: TPCTargetConfigCache); 55 procedure WriteDuplicatesInPPUPath(ConfigCache: TPCTargetConfigCache); 56 procedure WriteMissingPPUSources(UnitSet: TFPCUnitSetCache); 57 procedure WriteDuplicateSources(UnitSet: TFPCUnitSetCache); 58 procedure WriteUnitReport(UnitSet: TFPCUnitSetCache; const AnUnitName: string); 59 property CheckUnitName: string read FCheckUnitName write FCheckUnitName; 60 end; 61 62{ TMyApplication } 63 64procedure TTestFPCSourceUnitRules.DoRun; 65var 66 ErrorMsg: String; 67 CompilerFilename: String; 68 TargetOS: String; 69 TargetCPU: String; 70 FPCSrcDir: String; 71 UnitSet: TFPCUnitSetCache; 72 ConfigCache: TPCTargetConfigCache; 73 Options: TCodeToolsOptions; 74 Rescan: Boolean; 75 SourceCache: TFPCSourceCache; 76begin 77 // quick check parameters 78 ErrorMsg:=CheckOptions('hc:T:P:F:u:','help compiler: targetos: targetcpu: fpcsrcdir: checkunit: rescan'); 79 if ErrorMsg<>'' then begin 80 ShowException(Exception.Create(ErrorMsg)); 81 Terminate; 82 Exit; 83 end; 84 85 // parse parameters 86 if HasOption('h','help') then begin 87 WriteHelp; 88 Halt; 89 end; 90 91 if not HasOption('F','fpcsrcdir') then 92 Error('fpc source directory missing',true); 93 94 if HasOption('c','compiler') then begin 95 CompilerFilename:=GetOptionValue('c','compiler'); 96 CompilerFilename:=CleanAndExpandFilename(CompilerFilename); 97 end else begin 98 CompilerFilename:=GetDefaultCompilerFilename; 99 CompilerFilename:=SearchFileInPath(CompilerFilename,'', 100 GetEnvironmentVariable('PATH'), PathSeparator,ctsfcDefault); 101 end; 102 TargetOS:=GetOptionValue('T','targetos'); 103 TargetCPU:=GetOptionValue('P','targetcpu'); 104 FPCSrcDir:=GetOptionValue('F','fpcsrcdir'); 105 FPCSrcDir:=CleanAndExpandDirectory(FPCSrcDir); 106 CheckUnitName:=GetOptionValue('u','checkunit'); 107 Rescan:=HasOption('rescan'); 108 109 if not FileExistsUTF8(CompilerFilename) then 110 Error('compiler file not found: '+CompilerFilename,false); 111 if not DirPathExists(FPCSrcDir) then 112 Error('FPC source directory not found: '+FPCSrcDir,false); 113 114 Options:=TCodeToolsOptions.Create; 115 Options.InitWithEnvironmentVariables; 116 if FileExistsUTF8(ConfigFilename) then begin 117 writeln('loading ',ConfigFilename); 118 Options.LoadFromFile(ConfigFilename); 119 end else begin 120 writeln('no config yet: ',ConfigFilename); 121 end; 122 Options.FPCPath:=CompilerFilename; 123 Options.FPCOptions:=''; 124 Options.TargetOS:=TargetOS; 125 Options.TargetProcessor:=TargetCPU; 126 Options.FPCSrcDir:=FPCSrcDir; 127 128 CodeToolBoss.Init(Options); 129 130 UnitSet:=CodeToolBoss.CompilerDefinesCache.FindUnitSet(CompilerFilename, 131 TargetOS,TargetCPU,'',FPCSrcDir,true); 132 UnitSet.Init; 133 134 //writeln('saving ',ConfigFilename); 135 Options.SaveToFile(ConfigFilename); 136 Options.Free; 137 138 ConfigCache:=UnitSet.GetConfigCache(false); 139 if Rescan then begin 140 ConfigCache.Clear; 141 SourceCache:=UnitSet.GetSourceCache(false); 142 SourceCache.Clear; 143 UnitSet.GetUnitToSourceTree(true); 144 end; 145 WriteCompilerInfo(ConfigCache); 146 WriteNonExistingPPUPaths(ConfigCache); 147 WriteDuplicatesInPPUPath(ConfigCache); 148 WriteMissingPPUSources(UnitSet); 149 WriteDuplicateSources(UnitSet); 150 if CheckUnitName<>'' then 151 WriteUnitReport(UnitSet,CheckUnitName); 152 153 // stop program loop 154 Terminate; 155end; 156 157constructor TTestFPCSourceUnitRules.Create(TheOwner: TComponent); 158begin 159 inherited Create(TheOwner); 160 StopOnException:=True; 161end; 162 163destructor TTestFPCSourceUnitRules.Destroy; 164begin 165 inherited Destroy; 166end; 167 168procedure TTestFPCSourceUnitRules.WriteHelp; 169begin 170 writeln('Usage: ',ExeName,' -h'); 171 writeln; 172 writeln(' -c <compiler file name>, --compiler=<compiler file name>'); 173 writeln(' Default is to use environment variable PP.'); 174 writeln(' If this is not set, search for '+GetDefaultCompilerFilename); 175 writeln; 176 writeln(' -T <target OS>, --targetos=<target OS>'); 177 writeln(' Default is to use environment variable FPCTARGET.'); 178 writeln(' If this is not set, use the default of the compiler.'); 179 writeln; 180 writeln(' -P <target CPU>, --targetcpu=<target CPU>'); 181 writeln(' Default is to use environment variable FPCTARGETCPU.'); 182 writeln(' If this is not set, use the default of the compiler.'); 183 writeln; 184 writeln(' -F <FPC source directory>, --fpcsrcdir=<FPC source directory>'); 185 writeln(' Default is to use environment variable FPCDIR.'); 186 writeln(' There is no default.'); 187 writeln; 188 writeln(' -u <unit name>, --checkunit=<unit name>'); 189 writeln(' Write a detailed report about this unit.'); 190 writeln; 191 writeln(' --rescan rescan compiler and FPC sources for this combination'); 192end; 193 194procedure TTestFPCSourceUnitRules.Error(Msg: string; DoWriteHelp: Boolean); 195begin 196 writeln('Error: ',Msg); 197 if DoWriteHelp then begin 198 writeln; 199 WriteHelp; 200 end; 201 Halt; 202end; 203 204procedure TTestFPCSourceUnitRules.WriteCompilerInfo( 205 ConfigCache: TPCTargetConfigCache); 206var 207 i: Integer; 208 CfgFile: TPCConfigFileState; 209begin 210 writeln('Compiler=',ConfigCache.Compiler); 211 writeln('TargetOS=',ConfigCache.TargetOS); 212 writeln('TargetCPU=',ConfigCache.TargetCPU); 213 writeln('Options=',ConfigCache.CompilerOptions); 214 writeln('RealCompiler=',ConfigCache.RealCompiler); 215 writeln('RealTargetOS=',ConfigCache.RealTargetOS); 216 writeln('RealTargetCPU=',ConfigCache.RealTargetCPU); 217 writeln('RealCompilerInPATH=',ConfigCache.RealCompilerInPath); 218 if ConfigCache.ConfigFiles<>nil then begin 219 for i:=0 to ConfigCache.ConfigFiles.Count-1 do begin 220 CfgFile:=ConfigCache.ConfigFiles[i]; 221 writeln('Config=',CfgFile.Filename,' Exists=',CfgFile.FileExists); 222 end; 223 end; 224 if (ConfigCache.UnitPaths=nil) or (ConfigCache.UnitPaths.Count=0) then 225 writeln('WARNING: no ppu search paths') 226 else 227 writeln('Number of PPU search paths=',ConfigCache.UnitPaths.Count); 228end; 229 230procedure TTestFPCSourceUnitRules.WriteNonExistingPPUPaths( 231 ConfigCache: TPCTargetConfigCache); 232var 233 SearchPaths: TStrings; 234 i: Integer; 235 Dir: String; 236begin 237 SearchPaths:=ConfigCache.UnitPaths; 238 if SearchPaths=nil then exit; 239 for i:=0 to SearchPaths.Count-1 do begin 240 Dir:=CleanAndExpandDirectory(SearchPaths[i]); 241 if not DirPathExists(Dir) then begin 242 writeln('WARNING: ppu search path does not exist: ',SearchPaths[i]); 243 end; 244 end; 245end; 246 247procedure TTestFPCSourceUnitRules.WriteDuplicatesInPPUPath( 248 ConfigCache: TPCTargetConfigCache); 249var 250 i: Integer; 251 Directory: String; 252 FileInfo: TSearchRec; 253 ShortFilename: String; 254 Filename: String; 255 Ext: String; 256 LowerUnitname: String; 257 SearchPaths: TStrings; 258 IsSource: Boolean; 259 IsPPU: Boolean; 260 SourceFiles: TStringList; 261 Units: TStringToStringTree; 262 Item: PStringToStringItem; 263 Node: TAVLTreeNode; 264begin 265 SearchPaths:=ConfigCache.UnitPaths; 266 if SearchPaths=nil then exit; 267 SourceFiles:=TStringList.Create; 268 Units:=TStringToStringTree.Create(false); 269 for i:=SearchPaths.Count-1 downto 0 do begin 270 Directory:=CleanAndExpandDirectory(SearchPaths[i]); 271 if FindFirstUTF8(Directory+FileMask,faAnyFile,FileInfo)=0 then begin 272 repeat 273 ShortFilename:=FileInfo.Name; 274 if (ShortFilename='') or (ShortFilename='.') or (ShortFilename='..') then 275 continue; 276 Filename:=Directory+ShortFilename; 277 Ext:=LowerCase(ExtractFileExt(ShortFilename)); 278 IsSource:=(Ext='.pas') or (Ext='.pp') or (Ext='.p'); 279 IsPPU:=(Ext='.ppu'); 280 if IsSource then 281 SourceFiles.Add(Filename); 282 if IsSource or IsPPU then begin 283 LowerUnitname:=lowercase(ExtractFileNameOnly(Filename)); 284 if Units.Contains(LowerUnitname) then 285 Units[LowerUnitname]:=Units[LowerUnitname]+';'+Filename 286 else 287 Units[LowerUnitname]:=Filename; 288 end; 289 until FindNextUTF8(FileInfo)<>0; 290 end; 291 FindCloseUTF8(FileInfo); 292 end; 293 if SourceFiles.Count<>0 then begin 294 // source files in PPU search path 295 writeln; 296 writeln('WARNING: source files found in PPU search paths:'); 297 writeln(SourceFiles.Text); 298 writeln; 299 end; 300 Node:=Units.Tree.FindLowest; 301 i:=0; 302 while Node<>nil do begin 303 Item:=PStringToStringItem(Node.Data); 304 Filename:=Item^.Value; 305 if System.Pos(';',Filename)>0 then begin 306 // duplicate units 307 if i=0 then writeln; 308 inc(i); 309 writeln('HINT: duplicate unit in PPU path: '+Filename); 310 end; 311 Node:=Units.Tree.FindSuccessor(Node); 312 end; 313 if i>0 then writeln; 314 Units.Free; 315 SourceFiles.Free; 316end; 317 318procedure TTestFPCSourceUnitRules.WriteMissingPPUSources( 319 UnitSet: TFPCUnitSetCache); 320var 321 UnitToSrc: TStringToStringTree; 322 Node: TAVLTreeNode; 323 Item: PStringToStringItem; 324 ConfigCache: TPCTargetConfigCache; 325 aUnitName: String; 326 Cnt: Integer; 327 Filename: String; 328 SourceCache: TFPCSourceCache; 329 i: Integer; 330 SrcRules: TFPCSourceRules; 331 aTree: TStringToStringTree; 332begin 333 UnitToSrc:=UnitSet.GetUnitToSourceTree(false); 334 ConfigCache:=UnitSet.GetConfigCache(false); 335 SourceCache:=UnitSet.GetSourceCache(false); 336 if ConfigCache.Units<>nil then begin 337 Cnt:=0; 338 Node:=ConfigCache.Units.Tree.FindLowest; 339 while Node<>nil do begin 340 Item:=PStringToStringItem(Node.Data); 341 aUnitName:=Item^.Name; 342 Filename:=Item^.Value; 343 if CompareFileExt(Filename,'ppu',true)=0 then begin 344 // a ppu in the PPU search path 345 if UnitToSrc[aUnitName]='' then begin 346 inc(Cnt); 347 if Cnt=1 then writeln; 348 writeln('WARNING: no source found for PPU file: '+Filename); 349 for i:=0 to SourceCache.Files.Count-1 do begin 350 if SysUtils.CompareText(ExtractFileNameOnly(SourceCache.Files[i]),aUnitName)=0 351 then begin 352 writeln(' Candidate: ',SourceCache.Files[i]); 353 SrcRules:=UnitSet.GetSourceRules(false); 354 aTree:=GatherUnitsInFPCSources(SourceCache.Files, 355 ConfigCache.RealTargetOS,ConfigCache.RealTargetCPU,nil, 356 SrcRules,aUnitName); 357 aTree.Free; 358 end; 359 end; 360 end; 361 end; 362 Node:=ConfigCache.Units.Tree.FindSuccessor(Node); 363 end; 364 if Cnt>0 then writeln; 365 end; 366end; 367 368procedure TTestFPCSourceUnitRules.WriteDuplicateSources( 369 UnitSet: TFPCUnitSetCache); 370var 371 SrcDuplicates: TStringToStringTree; 372 Node: TAVLTreeNode; 373 Cnt: Integer; 374 Item: PStringToStringItem; 375 aUnitName: String; 376 Files: String; 377 Units: TStringToStringTree; 378 PPUFile: string; 379begin 380 SrcDuplicates:=UnitSet.GetSourceDuplicates(false); 381 if SrcDuplicates=nil then exit; 382 Units:=UnitSet.GetConfigCache(false).Units; 383 384 // first list all duplicates with a ppu file (important) 385 if Units<>nil then begin 386 Cnt:=0; 387 Node:=SrcDuplicates.Tree.FindLowest; 388 while Node<>nil do begin 389 Item:=PStringToStringItem(Node.Data); 390 aUnitName:=Item^.Name; 391 Files:=Item^.Value; 392 PPUFile:=Units[aUnitName]; 393 if CompareFileExt(PPUFile,'ppu',true)=0 then begin 394 if Cnt=0 then writeln; 395 inc(Cnt); 396 writeln('WARNING: duplicate source file for ppu ',aUnitName,' files=',Files); 397 end; 398 Node:=SrcDuplicates.Tree.FindSuccessor(Node); 399 end; 400 if Cnt>0 then writeln; 401 end; 402 403 // then list all duplicates without a ppu file (unimportant) 404 Cnt:=0; 405 Node:=SrcDuplicates.Tree.FindLowest; 406 while Node<>nil do begin 407 Item:=PStringToStringItem(Node.Data); 408 aUnitName:=Item^.Name; 409 Files:=Item^.Value; 410 if (Units=nil) or (Units[aUnitName]='') then begin 411 if Cnt=0 then writeln; 412 inc(Cnt); 413 writeln('HINT: duplicate source files: unit=',aUnitName,' files=',Files); 414 end; 415 Node:=SrcDuplicates.Tree.FindSuccessor(Node); 416 end; 417 if Cnt>0 then writeln; 418end; 419 420procedure TTestFPCSourceUnitRules.WriteUnitReport(UnitSet: TFPCUnitSetCache; 421 const AnUnitName: string); 422var 423 ConfigCache: TPCTargetConfigCache; 424 PPUFile: String; 425 SourceCache: TFPCSourceCache; 426 aTree: TStringToStringTree; 427 SrcRules: TFPCSourceRules; 428 FPM: TPCFPMFileState; 429begin 430 writeln; 431 writeln('Unit report for ',AnUnitName); 432 ConfigCache:=UnitSet.GetConfigCache(false); 433 434 // in ppu search path 435 PPUFile:=''; 436 if ConfigCache.Units<>nil then 437 PPUFile:=ConfigCache.Units[AnUnitName]; 438 if PPUFile='' then 439 writeln(' WARNING: ',AnUnitName,' is not in PPU search path') 440 else if CompareFileExt(PPUFile,'ppu',true)<>0 then 441 writeln(' WARNING: fpc ppu search path has a source and not a ppu for ',AnUnitName,': ',PPUFile) 442 else 443 writeln(' in PPU search path: ',PPUFile); 444 445 // search in FPC sources 446 SourceCache:=UnitSet.GetSourceCache(false); 447 SrcRules:=UnitSet.GetSourceRules(false); 448 if SourceCache.Files<>nil then begin 449 aTree:=GatherUnitsInFPCSources(SourceCache.Files, 450 ConfigCache.RealTargetOS,ConfigCache.RealTargetCPU,nil, 451 SrcRules,AnUnitName); 452 if (aTree=nil) or (aTree.Count=0) then 453 writeln(' WARNING: no units in FPC sources: ',SourceCache.Directory) 454 else 455 writeln(' in FPC source dir: ',aTree[AnUnitName]); 456 aTree.Free; 457 end else 458 writeln(' WARNING: no files in FPC sources: ',SourceCache.Directory); 459 460 // search in FPM 461 if ConfigCache.UnitToFPM<>nil then begin 462 FPM:=TPCFPMFileState(ConfigCache.UnitToFPM[AnUnitName]); 463 if FPM<>nil then begin 464 writeln(' in fpm: ',FPM.Name,' File=',FPM.FPMFilename); 465 writeln(' fpm source: ',FPM.UnitToSrc[AnUnitName]); 466 end; 467 end; 468end; 469 470var 471 Application: TTestFPCSourceUnitRules; 472begin 473 Application:=TTestFPCSourceUnitRules.Create(nil); 474 Application.Title:='TestFPCSrcUnitRules'; 475 Application.Run; 476 Application.Free; 477end. 478 479