checkcompileropts.pas

/ide/checkcompileropts.pas

http://github.com/graemeg/lazarus
Pascal | 1028 lines | 981 code | 15 blank | 32 comment | 1 complexity | 339c2fbe5e49db0212f7363b806412d6 MD5 | raw file
   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 Abstract:
  22   This dialog is typically called by the 'Test' button on the compiler options
  23   dialog.
  24   A dialog testing for common misconfigurations in some compiler options.
  25}
  26unit CheckCompilerOpts;
  27
  28{$mode objfpc}{$H+}
  29
  30{$I ide.inc}
  31
  32interface
  33
  34uses
  35  Classes, SysUtils, Forms, Controls, Dialogs, FileUtil,
  36  Clipbrd, StdCtrls, AVL_Tree, Menus, ExtCtrls, ButtonPanel, ComCtrls,
  37  // codetools
  38  CodeToolManager, FileProcs, LazFileCache, LazFileUtils, LazUTF8,
  39  DefineTemplates, CodeToolsStructs,
  40  // IDEIntf
  41  ProjectIntf, MacroIntf, IDEExternToolIntf, LazIDEIntf, IDEDialogs,
  42  PackageIntf, IDEMsgIntf,
  43  // IDE
  44  Project, PackageSystem, IDEProcs,
  45  LazarusIDEStrConsts, PackageDefs, CompilerOptions, TransferMacros, LazConf;
  46
  47type
  48  TCompilerOptionsTest = (
  49    cotNone,
  50    cotCheckCompilerExe,
  51    cotCheckAmbiguousFPCCfg,
  52    cotCheckMissingFPCPPUs,
  53    cotCheckCompilerDate,
  54    cotCheckCompilerConfig, // e.g. fpc.cfg
  55    cotCheckAmbiguousPPUsInUnitPath,
  56    cotCheckFPCUnitPathsContainSources,
  57    cotCompileBogusFiles
  58    );
  59    
  60  TCompilerCheckMsgLvl = (
  61    ccmlHint,
  62    ccmlWarning,
  63    ccmlError
  64    );
  65
  66  { TCheckCompilerOptsDlg }
  67
  68  TCheckCompilerOptsDlg = class(TForm)
  69    ButtonPanel: TButtonPanel;
  70    CopyOutputMenuItem: TMenuItem;
  71    OutputPopupMenu: TPopupMenu;
  72    OutputTreeView: TTreeView;
  73    Splitter1: TSplitter;
  74    TestMemo: TMemo;
  75    LabelTest: TLabel;
  76    LabelOutput: TLabel;
  77    procedure ApplicationOnIdle(Sender: TObject; var {%H-}Done: Boolean);
  78    procedure CopyOutputMenuItemClick(Sender: TObject);
  79  private
  80    FIdleConnected: boolean;
  81    FMacroList: TTransferMacroList;
  82    FOptions: TCompilerOptions;
  83    FTest: TCompilerOptionsTest;
  84    FLastLineIsProgress: boolean;
  85    FDirectories: TStringList;
  86    procedure SetIdleConnected(const AValue: boolean);
  87    procedure SetMacroList(const AValue: TTransferMacroList);
  88    procedure SetOptions(const AValue: TCompilerOptions);
  89    procedure SetMsgDirectory(Index: integer; const CurDir: string);
  90    function CheckSpecialCharsInPath(const Title, ExpandedPath: string): TModalResult;
  91    function CheckNonExistingSearchPaths(const Title, ExpandedPath: string): TModalResult;
  92    function CheckCompilerExecutable(const CompilerFilename: string): TModalResult;
  93    function CheckCompilerConfig(CfgCache: TFPCTargetConfigCache): TModalResult;
  94    function FindAllPPUFiles(const AnUnitPath: string): TStrings;
  95    function CheckMissingFPCPPUs(CfgCache: TFPCTargetConfigCache): TModalResult;
  96    function CheckCompilerDate(CfgCache: TFPCTargetConfigCache): TModalResult;
  97    function CheckForAmbiguousPPUs(SearchForPPUs: TStrings;
  98                                   SearchInPPUs: TStrings = nil): TModalResult;
  99    function CheckFPCUnitPathsContainSources(const FPCCfgUnitPath: string
 100                                              ): TModalResult;
 101    function CheckOutputPathInSourcePaths(CurOptions: TCompilerOptions): TModalResult;
 102    function CheckOrphanedPPUs(CurOptions: TCompilerOptions): TModalResult;
 103    function CheckCompileBogusFile(const CompilerFilename: string): TModalResult;
 104    function CheckPackagePathsIntersections(CurOptions: TCompilerOptions): TModalResult;
 105  public
 106    function DoTestAll: TModalResult;
 107    constructor Create(TheOwner: TComponent); override;
 108    destructor Destroy; override;
 109    procedure Add(const Msg, CurDir: String; ProgressLine: boolean;
 110                  OriginalIndex: integer);
 111    procedure AddMsg(const Msg, CurDir: String; OriginalIndex: integer);
 112    procedure AddHint(const Msg: string);
 113    procedure AddWarning(const Msg: string);
 114    procedure AddMsg(const Level: TCompilerCheckMsgLvl; const Msg: string);
 115    property IdleConnected: boolean read FIdleConnected write SetIdleConnected;
 116  public
 117    property Options: TCompilerOptions read FOptions write SetOptions;
 118    property Test: TCompilerOptionsTest read FTest;
 119    property MacroList: TTransferMacroList read FMacroList write SetMacroList;
 120  end;
 121
 122var
 123  CheckCompilerOptsDlg: TCheckCompilerOptsDlg;
 124
 125type
 126  TCCOSpecialCharType = (
 127    ccoscNonASCII,
 128    ccoscWrongPathDelim,
 129    ccoscUnusualChars,
 130    ccoscSpecialChars,
 131    ccoscNewLine
 132    );
 133  TCCOSpecialChars = set of TCCOSpecialCharType;
 134
 135procedure FindSpecialCharsInPath(const Path: string; out HasChars: TCCOSpecialChars);
 136function SpecialCharsToStr(const HasChars: TCCOSpecialChars): string;
 137
 138
 139implementation
 140
 141{$R *.lfm}
 142
 143procedure FindSpecialCharsInPath(const Path: string; out HasChars: TCCOSpecialChars);
 144var
 145  i: Integer;
 146begin
 147  HasChars := [];
 148  for i := 1 to length(Path) do
 149  begin
 150    case Path[i] of
 151      #10,#13: Include(HasChars,ccoscNewLine);
 152      #0..#9,#11,#12,#14..#31: Include(HasChars,ccoscSpecialChars);
 153      '/','\': if Path[i]<>PathDelim then Include(HasChars,ccoscWrongPathDelim);
 154      '@','#','$','&','*','(',')','[',']','+','<','>','?','|': Include(HasChars,ccoscUnusualChars);
 155      #128..#255: Include(HasChars,ccoscNonASCII);
 156    end;
 157  end;
 158end;
 159
 160function SpecialCharsToStr(const HasChars: TCCOSpecialChars): string;
 161
 162  procedure AddStr(var s: string; const Addition: string);
 163  begin
 164    if s='' then
 165      s:=lisCCOContains
 166    else
 167      s:=s+', ';
 168    s:=s+Addition;
 169  end;
 170
 171begin
 172  Result:='';
 173  if ccoscNonASCII in HasChars then AddStr(Result,lisCCONonASCII);
 174  if ccoscWrongPathDelim in HasChars then AddStr(Result,lisCCOWrongPathDelimiter);
 175  if ccoscUnusualChars in HasChars then AddStr(Result,lisCCOUnusualChars);
 176  
 177  if ccoscSpecialChars in HasChars then AddStr(Result,lisCCOSpecialCharacters);
 178  if ccoscNewLine in HasChars then AddStr(Result,lisCCOHasNewLine);
 179end;
 180
 181{ TCheckCompilerOptsDlg }
 182
 183procedure TCheckCompilerOptsDlg.ApplicationOnIdle(Sender: TObject; var Done: Boolean);
 184begin
 185  IdleConnected:=false;
 186  DoTestAll;
 187end;
 188
 189procedure TCheckCompilerOptsDlg.CopyOutputMenuItemClick(Sender: TObject);
 190var
 191  s: String;
 192  TVNode: TTreeNode;
 193begin
 194  s:='';
 195  for TVNode in OutputTreeView.Items do
 196    s+=TVNode.Text+LineEnding;
 197  Clipboard.AsText:=s;
 198end;
 199
 200procedure TCheckCompilerOptsDlg.SetOptions(const AValue: TCompilerOptions);
 201begin
 202  if FOptions=AValue then exit;
 203  FOptions:=AValue;
 204end;
 205
 206procedure TCheckCompilerOptsDlg.SetMsgDirectory(Index: integer;
 207  const CurDir: string);
 208begin
 209  if FDirectories=nil then FDirectories:=TStringList.Create;
 210  while FDirectories.Count<=Index do FDirectories.Add('');
 211  FDirectories[Index]:=CurDir;
 212end;
 213
 214function TCheckCompilerOptsDlg.CheckSpecialCharsInPath(const Title, ExpandedPath: string
 215  ): TModalResult;
 216var
 217  Warning: String;
 218  ErrorMsg: String;
 219  HasChars: TCCOSpecialChars;
 220begin
 221  FindSpecialCharsInPath(ExpandedPath, HasChars);
 222  Warning := SpecialCharsToStr(HasChars * [ccoscNonASCII, ccoscWrongPathDelim, ccoscUnusualChars]);
 223  ErrorMsg := SpecialCharsToStr(HasChars * [ccoscSpecialChars, ccoscNewLine]);
 224
 225  if Warning <> '' then
 226    AddWarning(Title + ' ' + Warning);
 227  if ErrorMsg <> '' then
 228  begin
 229    Result := IDEQuestionDialog(lisCCOInvalidSearchPath, Title + ' ' + ErrorMsg, mtError,
 230      [mrIgnore, lisCCOSkip, mrAbort]);
 231  end else
 232  begin
 233    if Warning = '' then
 234      Result := mrOk
 235    else
 236      Result := mrIgnore;
 237  end;
 238end;
 239
 240function TCheckCompilerOptsDlg.CheckNonExistingSearchPaths(const Title,
 241  ExpandedPath: string): TModalResult;
 242var
 243  p: Integer;
 244  CurPath: String;
 245begin
 246  Result:=mrOk;
 247  p:=1;
 248  repeat
 249    CurPath:=GetNextDirectoryInSearchPath(ExpandedPath,p);
 250    if (CurPath<>'') and (not IDEMacros.StrHasMacros(CurPath))
 251    and (FilenameIsAbsolute(CurPath)) then begin
 252      if not DirPathExistsCached(CurPath) then begin
 253        AddWarning(Format(lisDoesNotExists, [Title, CurPath]));
 254      end;
 255    end;
 256  until p>length(ExpandedPath);
 257end;
 258
 259function TCheckCompilerOptsDlg.CheckCompilerExecutable(
 260  const CompilerFilename: string): TModalResult;
 261var
 262  CompilerFiles: TStrings;
 263begin
 264  FTest:=cotCheckCompilerExe;
 265  LabelTest.Caption:=dlgCCOTestCheckingCompiler;
 266  try
 267    CheckIfFileIsExecutable(CompilerFilename);
 268  except
 269    on e: Exception do begin
 270      Result:=IDEQuestionDialog(lisCCOInvalidCompiler,
 271        Format(lisCCOCompilerNotAnExe,[CompilerFilename,LineEnding,E.Message]),
 272        mtError,[mrIgnore,lisCCOSkip,mrAbort]);
 273      exit;
 274    end;
 275  end;
 276
 277  // check if there are several compilers in path
 278  CompilerFiles:=SearchAllFilesInPath(GetDefaultCompilerFilename,'',
 279              GetEnvironmentVariableUTF8('PATH'),PathSeparator,[sffDontSearchInBasePath]);
 280  try
 281    ResolveLinksInFileList(CompilerFiles,false);
 282    RemoveDoubles(CompilerFiles);
 283    if (CompilerFiles<>nil) and (CompilerFiles.Count>1) then begin
 284      Result:=MessageDlg(lisCCOAmbiguousCompiler,
 285        Format(lisCCOSeveralCompilers,
 286              [LineEnding+LineEnding,CompilerFiles.Text,LineEnding]),
 287        mtWarning,[mbAbort,mbIgnore],0);
 288      if Result<>mrIgnore then exit;
 289    end;
 290  finally
 291    CompilerFiles.Free;
 292  end;
 293  
 294  Result:=mrOk;
 295end;
 296
 297function TCheckCompilerOptsDlg.CheckCompileBogusFile(
 298  const CompilerFilename: string): TModalResult;
 299var
 300  TestDir: String;
 301  BogusFilename: String;
 302  CmdLineParams: String;
 303  CompileTool: TAbstractExternalTool;
 304begin
 305  // compile bogus file
 306  FTest:=cotCompileBogusFiles;
 307  LabelTest.Caption:=dlgCCOTestCompilingEmptyFile;
 308  
 309  // get Test directory
 310  TestDir:=AppendPathDelim(LazarusIDE.GetTestBuildDirectory);
 311  if not DirPathExists(TestDir) then begin
 312    IDEMessageDialog(lisCCOInvalidTestDir,
 313      Format(lisCCOCheckTestDir,[LineEnding]),
 314      mtError,[mbCancel]);
 315    Result:=mrCancel;
 316    exit;
 317  end;
 318  // create bogus file
 319  BogusFilename:=CreateNonExistingFilename(TestDir+'testcompileroptions.pas');
 320  if not CreateEmptyFile(BogusFilename) then begin
 321    IDEMessageDialog(lisCCOUnableToCreateTestFile,
 322      Format(lisCCOUnableToCreateTestPascalFile,[BogusFilename]),
 323      mtError,[mbCancel]);
 324    Result:=mrCancel;
 325    exit;
 326  end;
 327  try
 328    // create compiler command line options
 329    CmdLineParams:=Options.MakeOptionsString(
 330              [ccloAddVerboseAll,ccloDoNotAppendOutFileOption,ccloAbsolutePaths])
 331              +' '+BogusFilename;
 332    CompileTool:=ExternalToolList.Add(dlgCCOTestToolCompilingEmptyFile);
 333    CompileTool.Reference(Self,ClassName);
 334    try
 335      CompileTool.AddParsers(SubToolFPC);
 336      CompileTool.AddParsers(SubToolMake);
 337      CompileTool.Process.CurrentDirectory:=TestDir;
 338      CompileTool.Process.Executable:=CompilerFilename;
 339      CompileTool.CmdLineParams:=CmdLineParams;
 340      CompileTool.Execute;
 341      CompileTool.WaitForExit;
 342    finally
 343      CompileTool.Release(Self);
 344    end;
 345  finally
 346    DeleteFileUTF8(BogusFilename);
 347  end;
 348  
 349  Result:=mrOk;
 350end;
 351
 352function TCheckCompilerOptsDlg.CheckPackagePathsIntersections(
 353  CurOptions: TCompilerOptions): TModalResult;
 354// check if the search paths contains source directories of used packages
 355// instead of only the output directories
 356var
 357  CurProject: TProject;
 358  CurPkg: TLazPackage;
 359  FirstDependency: TPkgDependency;
 360  PkgList: TFPList;
 361  i: Integer;
 362  UsedPkg: TLazPackage;
 363  UnitPath: String;
 364  OtherOutputDir: String;
 365  OtherSrcPath: String;
 366  p: Integer;
 367  SrcDir: String;
 368begin
 369  if CurOptions.BaseDirectory='' then exit(mrOk);
 370
 371  // get dependencies
 372  CurProject:=nil;
 373  CurPkg:=nil;
 374  if CurOptions.Owner is TProject then begin
 375    CurProject:=TProject(CurOptions.Owner);
 376    FirstDependency:=CurProject.FirstRequiredDependency;
 377  end;
 378  if CurOptions.Owner is TLazPackage then begin
 379    CurPkg:=TLazPackage(CurOptions.Owner);
 380    FirstDependency:=CurPkg.FirstRequiredDependency;
 381  end;
 382  if FirstDependency=nil then exit(mrOK);
 383  try
 384    // get used packages
 385    PackageGraph.GetAllRequiredPackages(nil,FirstDependency,PkgList,[pirSkipDesignTimeOnly]);
 386    if PkgList=nil then exit(mrOk);
 387
 388    // get search path
 389    UnitPath:=CurOptions.GetParsedPath(pcosUnitPath,icoNone,false,true);
 390    // check each used package
 391    for i:=0 to PkgList.Count-1 do begin
 392      UsedPkg:=TLazPackage(PkgList[i]);
 393      if UsedPkg.CompilerOptions.BaseDirectory='' then exit;
 394      // get source directories of used package (excluding the output directory)
 395      OtherSrcPath:=UsedPkg.CompilerOptions.GetParsedPath(pcosUnitPath,icoNone,false,true);
 396      OtherOutputDir:=UsedPkg.CompilerOptions.GetUnitOutPath(false);
 397      OtherSrcPath:=RemoveSearchPaths(OtherSrcPath,OtherOutputDir);
 398      // find intersections
 399      p:=1;
 400      repeat
 401        SrcDir:=GetNextDirectoryInSearchPath(UnitPath,p);
 402        if SearchDirectoryInSearchPath(OtherSrcPath,SrcDir)>0 then
 403          AddWarning(Format(lisTheUnitSearchPathOfContainsTheSourceDirectoryOfPac,
 404                            [CurOptions.GetOwnerName, SrcDir, UsedPkg.Name]));
 405      until p>length(UnitPath);
 406    end;
 407  finally
 408    PkgList.Free;
 409  end;
 410  Result:=mrOk;
 411end;
 412
 413function TCheckCompilerOptsDlg.CheckCompilerConfig(
 414  CfgCache: TFPCTargetConfigCache): TModalResult;
 415var
 416  i: Integer;
 417  CfgFile: TFPCConfigFileState;
 418  CfgCount: Integer;
 419begin
 420  FTest:=cotCheckCompilerConfig;
 421  LabelTest.Caption:=dlgCCOTestCheckingCompilerConfig;
 422
 423  CfgCount:=0;
 424  for i:=0 to CfgCache.ConfigFiles.Count-1 do begin
 425    CfgFile:=CfgCache.ConfigFiles[i];
 426    if CfgFile.FileExists then inc(CfgCount);
 427  end;
 428  if CfgCount<0 then begin
 429    // missing config file => warning
 430    AddWarning(lisCCONoCfgFound);
 431  end else if CfgCount=1 then begin
 432    // exactly one config, sounds good, but might still the be wrong one
 433    // => hint
 434    for i:=0 to CfgCache.ConfigFiles.Count-1 do begin
 435      CfgFile:=CfgCache.ConfigFiles[i];
 436      if CfgFile.FileExists then begin
 437        AddHint(Format(dlgCCOUsingConfigFile, [CfgFile.Filename]));
 438        break;
 439      end;
 440    end;
 441  end else if CfgCount>1 then begin
 442    // multiple config files => warning
 443    for i:=0 to CfgCache.ConfigFiles.Count-1 do begin
 444      CfgFile:=CfgCache.ConfigFiles[i];
 445      if CfgFile.FileExists then
 446        AddWarning(lisCCOMultipleCfgFound+CfgFile.Filename);
 447    end;
 448  end;
 449
 450  Result:=mrOk;
 451end;
 452
 453function TCheckCompilerOptsDlg.FindAllPPUFiles(const AnUnitPath: string
 454  ): TStrings;
 455var
 456  Directory: String;
 457  p: Integer;
 458  FileInfo: TSearchRec;
 459begin
 460  Result:=TStringList.Create;
 461
 462  p:=1;
 463  while p<=length(AnUnitPath) do begin
 464    Directory:=TrimAndExpandDirectory(GetNextDirectoryInSearchPath(AnUnitPath,p));
 465    if Directory<>'' then begin
 466      if FindFirstUTF8(Directory+GetAllFilesMask,faAnyFile,FileInfo)=0
 467      then begin
 468        repeat
 469          // check if special file
 470          if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
 471            continue;
 472          // check extension
 473          if CompareFileExt(FileInfo.Name,'.ppu',
 474            {$IFDEF MSWINDOWS}false{$ELSE}true{$ENDIF})=0 then
 475            Result.Add(Directory+FileInfo.Name);
 476        until FindNextUTF8(FileInfo)<>0;
 477      end;
 478      FindCloseUTF8(FileInfo);
 479    end;
 480  end;
 481end;
 482
 483function TCheckCompilerOptsDlg.CheckMissingFPCPPUs(
 484  CfgCache: TFPCTargetConfigCache): TModalResult;
 485  
 486  function Check(const TheUnitname: string; Severity: TCompilerCheckMsgLvl
 487    ): Boolean;
 488  begin
 489    if (CfgCache.Units<>nil)
 490    and (CfgCache.Units.Contains(TheUnitname)) then exit(true);
 491    AddMsg(Severity,Format(lisCCOMsgPPUNotFound,[TheUnitname]));
 492    Result:=ord(Severity)>=ord(ccmlError);
 493    if not Result then begin
 494      if IDEMessageDialog(lisCCOMissingUnit,
 495        Format(lisCCOPPUNotFoundDetailed,[TheUnitname, LineEnding]),
 496        mtError,[mbIgnore,mbAbort])=mrIgnore then
 497          Result:=true;
 498    end;
 499  end;
 500  
 501begin
 502  FTest:=cotCheckMissingFPCPPUs;
 503  LabelTest.Caption:=dlgCCOTestMissingPPU;
 504
 505  Result:=mrCancel;
 506
 507  if not Check('system',ccmlError) then exit;
 508  if not Check('objpas',ccmlError) then exit;
 509
 510  if CfgCache.TargetCPU='jvm' then begin
 511    if not Check('uuchar',ccmlError) then exit;
 512  end else begin
 513    if not Check('sysutils',ccmlError) then exit;
 514    if not Check('classes',ccmlError) then exit;
 515    if not Check('avl_tree',ccmlError) then exit;
 516    if not Check('zstream',ccmlError) then exit;
 517  end;
 518
 519  Result:=mrOk;
 520end;
 521
 522function TCheckCompilerOptsDlg.CheckCompilerDate(CfgCache: TFPCTargetConfigCache
 523  ): TModalResult;
 524var
 525  MinPPUDate: LongInt;
 526  MaxPPUDate: LongInt;
 527  CompilerDate: LongInt;
 528  MinPPU: String;
 529  MaxPPU: String;
 530  Node: TAVLTreeNode;
 531  Item: PStringToStringTreeItem;
 532  
 533  procedure CheckFileAge(const aFilename: string);
 534  var
 535    CurDate: LongInt;
 536  begin
 537    CurDate:=FileAgeCached(aFilename);
 538    //DebugLn(['CheckFileAge ',aFilename,' ',CurDate]);
 539    if (CurDate=-1) then exit;
 540    if (MinPPUDate=-1) or (MinPPUDate>CurDate) then begin
 541      MinPPUDate:=CurDate;
 542      MinPPU:=aFilename;
 543    end;
 544    if (MaxPPUDate=-1) or (MaxPPUDate<CurDate) then begin
 545      MaxPPUDate:=CurDate;
 546      MaxPPU:=aFilename;
 547    end;
 548  end;
 549  
 550  procedure CheckFileAgeOfUnit(const aUnitName: string);
 551  var
 552    Filename: string;
 553  begin
 554    Filename:=CfgCache.Units[aUnitName];
 555    if Filename='' then exit;
 556    CheckFileAge(Filename);
 557  end;
 558  
 559begin
 560  if CfgCache.Units=nil then exit(mrOK);
 561
 562  FTest:=cotCheckCompilerDate;
 563  LabelTest.Caption:=dlgCCOTestCompilerDate;
 564
 565  Result:=mrCancel;
 566  
 567  CompilerDate:=CfgCache.CompilerDate;
 568
 569  // first check some rtl and fcl units
 570  // They are normally installed in one step, so the dates should be nearly
 571  // the same. If not, then probably two different installations are mixed up.
 572  MinPPUDate:=-1;
 573  MinPPU:='';
 574  MaxPPUDate:=-1;
 575  MaxPPU:='';
 576  CheckFileAgeOfUnit('system');
 577  CheckFileAgeOfUnit('sysutils');
 578  CheckFileAgeOfUnit('classes');
 579  CheckFileAgeOfUnit('base64');
 580  CheckFileAgeOfUnit('avl_tree');
 581  CheckFileAgeOfUnit('fpimage');
 582  
 583  //DebugLn(['TCheckCompilerOptsDlg.CheckCompilerDate MinPPUDate=',MinPPUDate,' MaxPPUDate=',MaxPPUDate,' compdate=',CompilerDate]);
 584
 585  if MinPPU<>'' then begin
 586    if MaxPPUDate-MinPPUDate>3600 then begin
 587      // the FPC .ppu files dates differ more than one hour
 588      Result:=MessageDlg(lisCCOWarningCaption,
 589        Format(lisCCODatesDiffer,[LineEnding,LineEnding,MinPPU,LineEnding,MaxPPU]),
 590        mtError,[mbIgnore,mbAbort],0);
 591      if Result<>mrIgnore then
 592        exit;
 593    end;
 594  end;
 595
 596  // check file dates of all .ppu
 597  // if a .ppu is much older than the compiler itself, then the ppu is probably
 598  // a) a leftover from a installation
 599  // b) not updated
 600  Node:=CfgCache.Units.Tree.FindLowest;
 601  while Node<>nil do begin
 602    Item:=PStringToStringTreeItem(Node.Data);
 603    if (Item^.Value<>'') and (CompareFileExt(Item^.Value,'.ppu',false)=0) then
 604      CheckFileAge(Item^.Value);
 605    Node:=CfgCache.Units.Tree.FindSuccessor(Node);
 606  end;
 607
 608  if MinPPU<>'' then begin
 609    if CompilerDate-MinPPUDate>300 then begin
 610      // the compiler is more than 5 minutes newer than one of the ppu files
 611      Result:=MessageDlg(lisCCOWarningCaption,
 612        Format(lisCCOPPUOlderThanCompiler, [LineEnding, MinPPU]),
 613        mtError,[mbIgnore,mbAbort],0);
 614      if Result<>mrIgnore then
 615        exit;
 616    end;
 617  end;
 618
 619  Result:=mrOk;
 620end;
 621
 622function TCheckCompilerOptsDlg.CheckForAmbiguousPPUs(SearchForPPUs: TStrings;
 623  SearchInPPUs: TStrings): TModalResult;
 624var
 625  i: Integer;
 626  j: Integer;
 627  CurUnitName: String;
 628  AnotherUnitName: String;
 629begin
 630  if SearchInPPUs=nil then
 631    SearchInPPUs:=SearchForPPUs;
 632
 633  // resolve links and remove doubles
 634  ResolveLinksInFileList(SearchForPPUs,true);
 635  RemoveDoubles(SearchForPPUs);
 636  if SearchForPPUs<>SearchInPPUs then begin
 637    ResolveLinksInFileList(SearchInPPUs,true);
 638    RemoveDoubles(SearchInPPUs);
 639  end;
 640
 641  for i:=1 to SearchForPPUs.Count-1 do begin
 642    CurUnitName:=ExtractFileNameOnly(SearchForPPUs[i]);
 643    if SearchForPPUs=SearchInPPUs then
 644      j:=i-1
 645    else
 646      j:=SearchInPPUs.Count-1;
 647    while j>=0 do begin
 648      AnotherUnitName:=ExtractFileNameOnly(SearchInPPUs[j]);
 649      if CompareText(AnotherUnitName,CurUnitName)=0 then begin
 650        // unit exists twice
 651        AddWarning(Format(lisCCOPPUExistsTwice,[SearchForPPUs[i],SearchInPPUs[j]]));
 652        break;
 653      end;
 654      dec(j);
 655    end;
 656  end;
 657  Result:=mrOk;
 658end;
 659
 660function TCheckCompilerOptsDlg.CheckFPCUnitPathsContainSources(
 661  const FPCCfgUnitPath: string): TModalResult;
 662// The FPC standard unit path does not include source directories.
 663// If it contain source directories the user added these unit paths himself.
 664// This is probably a hack and has two disadvantages:
 665// 1. The IDE ignores these paths
 666// 2. The user risks to create various .ppu for these sources which leads to
 667//    strange further compilation errors.
 668var
 669  p: Integer;
 670  Directory: String;
 671  FileInfo: TSearchRec;
 672  WarnedDirectories: TStringList;
 673begin
 674  FTest:=cotCheckFPCUnitPathsContainSources;
 675  LabelTest.Caption:=dlgCCOTestSrcInPPUPaths;
 676
 677  Result:=mrCancel;
 678  WarnedDirectories:=TStringList.Create;
 679  p:=1;
 680  while p<=length(FPCCfgUnitPath) do begin
 681    Directory:=TrimFilename(GetNextDirectoryInSearchPath(FPCCfgUnitPath,p));
 682    if (Directory<>'') then begin
 683      Directory:=TrimAndExpandDirectory(GetNextDirectoryInSearchPath(FPCCfgUnitPath,p));
 684      if (Directory<>'') and (FilenameIsAbsolute(Directory))
 685      and (WarnedDirectories.IndexOf(Directory)<0) then begin
 686        //DebugLn(['TCheckCompilerOptsDlg.CheckFPCUnitPathsContainSources Directory="',Directory,'"']);
 687        if FindFirstUTF8(Directory+GetAllFilesMask,faAnyFile,FileInfo)=0
 688        then begin
 689          repeat
 690            // check if special file
 691            if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
 692              continue;
 693            // check extension
 694            if FilenameIsPascalUnit(FileInfo.Name) then begin
 695              AddWarning(lisCCOFPCUnitPathHasSource+Directory+FileInfo.Name);
 696              WarnedDirectories.Add(Directory);
 697              break;
 698            end;
 699          until FindNextUTF8(FileInfo)<>0;
 700        end;
 701        FindCloseUTF8(FileInfo);
 702      end;
 703    end;
 704  end;
 705  WarnedDirectories.Free;
 706  Result:=mrOk;
 707end;
 708
 709function TCheckCompilerOptsDlg.CheckOutputPathInSourcePaths(
 710  CurOptions: TCompilerOptions): TModalResult;
 711var
 712  OutputDir: String;
 713  SrcPath: String;
 714begin
 715  OutputDir:=CurOptions.GetUnitOutPath(false);
 716  if OutputDir='' then begin
 717    if CurOptions.Owner is TLazPackage then
 718      AddWarning(CurOptions.GetOwnerName+' has no output directory set');
 719    exit(mrOk);
 720  end;
 721  // check unit search path
 722  SrcPath:=CurOptions.GetParsedPath(pcosUnitPath,icoNone,false);
 723  if SearchDirectoryInSearchPath(SrcPath,OutputDir)>0 then begin
 724    AddWarning(Format(lisTheOutputDirectoryOfIsListedInTheUnitSearchPathOf, [
 725      CurOptions.GetOwnerName, CurOptions.GetOwnerName])
 726      +lisTheOutputDirectoryShouldBeASeparateDirectoryAndNot);
 727  end;
 728  // check include search path
 729  SrcPath:=CurOptions.GetParsedPath(pcosIncludePath,icoNone,false);
 730  if SearchDirectoryInSearchPath(SrcPath,OutputDir)>0 then begin
 731    AddWarning(Format(lisTheOutputDirectoryOfIsListedInTheIncludeSearchPath, [
 732      CurOptions.GetOwnerName, CurOptions.GetOwnerName])
 733      +lisTheOutputDirectoryShouldBeASeparateDirectoryAndNot);
 734  end;
 735  // check inherited unit search path
 736  SrcPath:=CurOptions.GetParsedPath(pcosNone,icoUnitPath,false);
 737  if SearchDirectoryInSearchPath(SrcPath,OutputDir)>0 then begin
 738    AddWarning(Format(lisTheOutputDirectoryOfIsListedInTheInheritedUnitSear, [
 739      CurOptions.GetOwnerName, CurOptions.GetOwnerName])
 740      +lisTheOutputDirectoryShouldBeASeparateDirectoryAndNot);
 741  end;
 742  // check inherited include search path
 743  SrcPath:=CurOptions.GetParsedPath(pcosNone,icoIncludePath,false);
 744  if SearchDirectoryInSearchPath(SrcPath,OutputDir)>0 then begin
 745    AddWarning(Format(lisTheOutputDirectoryOfIsListedInTheInheritedIncludeS, [
 746      CurOptions.GetOwnerName, CurOptions.GetOwnerName])
 747      +lisTheOutputDirectoryShouldBeASeparateDirectoryAndNot);
 748  end;
 749  Result:=mrOk;
 750end;
 751
 752function TCheckCompilerOptsDlg.CheckOrphanedPPUs(CurOptions: TCompilerOptions
 753  ): TModalResult;
 754// check for ppu and .o files that were not created from known .pas/.pp/.p files
 755var
 756  FileInfo: TSearchRec;
 757  PPUFiles: TStringList;
 758  i: Integer;
 759  OutputDir: String;
 760  PPUFilename: string;
 761  AUnitName: String;
 762  SrcPath: String;
 763  Directory: String;
 764  CurProject: TLazProject;
 765  ProjFile: TLazProjectFile;
 766begin
 767  OutputDir:=CurOptions.GetUnitOutPath(false);
 768  if OutputDir='' then exit(mrOk);
 769
 770  PPUFiles:=TStringList.Create;
 771  try
 772    // search .ppu and .o files in output directory
 773    Directory:=AppendPathDelim(OutputDir);
 774    if FindFirstUTF8(Directory+GetAllFilesMask,faAnyFile,FileInfo)=0 then
 775    begin
 776      repeat
 777        // check if special file
 778        if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
 779          continue;
 780        // check extension
 781        if (CompareFileExt(FileInfo.Name,'.ppu',
 782          {$IFDEF MSWINDOWS}false{$ELSE}true{$ENDIF})<>0)
 783        and (CompareFileExt(FileInfo.Name,'.o',
 784          {$IFDEF MSWINDOWS}false{$ELSE}true{$ENDIF})<>0)
 785        then
 786          continue;
 787        PPUFiles.Add(Directory+FileInfo.Name);
 788      until FindNextUTF8(FileInfo)<>0;
 789    end;
 790    FindCloseUTF8(FileInfo);
 791
 792    // remove all .ppu/.o files with a unit source
 793    SrcPath:=Options.GetParsedPath(pcosUnitPath,icoNone,false,true);
 794    //DebugLn(['TCheckCompilerOptsDlg.CheckOrphanedPPUs SrcPath="',SrcPath,'" OutDir="',OutputDir,'"']);
 795    for i:=PPUFiles.Count-1 downto 0 do begin
 796      PPUFilename:=PPUFiles[i];
 797      AUnitName:=ExtractFileNameOnly(PPUFilename);
 798      // search .pas/.pp/.p file
 799      if SearchPascalUnitInPath(AUnitName,'',SrcPath,';',ctsfcAllCase)<>'' then
 800        PPUFiles.Delete(i)
 801      // check for main source
 802      else if (Options.Owner is TLazProject) then begin
 803        CurProject:=TLazProject(Options.Owner);
 804        if (CurProject.MainFileID>=0) then begin
 805          ProjFile:=CurProject.MainFile;
 806          if (SysUtils.CompareText(ExtractFileNameOnly(ProjFile.Filename),AUnitName)=0)
 807          then
 808            PPUFiles.Delete(i);
 809        end;
 810      end;
 811    end;
 812
 813    // PPUFiles now contains all orphaned ppu/o files
 814    PPUFiles.Sort;
 815    for i:=0 to PPUFiles.Count-1 do
 816      AddWarning(Format(dlgCCOOrphanedFileFound, [PPUFiles[i]]));
 817  finally
 818    PPUFiles.Free;
 819  end;
 820
 821  Result:=mrOk;
 822end;
 823
 824procedure TCheckCompilerOptsDlg.SetMacroList(const AValue: TTransferMacroList);
 825begin
 826  if FMacroList=AValue then exit;
 827  FMacroList:=AValue;
 828end;
 829
 830procedure TCheckCompilerOptsDlg.SetIdleConnected(const AValue: boolean);
 831begin
 832  if FIdleConnected=AValue then exit;
 833  FIdleConnected:=AValue;
 834  if FIdleConnected then
 835    Application.AddOnIdleHandler(@ApplicationOnIdle)
 836  else
 837    Application.RemoveOnIdleHandler(@ApplicationOnIdle);
 838end;
 839
 840function TCheckCompilerOptsDlg.DoTestAll: TModalResult;
 841var
 842  CompilerFilename: String;
 843  CompileTool: TAbstractExternalTool;
 844  CompilerFiles: TStrings;
 845  FPCCfgUnitPath: string;
 846  TargetUnitPath: String;
 847  Target_PPUs: TStrings;
 848  cp: TParsedCompilerOptString;
 849  TargetCPU: String;
 850  TargetOS: String;
 851  CfgCache: TFPCTargetConfigCache;
 852  FPC_PPUs: TStrings;
 853begin
 854  Result:=mrCancel;
 855  if Test<>cotNone then exit;
 856  CompileTool:=nil;
 857  TestMemo.Lines.Clear;
 858  CompilerFiles:=nil;
 859  Target_PPUs:=nil;
 860  FPC_PPUs:=nil;
 861  IDEMessagesWindow.Clear;
 862  Screen.Cursor:=crHourGlass;
 863  try
 864    // make sure there is no invalid cache due to bugs
 865    InvalidateFileStateCache();
 866
 867    // check for special characters in search paths
 868    for cp:=Low(TParsedCompilerOptString) to High(TParsedCompilerOptString) do
 869    begin
 870      if cp in ParsedCompilerSearchPaths then begin
 871        Result:=CheckSpecialCharsInPath(copy(EnumToStr(cp),5,100),
 872                                        Options.ParsedOpts.GetParsedValue(cp));
 873        if not (Result in [mrOk,mrIgnore]) then exit;
 874      end;
 875    end;
 876    
 877    // check for non existing paths
 878    CheckNonExistingSearchPaths('include search path',Options.GetIncludePath(false));
 879    CheckNonExistingSearchPaths('library search path',Options.GetLibraryPath(false));
 880    CheckNonExistingSearchPaths('unit search path',   Options.GetUnitPath(false));
 881    CheckNonExistingSearchPaths('source search path', Options.GetSrcPath(false));
 882
 883    // fetch compiler filename
 884    CompilerFilename:=Options.ParsedOpts.GetParsedValue(pcosCompilerPath);
 885
 886    // check compiler filename
 887    Result:=CheckCompilerExecutable(CompilerFilename);
 888    if not (Result in [mrOk,mrIgnore]) then exit;
 889
 890    TargetOS:=Options.TargetOS;
 891    TargetCPU:=Options.TargetCPU;
 892    CfgCache:=CodeToolBoss.FPCDefinesCache.ConfigCaches.Find(CompilerFilename,
 893                                                    '',TargetOS,TargetCPU,true);
 894    if CfgCache.NeedsUpdate then
 895      CfgCache.Update(CodeToolBoss.FPCDefinesCache.TestFilename,
 896                      CodeToolBoss.FPCDefinesCache.ExtraOptions);
 897
 898    // check compiler config
 899    Result:=CheckCompilerConfig(CfgCache);
 900    if not (Result in [mrOk,mrIgnore]) then exit;
 901
 902    // check if compiler paths include base units
 903    Result:=CheckMissingFPCPPUs(CfgCache);
 904    if not (Result in [mrOk,mrIgnore]) then exit;
 905
 906    // check if compiler is older than fpc ppu
 907    Result:=CheckCompilerDate(CfgCache);
 908    if not (Result in [mrOk,mrIgnore]) then exit;
 909
 910    // check if there are ambiguous fpc ppu
 911    FPCCfgUnitPath:=CfgCache.GetUnitPaths;
 912    FPC_PPUs:=FindAllPPUFiles(FPCCfgUnitPath);
 913    Result:=CheckForAmbiguousPPUs(FPC_PPUs);
 914    if not (Result in [mrOk,mrIgnore]) then exit;
 915
 916    // check if FPC unit paths contain sources
 917    Result:=CheckFPCUnitPathsContainSources(FPCCfgUnitPath);
 918    if not (Result in [mrOk,mrIgnore]) then exit;
 919
 920    if Options is TPkgCompilerOptions then begin
 921      // check if package has no separate output directory
 922      Result:=CheckOutputPathInSourcePaths(Options);
 923      if not (Result in [mrOk,mrIgnore]) then exit;
 924    end;
 925
 926    // gather PPUs in project/package unit search paths
 927    TargetUnitPath:=Options.GetUnitPath(false);
 928    Target_PPUs:=FindAllPPUFiles(TargetUnitPath);
 929
 930    // check if there are ambiguous ppu in project/package unit path
 931    Result:=CheckForAmbiguousPPUs(Target_PPUs);
 932    if not (Result in [mrOk,mrIgnore]) then exit;
 933
 934    // check if there are ambiguous ppu in fpc and project/package unit path
 935    Result:=CheckForAmbiguousPPUs(FPC_PPUs,Target_PPUs);
 936    if not (Result in [mrOk,mrIgnore]) then exit;
 937
 938    // check that all ppu in the output directory have sources in project/package
 939    Result:=CheckOrphanedPPUs(Options);
 940    if not (Result in [mrOk,mrIgnore]) then exit;
 941
 942    // compile bogus file
 943    Result:=CheckCompileBogusFile(CompilerFilename);
 944    if not (Result in [mrOk,mrIgnore]) then exit;
 945    
 946    // check if search paths of packages/projects intersects
 947    Result:=CheckPackagePathsIntersections(Options);
 948    if not (Result in [mrOk,mrIgnore]) then exit;
 949
 950    // ToDo: check ppu checksums and versions
 951
 952    if OutputTreeView.Items.Count=0 then
 953      AddMsg(lisCCOTestsSuccess,'',-1);
 954
 955  finally
 956    Screen.Cursor:=crDefault;
 957    CompilerFiles.Free;
 958    CompileTool.Free;
 959    FTest:=cotNone;
 960    LabelTest.Caption:=dlgCCOTest;
 961    FPC_PPUs.Free;
 962    Target_PPUs.Free;
 963  end;
 964  Result:=mrOk;
 965end;
 966
 967constructor TCheckCompilerOptsDlg.Create(TheOwner: TComponent);
 968begin
 969  inherited Create(TheOwner);
 970  IdleConnected:=true;
 971  Caption:=dlgCCOCaption;
 972  LabelTest.Caption:=dlgCCOTest;
 973  LabelOutput.Caption:=dlgCCOResults;
 974  CopyOutputMenuItem.Caption:=lisCCOCopyOutputToCliboard;
 975end;
 976
 977destructor TCheckCompilerOptsDlg.Destroy;
 978begin
 979  IdleConnected:=false;;
 980  FDirectories.Free;
 981  inherited Destroy;
 982end;
 983
 984procedure TCheckCompilerOptsDlg.Add(const Msg, CurDir: String;
 985  ProgressLine: boolean; OriginalIndex: integer);
 986var
 987  i: Integer;
 988begin
 989  if FLastLineIsProgress then begin
 990    OutputTreeView.Items[OutputTreeView.Items.Count-1].Text:=Msg;
 991  end else begin
 992    OutputTreeView.Items.Add(nil,Msg);
 993  end;
 994  FLastLineIsProgress:=ProgressLine;
 995  i:=OutputTreeView.Items.Count-1;
 996  SetMsgDirectory(i,CurDir);
 997  OutputTreeView.TopItem:=OutputTreeView.Items.GetLastNode;
 998  if OriginalIndex=0 then ;
 999end;
1000
1001procedure TCheckCompilerOptsDlg.AddMsg(const Msg, CurDir: String;
1002  OriginalIndex: integer);
1003begin
1004  Add(Msg,CurDir,false,OriginalIndex);
1005end;
1006
1007procedure TCheckCompilerOptsDlg.AddHint(const Msg: string);
1008begin
1009  AddMsg(ccmlHint,Msg);
1010end;
1011
1012procedure TCheckCompilerOptsDlg.AddWarning(const Msg: string);
1013begin
1014  AddMsg(ccmlWarning,Msg);
1015end;
1016
1017procedure TCheckCompilerOptsDlg.AddMsg(const Level: TCompilerCheckMsgLvl;
1018  const Msg: string);
1019begin
1020  case Level of
1021  ccmlWarning: Add(lisCCOWarningMsg+Msg,'',false,-1);
1022  ccmlHint:    Add(lisCCOHintMsg+Msg,'',false,-1);
1023  else         Add(lisCCOErrorMsg+Msg,'',false,-1);
1024  end;
1025end;
1026
1027end.
1028