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