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