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