/ide/compiler.pp
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