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