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