PageRenderTime 58ms CodeModel.GetById 12ms app.highlight 37ms RepoModel.GetById 1ms app.codeStats 0ms

/ide/compiler.pp

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