/ide/compiler.pp

http://github.com/graemeg/lazarus · Puppet · 1457 lines · 1414 code · 43 blank · 0 comment · 46 complexity · f97c36594d039951a97896d269337201 MD5 · raw file

  1. {
  2. /***************************************************************************
  3. compiler.pp - Lazarus IDE unit
  4. -------------------------------------
  5. TCompiler is responsible for configuration and running
  6. the Free Pascal Compiler.
  7. Initial Revision : Sun Mar 28 23:15:32 CST 1999
  8. ***************************************************************************/
  9. ***************************************************************************
  10. * *
  11. * This source is free software; you can redistribute it and/or modify *
  12. * it under the terms of the GNU General Public License as published by *
  13. * the Free Software Foundation; either version 2 of the License, or *
  14. * (at your option) any later version. *
  15. * *
  16. * This code is distributed in the hope that it will be useful, but *
  17. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  18. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  19. * General Public License for more details. *
  20. * *
  21. * A copy of the GNU General Public License is available on the World *
  22. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  23. * obtain it by writing to the Free Software Foundation, *
  24. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  25. * *
  26. ***************************************************************************
  27. }
  28. unit Compiler;
  29. {$mode objfpc}
  30. {$H+}
  31. interface
  32. uses
  33. Classes, SysUtils, LCLProc, Forms, Controls, contnrs, strutils,
  34. IDEExternToolIntf, IDEMsgIntf, LazIDEIntf, LazUTF8,
  35. IDECmdLine, LazarusIDEStrConsts, CompilerOptions, Project,
  36. DefineTemplates, TransferMacros, EnvironmentOpts, LazFileUtils;
  37. type
  38. TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean) of object;
  39. { TCompiler }
  40. TCompiler = class(TObject)
  41. private
  42. FOnCmdLineCreate : TOnCmdLineCreate;
  43. public
  44. constructor Create;
  45. destructor Destroy; override;
  46. function Compile(AProject: TProject;
  47. const WorkingDir, CompilerFilename, CompilerParams: string;
  48. BuildAll, SkipLinking, SkipAssembler: boolean;
  49. const aCompileHint: string
  50. ): TModalResult;
  51. procedure WriteError(const Msg: string);
  52. end;
  53. // Following classes are for compiler options parsed from "fpc -h" and "fpc -i".
  54. TCompilerOptEditKind = (
  55. oeGroup, // A header for a group
  56. oeSet, // A header for a set
  57. oeSetElem, // One char element of a set, use CheckBox
  58. oeSetNumber, // Number element of a set, use Edit
  59. oeBoolean, // True/False, typically use CheckBox
  60. oeText, // Textual value
  61. oeNumber, // Numeric value
  62. oeList // Pre-defined list of choices
  63. );
  64. TCompilerOptGroup = class;
  65. { TCompilerOpt }
  66. TCompilerOpt = class
  67. private
  68. fOwnerGroup: TCompilerOptGroup;
  69. fId: integer; // Identification.
  70. fOption: string; // Option with the leading '-'.
  71. fSuffix: string; // <x> or similar suffix of option.
  72. fValue: string; // Data entered by user, 'True' for Boolean.
  73. fOrigLine: integer; // Original line in the input data.
  74. fEditKind: TCompilerOptEditKind;
  75. fDescription: string;
  76. fIndentation: integer; // Indentation level in "fpc -h" output.
  77. fVisible: Boolean; // Used for filtering.
  78. fIgnored: Boolean; // Pretend this option does not exist.
  79. fChoices: TStrings; // Choices got from "fpc -i"
  80. procedure AddChoicesByOptOld;
  81. function Comment: string;
  82. procedure Filter(aFilter: string; aOnlySelected: Boolean);
  83. function GenerateOptValue(aUseComments: Boolean): string;
  84. procedure SetValue(aValue: string; aOrigLine: integer);
  85. protected
  86. procedure ParseEditKind; virtual;
  87. procedure ParseOption(aDescr: string; aIndent: integer); virtual;
  88. public
  89. constructor Create(aOwnerGroup: TCompilerOptGroup);
  90. destructor Destroy; override;
  91. function CalcLeft(aDefaultLeft, aLimit: integer): integer;
  92. public
  93. property Id: integer read fId;
  94. property Option: string read fOption;
  95. property Suffix: string read fSuffix;
  96. property Value: string read fValue write fValue;
  97. property EditKind: TCompilerOptEditKind read fEditKind;
  98. property Description: string read fDescription;
  99. property Indentation: integer read fIndentation;
  100. property Visible: Boolean read fVisible write fVisible;
  101. property Ignored: Boolean read fIgnored write fIgnored;
  102. property Choices: TStrings read fChoices;
  103. end;
  104. TCompilerOptList = TObjectList;
  105. TCompilerOptReader = class; // Forward reference
  106. { TCompilerOptGroup }
  107. // Group with explanation header. Actual options are not defined here.
  108. TCompilerOptGroup = class(TCompilerOpt)
  109. private
  110. fOwnerReader: TCompilerOptReader;
  111. // List of options belonging to this group.
  112. fCompilerOpts: TCompilerOptList;
  113. fIncludeNegativeOpt: Boolean; // Each option has a variation with "NO" appended.
  114. function OneCharOptions(aOptAndValue: string): TCompilerOpt;
  115. protected
  116. procedure ParseEditKind; override;
  117. procedure ParseOption(aDescr: string; aIndent: integer); override;
  118. public
  119. constructor Create(aOwnerReader: TCompilerOptReader; aOwnerGroup: TCompilerOptGroup);
  120. destructor Destroy; override;
  121. procedure Clear;
  122. function FindOption(aOptStr: string): TCompilerOpt;
  123. function FindOptionById(aId: integer): TCompilerOpt;
  124. function SelectOption(aOptAndValue: string): Boolean;
  125. procedure DeselectAll;
  126. public
  127. property CompilerOpts: TCompilerOptList read fCompilerOpts;
  128. end;
  129. { TCompilerOptSet }
  130. // A set of options. A combination of chars or numbers following the option char.
  131. TCompilerOptSet = class(TCompilerOptGroup)
  132. private
  133. fCommonIndent: integer; // Common indentation for this group fixed during parse.
  134. function SetNumberOpt(aValue: string): Boolean;
  135. function SetBooleanOpt(aValue: string): Boolean;
  136. protected
  137. procedure AddOptions(aDescr: string; aIndent: integer);
  138. procedure ParseEditKind; override;
  139. public
  140. constructor Create(aOwnerReader: TCompilerOptReader;
  141. aOwnerGroup: TCompilerOptGroup; aCommonIndent: integer);
  142. destructor Destroy; override;
  143. function CollectSelectedOptions(aUseComments: Boolean): string;
  144. procedure SelectOptions(aOptStr: string);
  145. property CommonIndent: integer read fCommonIndent write fCommonIndent;
  146. end;
  147. { TCompilerOptReader }
  148. TCompilerOptReader = class
  149. private
  150. fCurOrigLine: integer; // Current line num when parsing original data.
  151. // Defines (-d...) are separated from custom options and stored here.
  152. fDefines: TStringList;
  153. // Options not accepted by parser. They may still be valid (a macro maybe)
  154. fInvalidOptions: TStringList; // and will be included in output.
  155. // List of categories parsed from "fpc -i". Contains category names,
  156. // Objects[] contains another StringList for the selection list.
  157. fSupportedCategories: TStringList;
  158. // Hierarchy of options parsed from "fpc -h".
  159. fRootOptGroup: TCompilerOptGroup;
  160. fCompilerExecutable: string; // Compiler path must be set by caller.
  161. fFpcVersion: string; // Parsed from "fpc -h".
  162. fIsNewFpc: Boolean;
  163. fParsedTarget: String;
  164. fErrorMsg: String;
  165. fGeneratedOptions: TStringList; // Options generated from GUI.
  166. fUseComments: Boolean; // Add option's description into generated data.
  167. function AddChoicesNew(aOpt: string): TStrings;
  168. function AddNewCategory(aCategoryName: String): TStringList;
  169. function AddOptInLowestOrigLine(OutStrings: TStrings): Boolean;
  170. procedure CopyOptions(aRoot: TCompilerOpt);
  171. function FindLowestOrigLine(aStrings: TStrings; out aOrigLine: Integer): integer;
  172. function IsGroup(aOpt: string; var aCategoryList: TStrings): Boolean;
  173. function ReadCategorySelections(aChar: Char): TStringList;
  174. function ReadVersion(s: string): Boolean;
  175. procedure CreateNewGroupItem(aGroup: TCompilerOptGroup; aTxt: string);
  176. procedure AddGroupItems(aGroup: TCompilerOptGroup; aItems: TStrings);
  177. function ParseI(aLines: TStringList): TModalResult;
  178. function ParseH(aLines: TStringList): TModalResult;
  179. public
  180. constructor Create;
  181. destructor Destroy; override;
  182. procedure Clear;
  183. function UpdateTargetParam: Boolean;
  184. function ReadAndParseOptions: TModalResult;
  185. function FilterOptions(aFilter: string; aOnlySelected: Boolean): Boolean;
  186. function FindOptionById(aId: integer): TCompilerOpt;
  187. function FromCustomOptions(aStrings: TStrings): TModalResult;
  188. function ToCustomOptions(aStrings: TStrings; aUseComments: Boolean): TModalResult;
  189. public
  190. property Defines: TStringList read fDefines;
  191. //property SupportedCategories: TStringList read fSupportedCategories;
  192. property RootOptGroup: TCompilerOptGroup read fRootOptGroup;
  193. property CompilerExecutable: string read fCompilerExecutable write fCompilerExecutable;
  194. property ParsedTarget: String read fParsedTarget write fParsedTarget;
  195. property ErrorMsg: String read fErrorMsg write fErrorMsg;
  196. end;
  197. { TCompilerOptThread }
  198. TCompilerOptThread = class(TThread)
  199. private
  200. fReader: TCompilerOptReader;
  201. fReadTime: TDateTime;
  202. fStartedOnce: boolean;
  203. function GetErrorMsg: string;
  204. procedure Clear; // (main thread)
  205. protected
  206. procedure Execute; override;
  207. public
  208. constructor Create(aReader: TCompilerOptReader);
  209. destructor Destroy; override;
  210. procedure StartParsing; // (main thread)
  211. procedure EndParsing; // (main thread)
  212. public
  213. property ReadTime: TDateTime read fReadTime;
  214. property ErrorMsg: string read GetErrorMsg;
  215. end;
  216. implementation
  217. { TCompiler }
  218. {------------------------------------------------------------------------------
  219. TCompiler Constructor
  220. ------------------------------------------------------------------------------}
  221. constructor TCompiler.Create;
  222. begin
  223. inherited Create;
  224. end;
  225. {------------------------------------------------------------------------------
  226. TCompiler Destructor
  227. ------------------------------------------------------------------------------}
  228. destructor TCompiler.Destroy;
  229. begin
  230. inherited Destroy;
  231. end;
  232. {------------------------------------------------------------------------------
  233. TCompiler Compile
  234. ------------------------------------------------------------------------------}
  235. function TCompiler.Compile(AProject: TProject; const WorkingDir,
  236. CompilerFilename, CompilerParams: string; BuildAll, SkipLinking,
  237. SkipAssembler: boolean; const aCompileHint: string): TModalResult;
  238. var
  239. CmdLine : String;
  240. Abort : Boolean;
  241. Tool: TAbstractExternalTool;
  242. FPCParser: TFPCParser;
  243. Title: String;
  244. TargetOS: String;
  245. TargetCPU: String;
  246. TargetFilename: String;
  247. begin
  248. Result:=mrCancel;
  249. if ConsoleVerbosity>=1 then
  250. DebugLn('TCompiler.Compile WorkingDir="',WorkingDir,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"');
  251. try
  252. CheckIfFileIsExecutable(CompilerFilename);
  253. except
  254. on E: Exception do begin
  255. WriteError(Format(lisCompilerErrorInvalidCompiler, [E.Message]));
  256. if CompilerFilename='' then begin
  257. WriteError(lisCompilerHintYouCanSetTheCompilerPath);
  258. end;
  259. exit;
  260. end;
  261. end;
  262. CmdLine := '';
  263. if BuildAll then
  264. CmdLine := CmdLine+' -B';
  265. if SkipLinking and SkipAssembler then
  266. CmdLine := CmdLine+' -s'
  267. else if SkipLinking then
  268. CmdLine := CmdLine+' -Cn';
  269. if CompilerParams<>'' then
  270. CmdLine := CmdLine+' '+CompilerParams;
  271. if Assigned(FOnCmdLineCreate) then begin
  272. Abort:=false;
  273. FOnCmdLineCreate(CmdLine,Abort);
  274. if Abort then begin
  275. Result:=mrAbort;
  276. exit;
  277. end;
  278. end;
  279. if ConsoleVerbosity>=0 then
  280. DebugLn('[TCompiler.Compile] CmdLine="',CompilerFilename+CmdLine,'"');
  281. Title:=lisCompileProject;
  282. if AProject.BuildModes.Count>1 then
  283. Title+=Format(lisMode, [AProject.ActiveBuildMode.Identifier]);
  284. TargetOS:=AProject.CompilerOptions.GetEffectiveTargetOS;
  285. if TargetOS<>GetCompiledTargetOS then
  286. Title+=Format(lisOS, [TargetOS]);
  287. TargetCPU:=AProject.CompilerOptions.GetEffectiveTargetCPU;
  288. if TargetCPU<>GetCompiledTargetCPU then
  289. Title+=Format(lisCPU, [TargetCPU]);
  290. TargetFilename:=AProject.GetShortFilename(
  291. AProject.CompilerOptions.CreateTargetFilename,false);
  292. if TargetFilename<>'' then
  293. Title+=Format(lisTarget2, [TargetFilename]);
  294. Tool:=ExternalToolList.Add(Title);
  295. Tool.Reference(Self,ClassName);
  296. try
  297. Tool.Data:=TIDEExternalToolData.Create(IDEToolCompileProject,'',AProject.ProjectInfoFile);
  298. Tool.FreeData:=true;
  299. Tool.Hint:=aCompileHint;
  300. Tool.Process.Executable:=CompilerFilename;
  301. Tool.CmdLineParams:=CmdLine;
  302. Tool.Process.CurrentDirectory:=WorkingDir;
  303. FPCParser:=TFPCParser(Tool.AddParsers(SubToolFPC));
  304. FPCParser.ShowLinesCompiled:=EnvironmentOptions.MsgViewShowFPCMsgLinesCompiled;
  305. FPCParser.HideHintsSenderNotUsed:=not AProject.CompilerOptions.ShowHintsForSenderNotUsed;
  306. FPCParser.HideHintsUnitNotUsedInMainSource:=not AProject.CompilerOptions.ShowHintsForUnusedUnitsInMainSrc;
  307. if (not AProject.CompilerOptions.ShowHintsForUnusedUnitsInMainSrc)
  308. and (AProject.MainFilename<>'') then
  309. FPCParser.FilesToIgnoreUnitNotUsed.Add(AProject.MainFilename);
  310. Tool.AddParsers(SubToolMake);
  311. Tool.Execute;
  312. Tool.WaitForExit;
  313. if Tool.ErrorMessage='' then
  314. Result:=mrOK;
  315. finally
  316. Tool.Release(Self);
  317. end;
  318. if ConsoleVerbosity>=0 then
  319. DebugLn('[TCompiler.Compile] end');
  320. end;
  321. procedure TCompiler.WriteError(const Msg: string);
  322. begin
  323. DebugLn('TCompiler.WriteError ',Msg);
  324. if IDEMessagesWindow<>nil then
  325. IDEMessagesWindow.AddCustomMessage(mluError,Msg);
  326. end;
  327. // Compiler options parsed from "fpc -h" and "fpc -i".
  328. var
  329. OptionIdCounter: integer;
  330. function NextOptionId: integer;
  331. begin
  332. Result := OptionIdCounter;
  333. Inc(OptionIdCounter);
  334. end;
  335. function CalcIndentation(s: string): integer;
  336. begin
  337. Result := 0;
  338. while (Result < Length(s)) and (s[Result+1] = ' ') do
  339. Inc(Result);
  340. end;
  341. function IsIgnoredOption(aOpt: string): Boolean;
  342. begin
  343. if Length(aOpt) < 2 then Exit(False);
  344. // Ignore : * information
  345. // * all file names and paths
  346. // * executable path
  347. // * change name of produced executable
  348. // * define and undefine
  349. // * set language mode
  350. // * target operating system
  351. Result := aOpt[2] in ['i', 'F', 'e', 'o', 'd', 'u', 'M', 'T'];
  352. end;
  353. { TCompilerOpt }
  354. constructor TCompilerOpt.Create(aOwnerGroup: TCompilerOptGroup);
  355. begin
  356. inherited Create;
  357. fOwnerGroup := aOwnerGroup;
  358. if Assigned(aOwnerGroup) then
  359. aOwnerGroup.fCompilerOpts.Add(Self);
  360. fId := NextOptionId;
  361. fOrigLine := -1;
  362. end;
  363. destructor TCompilerOpt.Destroy;
  364. begin
  365. inherited Destroy;
  366. end;
  367. procedure TCompilerOpt.AddChoicesByOptOld;
  368. // From FPC 2.6.x output
  369. procedure AddChoices(aCategory: string);
  370. // Add selection choices for this option. Data originates from "fpc -i".
  371. var
  372. i: Integer;
  373. begin
  374. with fOwnerGroup.fOwnerReader do
  375. if fSupportedCategories.Find(aCategory, i) then
  376. fChoices := fSupportedCategories.Objects[i] as TStrings
  377. else
  378. raise Exception.CreateFmt('No selection list for "%s" found.', [aCategory]);
  379. end;
  380. begin
  381. if Pos('fpc -i', fDescription) = 0 then Exit;
  382. fEditKind := oeList; // Values will be got later.
  383. case fOption of
  384. '-Ca': AddChoices('ABI targets:');
  385. '-Cf': AddChoices('FPU instruction sets:');
  386. '-Cp': AddChoices('CPU instruction sets:');
  387. // '-Oo', '-Oo[NO]': AddChoices('Optimizations:');
  388. '-Op': AddChoices('CPU instruction sets:');
  389. // '-OW': AddChoices('Whole Program Optimizations:');
  390. // '-Ow': AddChoices('Whole Program Optimizations:');
  391. else
  392. raise Exception.Create('Don''t know where to get selection list for option '+fOption);
  393. end;
  394. end;
  395. procedure TCompilerOpt.ParseEditKind;
  396. begin
  397. // Guess whether this option can be edited and what is the EditKind
  398. fEditKind := oeBoolean; // Default kind
  399. if (Length(fSuffix) = 3) and (fSuffix[1] = '<') and (fSuffix[3] = '>') then
  400. case fSuffix[2] of
  401. 'x': fEditKind:=oeText; // <x>
  402. 'n': fEditKind:=oeNumber; // <n>
  403. end;
  404. if fOwnerGroup.fOwnerReader.fIsNewFpc then begin
  405. fChoices := fOwnerGroup.fOwnerReader.AddChoicesNew(fDescription);
  406. if Assigned(fChoices) then
  407. fEditKind := oeList;
  408. end
  409. else
  410. AddChoicesByOptOld;
  411. end;
  412. procedure TCompilerOpt.ParseOption(aDescr: string; aIndent: integer);
  413. var
  414. i: Integer;
  415. begin
  416. fIndentation := aIndent;
  417. // Separate the actual option and description from each other
  418. if aDescr[1] <> '-' then
  419. raise Exception.CreateFmt('Option "%s" does not start with "-"', [aDescr]);
  420. i := 1;
  421. while (i <= Length(aDescr)) and (aDescr[i] <> ' ') do
  422. Inc(i);
  423. fOption := Copy(aDescr, 1, i-1);
  424. while (i <= Length(aDescr)) and (aDescr[i] = ' ') do
  425. Inc(i);
  426. fDescription := Copy(aDescr, i, Length(aDescr));
  427. i := Length(fOption);
  428. if (i > 3) and (fOption[i-2] = '<') and (fOption[i] = '>') then
  429. begin
  430. // Move <x> in the end to Suffix. We need the pure option later.
  431. fSuffix := Copy(fOption, i-2, i);
  432. fOption := Copy(fOption, 1, i-3);
  433. end;
  434. if fOwnerGroup.fIgnored or IsIgnoredOption(fOption) then
  435. fIgnored := True;
  436. ParseEditKind;
  437. end;
  438. procedure TCompilerOpt.Filter(aFilter: string; aOnlySelected: Boolean);
  439. var
  440. //iOpt, iDes: SizeInt;
  441. HideNonSelected: Boolean;
  442. begin
  443. HideNonSelected := (fValue='') and aOnlySelected;
  444. Visible := not (fIgnored or HideNonSelected)
  445. and ( (aFilter='') or (Pos(aFilter,UTF8LowerCase(fOption))>0)
  446. or (Pos(aFilter,UTF8LowerCase(fDescription))>0) );
  447. {
  448. if aFilter = '' then
  449. Visible := not (fIgnored or HideNonSelected)
  450. else begin
  451. iOpt := Pos(aFilter,UTF8LowerCase(fOption));
  452. iDes := Pos(aFilter,UTF8LowerCase(fDescription));
  453. Visible := not (fIgnored or HideNonSelected) and ( (iOpt>0) or (iDes>0) );
  454. if Visible then
  455. DebugLn(['TCompilerOpt.Filter match "', aFilter, '": iOpt=', iOpt,
  456. ', iDes=', iDes, ', Ignore=', fIgnored, ', aOnlySelected=', aOnlySelected,
  457. ', Opt'=fOption, ', Descr=', fDescription]);
  458. end;
  459. }
  460. end;
  461. const
  462. CommentId = '-dLazIdeComment_';
  463. function TCompilerOpt.Comment: string;
  464. begin
  465. Result := ' ' + CommentId + StringReplace(fDescription,' ','_',[rfReplaceAll]);
  466. end;
  467. function TCompilerOpt.GenerateOptValue(aUseComments: Boolean): string;
  468. begin
  469. if fValue = '' then Exit('');
  470. if fValue = 'True' then // Boolean
  471. Result := fOption
  472. else // or value of other kind
  473. Result := fOption + StrToCmdLineParam(Value);
  474. // ToDo: Show "//" comment in editor and change to a define when storing.
  475. // Result := ' // ' + aOpt.Description
  476. if aUseComments then // Replace illegal characters with '_' in comment
  477. Result := Result + Comment;
  478. end;
  479. procedure TCompilerOpt.SetValue(aValue: string; aOrigLine: integer);
  480. begin
  481. fValue := aValue;
  482. fOrigLine := aOrigLine;
  483. end;
  484. function TCompilerOpt.CalcLeft(aDefaultLeft, aLimit: integer): integer;
  485. var
  486. Len: Integer;
  487. begin
  488. Len := (fIndentation div 2) + Length(fOption); // Approximation
  489. if Len > aLimit then
  490. Result := aDefaultLeft + (Len-aLimit)*8
  491. else
  492. Result := aDefaultLeft;
  493. end;
  494. { TCompilerOptGroup }
  495. constructor TCompilerOptGroup.Create(aOwnerReader: TCompilerOptReader; aOwnerGroup: TCompilerOptGroup);
  496. begin
  497. inherited Create(aOwnerGroup);
  498. fOwnerReader := aOwnerReader;
  499. fCompilerOpts := TCompilerOptList.Create;
  500. end;
  501. destructor TCompilerOptGroup.Destroy;
  502. begin
  503. fCompilerOpts.Free;
  504. inherited Destroy;
  505. end;
  506. procedure TCompilerOptGroup.Clear;
  507. begin
  508. fCompilerOpts.Clear;
  509. end;
  510. function TCompilerOptGroup.FindOption(aOptStr: string): TCompilerOpt;
  511. function FindOptionSub(aRoot: TCompilerOpt): TCompilerOpt;
  512. var
  513. Children: TCompilerOptList;
  514. i: Integer;
  515. begin
  516. Result := Nil;
  517. if aRoot is TCompilerOptGroup then
  518. begin
  519. Children := TCompilerOptGroup(aRoot).CompilerOpts;
  520. if aRoot is TCompilerOptSet then
  521. begin // TCompilerOptSet
  522. if AnsiStartsStr(aRoot.Option, aOptStr) then
  523. begin
  524. with TCompilerOptSet(aRoot) do
  525. SelectOptions(Copy(aOptStr, Length(aRoot.Option)+1, Length(aOptStr)));
  526. Result := aRoot;
  527. end;
  528. end
  529. else begin // TCompilerOptGroup
  530. for i := 0 to Children.Count-1 do // Recursive call for children.
  531. begin
  532. Result := FindOptionSub(TCompilerOpt(Children[i]));
  533. if Assigned(Result) then Break;
  534. end;
  535. end;
  536. end
  537. else begin // TCompilerOpt
  538. if aRoot.Option = aOptStr then
  539. Result := aRoot
  540. else if (aRoot.EditKind = oeText) and AnsiStartsStr(aRoot.Option, aOptStr) then
  541. begin
  542. aRoot.SetValue(Copy(aOptStr, Length(aRoot.Option)+1, Length(aOptStr)),
  543. fOwnerReader.fCurOrigLine);
  544. Result := aRoot;
  545. end;
  546. end;
  547. end;
  548. begin
  549. Result := FindOptionSub(Self);
  550. end;
  551. function TCompilerOptGroup.FindOptionById(aId: integer): TCompilerOpt;
  552. function FindOptionSub(aRoot: TCompilerOpt): TCompilerOpt;
  553. var
  554. Children: TCompilerOptList;
  555. i: Integer;
  556. begin
  557. Result := Nil;
  558. if aRoot is TCompilerOptGroup then
  559. begin
  560. Children := TCompilerOptGroup(aRoot).CompilerOpts;
  561. for i := 0 to Children.Count-1 do // Recursive call for children.
  562. begin
  563. Result := FindOptionSub(TCompilerOpt(Children[i]));
  564. if Assigned(Result) then Break;
  565. end;
  566. end
  567. else begin // TCompilerOpt
  568. if aRoot.fId = aId then
  569. Result := aRoot;
  570. end;
  571. end;
  572. begin
  573. Result := FindOptionSub(Self);
  574. end;
  575. function TCompilerOptGroup.OneCharOptions(aOptAndValue: string): TCompilerOpt;
  576. // Split and select option characters like in -Criot.
  577. // Returns reference to the last option object if all characters were valid opts.
  578. var
  579. i: Integer;
  580. OptBase: String;
  581. List: TList;
  582. begin
  583. List := TList.Create;
  584. try
  585. OptBase := Copy(aOptAndValue, 1, 2);
  586. // First check if all options are valid. Change them only if they are valid.
  587. for i := 3 to Length(aOptAndValue) do
  588. begin
  589. Result := FindOption(OptBase + aOptAndValue[i]);
  590. if Assigned(Result) then
  591. List.Add(Result)
  592. else
  593. Break;
  594. end;
  595. // Set boolean options but only if they all are valid.
  596. if Assigned(Result) then
  597. for i := 0 to List.Count-1 do
  598. TCompilerOpt(List[i]).SetValue('True', fOwnerReader.fCurOrigLine);
  599. finally
  600. List.Free;
  601. end;
  602. end;
  603. function TCompilerOptGroup.SelectOption(aOptAndValue: string): Boolean;
  604. var
  605. Opt: TCompilerOpt;
  606. Param: string;
  607. OptLen, ParamLen: integer;
  608. begin
  609. Opt := FindOption(aOptAndValue);
  610. if Assigned(Opt) then
  611. begin
  612. // Found. Set boolean option, other type of options are already set.
  613. if Opt.EditKind = oeBoolean then
  614. Opt.SetValue('True', fOwnerReader.fCurOrigLine);
  615. end
  616. else begin
  617. // Option was not found, try separating the parameter.
  618. // ToDo: figure out the length in a more clever way.
  619. if (Length(aOptAndValue) < 3) or (aOptAndValue[1] <> '-') then
  620. Exit(False);
  621. if aOptAndValue[2] in ['e', 'u', 'I', 'k', 'o'] then
  622. OptLen := 2
  623. else
  624. OptLen := 3;
  625. ParamLen := Length(aOptAndValue) - OptLen;
  626. Opt := Nil;
  627. if (ParamLen > 1)
  628. and (aOptAndValue[OptLen+1] in ['''', '"'])
  629. and (aOptAndValue[Length(aOptAndValue)] in ['''', '"']) then
  630. Param := Copy(aOptAndValue, OptLen+2, ParamLen-2) // Strip quotes
  631. else begin
  632. Param := Copy(aOptAndValue, OptLen+1, ParamLen);
  633. if OptLen = 3 then // Can contain one char options like -Criot. Can be combined.
  634. Opt := OneCharOptions(aOptAndValue);
  635. end;
  636. if Opt = Nil then
  637. begin
  638. Opt := FindOption(Copy(aOptAndValue, 1, OptLen));
  639. if Assigned(Opt) then
  640. begin
  641. Assert(Opt.Value='', 'TCompilerOptGroup.SelectOption: Opt.Value is already set.');
  642. Opt.SetValue(Param, fOwnerReader.fCurOrigLine)
  643. end;
  644. end;
  645. end;
  646. Result := Assigned(Opt);
  647. end;
  648. procedure TCompilerOptGroup.DeselectAll;
  649. procedure DeselectSub(aRoot: TCompilerOpt);
  650. var
  651. Children: TCompilerOptList;
  652. i: Integer;
  653. begin
  654. if aRoot is TCompilerOptGroup then
  655. begin
  656. Children := TCompilerOptGroup(aRoot).CompilerOpts;
  657. for i := 0 to Children.Count-1 do // Recursive call for children.
  658. DeselectSub(TCompilerOpt(Children[i]));
  659. end
  660. else
  661. aRoot.SetValue('', -1); // TCompilerOpt
  662. end;
  663. begin
  664. DeselectSub(Self);
  665. end;
  666. procedure TCompilerOptGroup.ParseEditKind;
  667. begin
  668. fEditKind := oeGroup;
  669. end;
  670. procedure TCompilerOptGroup.ParseOption(aDescr: string; aIndent: integer);
  671. var
  672. i: Integer;
  673. begin
  674. inherited ParseOption(aDescr, aIndent);
  675. i := Length(fOption);
  676. fIncludeNegativeOpt := Copy(fOption, i-3, 4) = '[NO]';
  677. if fIncludeNegativeOpt then
  678. SetLength(fOption, i-4);
  679. end;
  680. { TCompilerOptSet }
  681. constructor TCompilerOptSet.Create(aOwnerReader: TCompilerOptReader;
  682. aOwnerGroup: TCompilerOptGroup; aCommonIndent: integer);
  683. begin
  684. inherited Create(aOwnerReader, aOwnerGroup);
  685. fCommonIndent := aCommonIndent;
  686. end;
  687. destructor TCompilerOptSet.Destroy;
  688. begin
  689. inherited Destroy;
  690. end;
  691. function TCompilerOptSet.CollectSelectedOptions(aUseComments: Boolean): string;
  692. // Collect subitems of a set to one option.
  693. var
  694. Opt: TCompilerOpt;
  695. i: Integer;
  696. s: string;
  697. begin
  698. s := '';
  699. for i := 0 to fCompilerOpts.Count-1 do
  700. begin
  701. Opt := TCompilerOpt(fCompilerOpts[i]);
  702. if Opt.Value <> '' then
  703. case Opt.EditKind of
  704. oeSetElem : s := s + Opt.Option;
  705. oeSetNumber: s := s + Opt.Value;
  706. end;
  707. end;
  708. if s <> '' then begin
  709. Result := Option + s;
  710. if aUseComments then
  711. Result := Result + Comment;
  712. end
  713. else
  714. Result := '';
  715. end;
  716. function TCompilerOptSet.SetNumberOpt(aValue: string): Boolean;
  717. // Find a numeric value in the set and update its value. Return True on success.
  718. var
  719. i: Integer;
  720. Opt: TCompilerOpt;
  721. begin
  722. for i := 0 to fCompilerOpts.Count-1 do
  723. begin
  724. Opt := TCompilerOpt(fCompilerOpts[i]);
  725. if Opt.EditKind = oeSetNumber then
  726. begin
  727. Opt.SetValue(aValue, fOwnerReader.fCurOrigLine);
  728. Exit(True); // Found and updated.
  729. end;
  730. end;
  731. Result := False; // Not found.
  732. end;
  733. function TCompilerOptSet.SetBooleanOpt(aValue: string): Boolean;
  734. // Find a single letter value in the set and update its value. Return True on success.
  735. var
  736. i: Integer;
  737. Opt: TCompilerOpt;
  738. begin
  739. for i := 0 to fCompilerOpts.Count-1 do
  740. begin
  741. Opt := TCompilerOpt(fCompilerOpts[i]);
  742. if (Opt.EditKind = oeSetElem) and (Opt.Option = aValue) then
  743. begin
  744. Opt.SetValue('True', fOwnerReader.fCurOrigLine);
  745. Exit(True); // Found and updated.
  746. end;
  747. end;
  748. Result := False; // Not found.
  749. end;
  750. procedure TCompilerOptSet.SelectOptions(aOptStr: string);
  751. // Select options in this set based on the given characters.
  752. var
  753. i, Start: Integer;
  754. OneOpt: string;
  755. OptOk: Boolean;
  756. begin
  757. i := 1;
  758. while i <= Length(aOptStr) do
  759. begin
  760. Start := i;
  761. if aOptStr[i] in ['0'..'9'] then
  762. while (i <= Length(aOptStr)) and (aOptStr[i] in ['0'..'9']) do
  763. Inc(i)
  764. else
  765. Inc(i);
  766. OneOpt := Copy(aOptStr, Start, i-Start);
  767. if OneOpt[1] in ['0'..'9'] then
  768. OptOk := SetNumberOpt(OneOpt)
  769. else
  770. OptOk := False;
  771. if not (OptOk or SetBooleanOpt(OneOpt)) then
  772. raise Exception.CreateFmt('Option %s is not found in set %s.', [OneOpt, fOption]);
  773. end;
  774. end;
  775. procedure TCompilerOptSet.AddOptions(aDescr: string; aIndent: integer);
  776. // Set can have one letter options and <n> for numbers
  777. procedure NewSetNumber(aDescr: string);
  778. var
  779. OptSet: TCompilerOpt;
  780. begin
  781. OptSet := TCompilerOpt.Create(Self); // Add it under a group
  782. OptSet.fIndentation := aIndent;
  783. OptSet.fOption := 'Number';
  784. OptSet.fDescription := aDescr;
  785. OptSet.fEditKind := oeSetNumber;
  786. end;
  787. procedure NewSetElem(aDescr: string);
  788. var
  789. OptSet: TCompilerOpt;
  790. begin
  791. // Ignore -vl and -vs
  792. if (fOption = '-v') and (aDescr[1] in ['l', 's']) then Exit;
  793. OptSet := TCompilerOpt.Create(Self); // Add it under a group
  794. OptSet.fIndentation := aIndent;
  795. OptSet.fOption := aDescr[1];
  796. OptSet.fDescription := Copy(aDescr, 2, Length(aDescr));
  797. OptSet.fEditKind := oeSetElem;
  798. end;
  799. var
  800. Opt1, Opt2: string;
  801. i: Integer;
  802. begin
  803. if AnsiStartsStr('<n>', aDescr) then
  804. NewSetNumber(aDescr)
  805. else begin
  806. i := PosEx(':', aDescr, 4);
  807. if (i > 0) and (aDescr[i-1]=' ') and (aDescr[i-2]<>' ') and (aDescr[i-3]=' ') then
  808. begin
  809. // Found another option on the same line, like ' a :'
  810. Opt2 := Copy(aDescr, i-2, Length(aDescr));
  811. if aDescr[3] = ':' then
  812. Opt1 := TrimRight(Copy(aDescr, 1, i-3))
  813. else
  814. Opt1 := '';
  815. end
  816. else begin
  817. Opt2 := '';
  818. Opt1 := aDescr;
  819. end;
  820. if Opt1 <> '' then // Can be empty when line in help output is split.
  821. NewSetElem(Opt1)
  822. else if fCompilerOpts.Count > 0 then
  823. aIndent := TCompilerOpt(fCompilerOpts[0]).Indentation;
  824. if Opt2 <> '' then
  825. NewSetElem(Opt2);
  826. end;
  827. end;
  828. procedure TCompilerOptSet.ParseEditKind;
  829. begin
  830. fEditKind := oeSet;
  831. end;
  832. { TCompilerOptReader }
  833. constructor TCompilerOptReader.Create;
  834. begin
  835. inherited Create;
  836. fDefines := TStringList.Create;
  837. fInvalidOptions := TStringList.Create;
  838. fSupportedCategories := TStringList.Create;
  839. fSupportedCategories.Sorted := True;
  840. fGeneratedOptions := TStringList.Create;
  841. fRootOptGroup := TCompilerOptGroup.Create(Self, Nil);
  842. end;
  843. destructor TCompilerOptReader.Destroy;
  844. begin
  845. Clear;
  846. fRootOptGroup.Free;
  847. fGeneratedOptions.Free;
  848. fSupportedCategories.Free;
  849. fInvalidOptions.Free;
  850. fDefines.Free;
  851. inherited Destroy;
  852. end;
  853. procedure TCompilerOptReader.Clear;
  854. var
  855. i: Integer;
  856. begin
  857. fRootOptGroup.Clear;
  858. for i := 0 to fSupportedCategories.Count-1 do
  859. fSupportedCategories.Objects[i].Free;
  860. fSupportedCategories.Clear;
  861. end;
  862. function TCompilerOptReader.AddChoicesNew(aOpt: string): TStrings;
  863. // From FPC 2.7.1+ output
  864. const
  865. FpcIStart = 'see fpc -i or fpc -i';
  866. var
  867. ch: Char;
  868. i: integer;
  869. begin
  870. Result := Nil;
  871. i := Pos(FpcIStart, aOpt);
  872. if i = 0 then Exit;
  873. Assert(Length(aOpt) >= i+Length(FpcIStart));
  874. ch := aOpt[i+Length(FpcIStart)]; // Pick the next char from description.
  875. if fSupportedCategories.Find(ch, i) then
  876. Result := fSupportedCategories.Objects[i] as TStrings
  877. else begin
  878. Result := ReadCategorySelections(ch);
  879. Result.Insert(0, ''); // First an empty string. Allows removing selection.
  880. fSupportedCategories.AddObject(ch, Result);
  881. end;
  882. end;
  883. function TCompilerOptReader.IsGroup(aOpt: string; var aCategoryList: TStrings): Boolean;
  884. // This option should be a group instead of a selection list.
  885. // The information is not available in fpc -h output.
  886. var
  887. i: Integer;
  888. CategoryName: string;
  889. begin
  890. Result := False;
  891. if fIsNewFpc then
  892. begin
  893. // FPC 2.7.1+
  894. if AnsiStartsStr('-Oo', aOpt)
  895. or AnsiStartsStr('-OW', aOpt)
  896. or AnsiStartsStr('-Ow', aOpt) then
  897. begin
  898. aCategoryList := AddChoicesNew(aOpt);
  899. Result := Assigned(aCategoryList);
  900. end;
  901. end
  902. else begin
  903. // FPC 2.6.x
  904. CategoryName := '';
  905. if AnsiStartsStr('-Oo', aOpt) then
  906. CategoryName := 'Optimizations:'
  907. else if AnsiStartsStr('-OW', aOpt) or AnsiStartsStr('-Ow', aOpt) then
  908. CategoryName := 'Whole Program Optimizations:';
  909. Result := CategoryName <> '';
  910. if Result then
  911. if fSupportedCategories.Find(CategoryName, i) then
  912. aCategoryList := fSupportedCategories.Objects[i] as TStrings
  913. else
  914. raise Exception.CreateFmt('No list of options found for "%s".', [CategoryName]);
  915. end;
  916. end;
  917. function TCompilerOptReader.AddNewCategory(aCategoryName: String): TStringList;
  918. begin
  919. Result := TStringList.Create;
  920. Result.Add(''); // First an empty string. Allows removing selection.
  921. fSupportedCategories.AddObject(aCategoryName, Result);
  922. end;
  923. function TCompilerOptReader.ParseI(aLines: TStringList): TModalResult;
  924. const
  925. Supported = 'Supported ';
  926. var
  927. i, j: Integer;
  928. Line, TrimmedLine: String;
  929. Category, sl: TStringList;
  930. begin
  931. Result := mrOK;
  932. Category := Nil;
  933. sl := TStringList.Create;
  934. try
  935. sl.StrictDelimiter := True;
  936. sl.Delimiter := ',';
  937. for i := 0 to aLines.Count-1 do
  938. begin
  939. Line := aLines[i];
  940. TrimmedLine := Trim(Line);
  941. if Assigned(Category) then
  942. begin
  943. if TrimmedLine = '' then
  944. Category := Nil // End of category.
  945. else begin
  946. if Line[1] <> ' ' then
  947. raise Exception.Create('TCompilerReader.ParseI: Line should start with a space.');
  948. sl.Clear;
  949. // Some old FPC versions had a comma separated list.
  950. sl.DelimitedText := Trim(Line);
  951. for j := 0 to sl.Count-1 do
  952. Category.Add(sl[j]);
  953. end;
  954. end
  955. else if AnsiStartsStr(Supported, Line) then
  956. Category := AddNewCategory(Copy(Line, Length(Supported)+1, Length(Line)));
  957. end;
  958. finally
  959. sl.Free;
  960. end;
  961. end;
  962. function TCompilerOptReader.ReadVersion(s: string): Boolean;
  963. const
  964. VersBegin = 'Free Pascal Compiler version ';
  965. var
  966. Start, V1, V2: Integer;
  967. OutputI: TStringList; // fpc -Fr$(FPCMsgFile) -i
  968. begin
  969. Result := AnsiStartsStr(VersBegin, s);
  970. if Result then
  971. begin
  972. fIsNewFpc := False;
  973. Start := Length(VersBegin)+1;
  974. V1 := PosEx(' ', s, Start);
  975. if V1 > 0 then
  976. begin
  977. fFpcVersion := Copy(s, Start, V1-Start);
  978. if (Length(fFpcVersion)>2) then begin
  979. V1 := StrToIntDef(fFpcVersion[1], 0);
  980. V2 := StrToIntDef(fFpcVersion[3], 0);
  981. fIsNewFpc := ((V1=2) and (V2>=7)) or (V1>2);
  982. end;
  983. // The rest 2 fields are date and target CPU.
  984. end;
  985. if not fIsNewFpc then
  986. begin
  987. // Get categories with FPC -i, once we know the version is old (2.6.x).
  988. OutputI := RunTool(fCompilerExecutable, fParsedTarget + ' -i');
  989. if OutputI = Nil then Exit(False);
  990. try
  991. Result := ParseI(OutputI) = mrOK;
  992. finally
  993. OutputI.Free;
  994. end;
  995. end;
  996. end;
  997. end;
  998. procedure TCompilerOptReader.CreateNewGroupItem(aGroup: TCompilerOptGroup; aTxt: string);
  999. var
  1000. Opt: TCompilerOpt;
  1001. begin
  1002. Opt := TCompilerOpt.Create(aGroup); // Add it under a group
  1003. Opt.fOption := aGroup.Option + aTxt;
  1004. Opt.fIndentation := aGroup.Indentation+4;
  1005. Opt.fEditKind := oeBoolean;
  1006. end;
  1007. procedure TCompilerOptReader.AddGroupItems(aGroup: TCompilerOptGroup; aItems: TStrings);
  1008. var
  1009. i: Integer;
  1010. begin
  1011. for i := 1 to aItems.Count-1 do // Skip the first empty item.
  1012. begin
  1013. CreateNewGroupItem(aGroup, aItems[i]);
  1014. if aGroup.fIncludeNegativeOpt then
  1015. CreateNewGroupItem(aGroup, 'NO'+aItems[i]);
  1016. end;
  1017. end;
  1018. function TCompilerOptReader.ParseH(aLines: TStringList): TModalResult;
  1019. const
  1020. OptSetId = 'a combination of';
  1021. var
  1022. i, ThisInd, NextInd, OptSetInd: Integer;
  1023. ThisLine: String;
  1024. Opt: TCompilerOpt;
  1025. LastGroup, SubGroup: TCompilerOptGroup;
  1026. GroupItems: TStrings;
  1027. begin
  1028. Result := mrOK;
  1029. LastGroup := fRootOptGroup;
  1030. GroupItems:=nil;
  1031. for i := 0 to aLines.Count-1 do
  1032. begin
  1033. ThisLine := StringReplace(aLines[i],'-Agas-darwinAssemble','-Agas-darwin Assemble',[]);
  1034. ThisInd := CalcIndentation(ThisLine);
  1035. ThisLine := Trim(ThisLine);
  1036. if LastGroup is TCompilerOptSet then
  1037. begin // Fix strangely split line indents in options groups.
  1038. OptSetInd := TCompilerOptSet(LastGroup).CommonIndent;
  1039. if (ThisLine[1] <> '-') and (ThisInd > OptSetInd) then
  1040. ThisInd := OptSetInd;
  1041. end;
  1042. // Top header line for compiler version, check only once.
  1043. if (fFpcVersion = '') and ReadVersion(ThisLine) then Continue;
  1044. if ThisInd < 2 then Continue;
  1045. if (ThisLine = '') or (ThisInd > 30)
  1046. or (ThisLine[1] = '@')
  1047. or (Pos('-? ', ThisLine) > 0)
  1048. or (Pos('-h ', ThisLine) > 0) then Continue;
  1049. if i < aLines.Count-1 then
  1050. NextInd := CalcIndentation(aLines[i+1])
  1051. else
  1052. NextInd := -1;
  1053. if NextInd > ThisInd then
  1054. begin
  1055. if LastGroup is TCompilerOptSet then
  1056. NextInd := TCompilerOptSet(LastGroup).CommonIndent
  1057. else begin
  1058. if Pos(OptSetId, ThisLine) > 0 then // Header for sets
  1059. // Hard-code indent to NextInd, for strangely split lines later in help output.
  1060. LastGroup := TCompilerOptSet.Create(Self, LastGroup, NextInd)
  1061. else // Group header for options
  1062. LastGroup := TCompilerOptGroup.Create(Self, LastGroup);
  1063. LastGroup.ParseOption(ThisLine, ThisInd);
  1064. end;
  1065. end;
  1066. if NextInd <= ThisInd then
  1067. begin
  1068. // This is an option
  1069. if LastGroup is TCompilerOptSet then // Add it to a set (may add many)
  1070. TCompilerOptSet(LastGroup).AddOptions(ThisLine, ThisInd)
  1071. else begin
  1072. if IsGroup(ThisLine, GroupItems) then
  1073. begin
  1074. SubGroup := TCompilerOptGroup.Create(Self, LastGroup);
  1075. SubGroup.ParseOption(ThisLine, ThisInd);
  1076. AddGroupItems(SubGroup, GroupItems);
  1077. end
  1078. else begin
  1079. Opt := TCompilerOpt.Create(LastGroup); // Add it under a group
  1080. Opt.ParseOption(ThisLine, ThisInd);
  1081. end;
  1082. end;
  1083. if (NextInd <> -1) and (NextInd < ThisInd) then
  1084. LastGroup := LastGroup.fOwnerGroup; // Return to a previous group
  1085. end;
  1086. end;
  1087. end;
  1088. function TCompilerOptReader.UpdateTargetParam: Boolean;
  1089. // Updates target OS and CPU parameter using global macros.
  1090. // Returns true if the value has changed since last time.
  1091. var
  1092. NewTarget: string;
  1093. begin
  1094. NewTarget := '-T$(TargetOS) -P$(TargetCPU)';
  1095. if not GlobalMacroList.SubstituteStr(NewTarget) then
  1096. raise Exception.CreateFmt('UpdateTargetParam: Cannot substitute macros "%s".',
  1097. [NewTarget]);
  1098. Result := fParsedTarget <> NewTarget;
  1099. if Result then
  1100. fParsedTarget := NewTarget; // fParsedTarget is used as a param for FPC.
  1101. end;
  1102. function TCompilerOptReader.ReadCategorySelections(aChar: Char): TStringList;
  1103. // Get the selection list for a category using "fpc -i+char", for new FPC versions.
  1104. begin
  1105. Result:=RunTool(fCompilerExecutable, fParsedTarget + ' -i' + aChar);
  1106. Result.Sort;
  1107. end;
  1108. function TCompilerOptReader.ReadAndParseOptions: TModalResult;
  1109. // fpc -Fr$(FPCMsgFile) -h
  1110. var
  1111. OutputH: TStringList;
  1112. begin
  1113. if fCompilerExecutable = '' then
  1114. fCompilerExecutable := 'fpc'; // Let's hope "fpc" is found in PATH.
  1115. OptionIdCounter := 0;
  1116. fErrorMsg := '';
  1117. try
  1118. // FPC with option -h
  1119. OutputH := RunTool(fCompilerExecutable, fParsedTarget + ' -h');
  1120. if OutputH = Nil then Exit(mrCancel);
  1121. Result := ParseH(OutputH);
  1122. finally
  1123. OutputH.Free;
  1124. end;
  1125. end;
  1126. function TCompilerOptReader.FilterOptions(aFilter: string; aOnlySelected: Boolean): Boolean;
  1127. // Filter all options recursively, setting their Visible flag as needed.
  1128. // Returns True if Option(group) or child options have visible items.
  1129. function FilterOptionsSub(aRoot: TCompilerOpt): Boolean;
  1130. var
  1131. Children: TCompilerOptList;
  1132. i: Integer;
  1133. begin
  1134. // Filter the root item
  1135. aRoot.Filter(aFilter, aOnlySelected); // Sets Visible flag
  1136. // Filter children in a group
  1137. if aRoot is TCompilerOptGroup then
  1138. begin
  1139. Children := TCompilerOptGroup(aRoot).CompilerOpts;
  1140. for i := 0 to Children.Count-1 do // Recursive call for children.
  1141. aRoot.Visible := FilterOptionsSub(TCompilerOpt(Children[i])) or aRoot.Visible;
  1142. end;
  1143. Result := aRoot.Visible;
  1144. end;
  1145. begin
  1146. Result := FilterOptionsSub(fRootOptGroup);
  1147. end;
  1148. function TCompilerOptReader.FindOptionById(aId: integer): TCompilerOpt;
  1149. begin
  1150. Result := fRootOptGroup.FindOptionById(aId);
  1151. end;
  1152. function TCompilerOptReader.FromCustomOptions(aStrings: TStrings): TModalResult;
  1153. // Example: $(IDEBuildOptions) -dCR -dgc -Criot
  1154. var
  1155. i, j: Integer;
  1156. s: String;
  1157. sl: TStringList;
  1158. begin
  1159. Result := mrOK;
  1160. fCurOrigLine := 0;
  1161. fRootOptGroup.DeselectAll;
  1162. fDefines.Clear;
  1163. fInvalidOptions.Clear;
  1164. sl := TStringList.Create;
  1165. try
  1166. // Separate options that are on one line.
  1167. for i := 0 to aStrings.Count-1 do
  1168. begin
  1169. s := Trim(aStrings[i]);
  1170. if s = '' then Continue;
  1171. sl.Clear;
  1172. SplitCmdLineParams(s, sl);
  1173. for j := 0 to sl.Count-1 do begin
  1174. s := sl[j];
  1175. // Put the option into fDefines or fInvalidOptions, or set in options collection.
  1176. if AnsiStartsStr('-d', s) and (Length(s) > 2) then
  1177. begin
  1178. if not AnsiStartsStr(CommentId, s) then // Skip a generated comment.
  1179. fDefines.Add(s)
  1180. end
  1181. else
  1182. if not fRootOptGroup.SelectOption(s) then
  1183. fInvalidOptions.AddObject(s, TObject({%H-}Pointer(PtrUInt(i))));
  1184. Inc(fCurOrigLine);
  1185. end;
  1186. end;
  1187. finally
  1188. sl.Free;
  1189. end;
  1190. end;
  1191. procedure TCompilerOptReader.CopyOptions(aRoot: TCompilerOpt);
  1192. // Collect non-default options from GUI to fGeneratedOptions
  1193. var
  1194. Children: TCompilerOptList;
  1195. i: Integer;
  1196. s: string;
  1197. begin
  1198. if aRoot is TCompilerOptGroup then
  1199. begin
  1200. Children := TCompilerOptGroup(aRoot).CompilerOpts;
  1201. if aRoot is TCompilerOptSet then
  1202. begin // TCompilerOptSet
  1203. s := TCompilerOptSet(aRoot).CollectSelectedOptions(fUseComments);
  1204. if s <> '' then
  1205. fGeneratedOptions.AddObject(s, TObject({%H-}Pointer(PtrUInt(aRoot.fOrigLine))));
  1206. end
  1207. else begin // TCompilerOptGroup
  1208. for i := 0 to Children.Count-1 do
  1209. CopyOptions(TCompilerOpt(Children[i])); // Recursive call for children.
  1210. end;
  1211. end
  1212. else if aRoot.Value <> '' then // TCompilerOpt
  1213. fGeneratedOptions.AddObject(aRoot.GenerateOptValue(fUseComments),
  1214. TObject({%H-}Pointer(PtrUINt(aRoot.fOrigLine))));
  1215. end;
  1216. function TCompilerOptReader.FindLowestOrigLine(aStrings: TStrings;
  1217. out aOrigLine: Integer): integer;
  1218. // Return index in aStrings for an option that has the lowest original line number.
  1219. // aOrigLine returns the original line number.
  1220. var
  1221. i, OriLine, MinOrigLine: Integer;
  1222. begin
  1223. Result := -1;
  1224. aOrigLine := -1;
  1225. MinOrigLine := MaxInt;
  1226. for i := 0 to aStrings.Count-1 do
  1227. begin
  1228. OriLine := Integer({%H-}PtrUInt(Pointer(aStrings.Objects[i])));
  1229. if (OriLine > -1) and (OriLine < MinOrigLine) then
  1230. begin
  1231. MinOrigLine := OriLine;
  1232. aOrigLine := OriLine;
  1233. Result := i;
  1234. end;
  1235. end;
  1236. end;
  1237. function TCompilerOptReader.AddOptInLowestOrigLine(OutStrings: TStrings): Boolean;
  1238. // Copy an option that had the lowest original line number.
  1239. // Returns True if options from original data was found.
  1240. var
  1241. iGen, iInv: Integer;
  1242. iGenOrig, iInvOrig: Integer;
  1243. begin
  1244. // Find lowest lines from both generated and invalid options
  1245. iGen := FindLowestOrigLine(fGeneratedOptions, iGenOrig);
  1246. iInv := FindLowestOrigLine(fInvalidOptions, iInvOrig);
  1247. // then add the one that is lower.
  1248. if (iGenOrig = -1) and (iInvOrig = -1) then Exit(False);
  1249. Result := True;
  1250. if ( (iGenOrig > -1) and (iInvOrig > -1) and (iGenOrig <= iInvOrig) )
  1251. or ( (iGenOrig > -1) and (iInvOrig = -1) ) then
  1252. begin
  1253. OutStrings.Add(fGeneratedOptions[iGen]);
  1254. fGeneratedOptions[iGen] := '';
  1255. fGeneratedOptions.Objects[iGen] := TObject(Pointer(-1)); // Mark as processed.
  1256. end
  1257. else begin
  1258. OutStrings.Add(fInvalidOptions[iInv]);
  1259. fInvalidOptions[iInv] := '';
  1260. fInvalidOptions.Objects[iInv] := TObject(Pointer(-1));
  1261. end;
  1262. end;
  1263. function TCompilerOptReader.ToCustomOptions(aStrings: TStrings;
  1264. aUseComments: Boolean): TModalResult;
  1265. // Copy options to a list if they have a non-default value (True for boolean).
  1266. var
  1267. i: Integer;
  1268. begin
  1269. Result := mrOK;
  1270. fUseComments := aUseComments;
  1271. fGeneratedOptions.Clear;
  1272. CopyOptions(fRootOptGroup);
  1273. // Options are now in fGeneratedOptions. Move them to aStrings in a right order.
  1274. aStrings.Clear;
  1275. // First collect options that were in the original list.
  1276. while AddOptInLowestOrigLine(aStrings) do ;
  1277. // Then add all the rest.
  1278. for i := 0 to fGeneratedOptions.Count-1 do
  1279. if fGeneratedOptions[i] <> '' then
  1280. aStrings.Add(fGeneratedOptions[i]);
  1281. // Then defines
  1282. aStrings.AddStrings(fDefines);
  1283. end;
  1284. { TCompilerOptThread }
  1285. constructor TCompilerOptThread.Create(aReader: TCompilerOptReader);
  1286. begin
  1287. inherited Create(True);
  1288. //FreeOnTerminate:=True;
  1289. fStartedOnce:=false;
  1290. fReader:=aReader;
  1291. end;
  1292. destructor TCompilerOptThread.Destroy;
  1293. begin
  1294. if fStartedOnce then
  1295. WaitFor;
  1296. Clear;
  1297. inherited Destroy;
  1298. end;
  1299. function TCompilerOptThread.GetErrorMsg: string;
  1300. begin
  1301. Result := fReader.ErrorMsg;
  1302. end;
  1303. procedure TCompilerOptThread.Clear;
  1304. begin
  1305. ;
  1306. end;
  1307. procedure TCompilerOptThread.StartParsing;
  1308. begin
  1309. if fStartedOnce then
  1310. WaitFor;
  1311. fReader.CompilerExecutable:=LazarusIDE.GetFPCompilerFilename;
  1312. fReader.UpdateTargetParam;
  1313. Start;
  1314. fStartedOnce:=true;
  1315. end;
  1316. procedure TCompilerOptThread.EndParsing;
  1317. begin
  1318. if fStartedOnce then
  1319. WaitFor;
  1320. end;
  1321. procedure TCompilerOptThread.Execute;
  1322. var
  1323. StartTime: TDateTime;
  1324. begin
  1325. StartTime := Now;
  1326. try
  1327. fReader.ReadAndParseOptions;
  1328. except
  1329. on E: Exception do
  1330. fReader.ErrorMsg := 'Error reading compiler: '+E.Message;
  1331. end;
  1332. fReadTime := Now-StartTime;
  1333. end;
  1334. end.