mirror of
				https://gitlab.com/freepascal.org/lazarus/lazarus.git
				synced 2025-10-25 10:41:42 +02:00 
			
		
		
		
	
		
			
				
	
	
		
			1458 lines
		
	
	
		
			45 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			1458 lines
		
	
	
		
			45 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|  /***************************************************************************
 | |
|                         compiler.pp  -  Lazarus IDE unit
 | |
|                         -------------------------------------
 | |
|                TCompiler is responsible for configuration and running
 | |
|                the Free Pascal Compiler.
 | |
| 
 | |
| 
 | |
|                    Initial Revision  : Sun Mar 28 23:15:32 CST 1999
 | |
| 
 | |
| 
 | |
|  ***************************************************************************/
 | |
| 
 | |
|  ***************************************************************************
 | |
|  *                                                                         *
 | |
|  *   This source is free software; you can redistribute it and/or modify   *
 | |
|  *   it under the terms of the GNU General Public License as published by  *
 | |
|  *   the Free Software Foundation; either version 2 of the License, or     *
 | |
|  *   (at your option) any later version.                                   *
 | |
|  *                                                                         *
 | |
|  *   This code is distributed in the hope that it will be useful, but      *
 | |
|  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
 | |
|  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
 | |
|  *   General Public License for more details.                              *
 | |
|  *                                                                         *
 | |
|  *   A copy of the GNU General Public License is available on the World    *
 | |
|  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
 | |
|  *   obtain it by writing to the Free Software Foundation,                 *
 | |
|  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
 | |
|  *                                                                         *
 | |
|  ***************************************************************************
 | |
| }
 | |
| unit Compiler;
 | |
| 
 | |
| {$mode objfpc}
 | |
| {$H+}
 | |
| 
 | |
| interface
 | |
| 
 | |
| uses
 | |
|   Classes, SysUtils, LCLProc, Forms, Controls, contnrs, strutils,
 | |
|   IDEExternToolIntf, IDEMsgIntf, LazIDEIntf, LazUTF8,
 | |
|   IDECmdLine, LazarusIDEStrConsts, CompilerOptions, Project,
 | |
|   DefineTemplates, TransferMacros, EnvironmentOpts, LazFileUtils;
 | |
| 
 | |
| type
 | |
|   TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean) of object;
 | |
| 
 | |
|   { TCompiler }
 | |
| 
 | |
|   TCompiler = class(TObject)
 | |
|   private
 | |
|     FOnCmdLineCreate : TOnCmdLineCreate;
 | |
|   public
 | |
|     constructor Create;
 | |
|     destructor Destroy; override;
 | |
|     function Compile(AProject: TProject;
 | |
|                      const WorkingDir, CompilerFilename, CompilerParams: string;
 | |
|                      BuildAll, SkipLinking, SkipAssembler, CurrentDirectoryIsTestDir: boolean;
 | |
|                      const aCompileHint: string): TModalResult;
 | |
|     procedure WriteError(const Msg: string);
 | |
|   end;
 | |
| 
 | |
|   // Following classes are for compiler options parsed from "fpc -h" and "fpc -i".
 | |
| 
 | |
|   TCompilerOptEditKind = (
 | |
|     oeGroup,      // A header for a group
 | |
|     oeSet,        // A header for a set
 | |
|     oeSetElem,    // One char element of a set, use CheckBox
 | |
|     oeSetNumber,  // Number element of a set, use Edit
 | |
|     oeBoolean,    // True/False, typically use CheckBox
 | |
|     oeText,       // Textual value
 | |
|     oeNumber,     // Numeric value
 | |
|     oeList        // Pre-defined list of choices
 | |
|   );
 | |
| 
 | |
|   TCompilerOptGroup = class;
 | |
| 
 | |
|   { TCompilerOpt }
 | |
| 
 | |
|   TCompilerOpt = class
 | |
|   private
 | |
|     fOwnerGroup: TCompilerOptGroup;
 | |
|     fId: integer;                       // Identification.
 | |
|     fOption: string;                    // Option with the leading '-'.
 | |
|     fSuffix: string;                    // <x> or similar suffix of option.
 | |
|     fValue: string;                     // Data entered by user, 'True' for Boolean.
 | |
|     fOrigLine: integer;                 // Original line in the input data.
 | |
|     fEditKind: TCompilerOptEditKind;
 | |
|     fDescription: string;
 | |
|     fIndentation: integer;              // Indentation level in "fpc -h" output.
 | |
|     fVisible: Boolean;                  // Used for filtering.
 | |
|     fIgnored: Boolean;                  // Pretend this option does not exist.
 | |
|     fChoices: TStrings;                 // Choices got from "fpc -i"
 | |
|     procedure AddChoicesByOptOld;
 | |
|     function Comment: string;
 | |
|     procedure Filter(aFilter: string; aOnlySelected: Boolean);
 | |
|     function GenerateOptValue(aUseComments: Boolean): string;
 | |
|     procedure SetValue(aValue: string; aOrigLine: integer);
 | |
|   protected
 | |
|     procedure ParseEditKind; virtual;
 | |
|     procedure ParseOption(aDescr: string; aIndent: integer); virtual;
 | |
|   public
 | |
|     constructor Create(aOwnerGroup: TCompilerOptGroup);
 | |
|     destructor Destroy; override;
 | |
|     function CalcLeft(aDefaultLeft, aLimit: integer): integer;
 | |
|   public
 | |
|     property Id: integer read fId;
 | |
|     property Option: string read fOption;
 | |
|     property Suffix: string read fSuffix;
 | |
|     property Value: string read fValue write fValue;
 | |
|     property EditKind: TCompilerOptEditKind read fEditKind;
 | |
|     property Description: string read fDescription;
 | |
|     property Indentation: integer read fIndentation;
 | |
|     property Visible: Boolean read fVisible write fVisible;
 | |
|     property Ignored: Boolean read fIgnored write fIgnored;
 | |
|     property Choices: TStrings read fChoices;
 | |
|   end;
 | |
| 
 | |
|   TCompilerOptList = TObjectList;
 | |
|   TCompilerOptReader = class;         // Forward reference
 | |
| 
 | |
|   { TCompilerOptGroup }
 | |
| 
 | |
|   // Group with explanation header. Actual options are not defined here.
 | |
|   TCompilerOptGroup = class(TCompilerOpt)
 | |
|   private
 | |
|     fOwnerReader: TCompilerOptReader;
 | |
|     // List of options belonging to this group.
 | |
|     fCompilerOpts: TCompilerOptList;
 | |
|     fIncludeNegativeOpt: Boolean; // Each option has a variation with "NO" appended.
 | |
|     function OneCharOptions(aOptAndValue: string): TCompilerOpt;
 | |
|   protected
 | |
|     procedure ParseEditKind; override;
 | |
|     procedure ParseOption(aDescr: string; aIndent: integer); override;
 | |
|   public
 | |
|     constructor Create(aOwnerReader: TCompilerOptReader; aOwnerGroup: TCompilerOptGroup);
 | |
|     destructor Destroy; override;
 | |
|     procedure Clear;
 | |
|     function FindOption(aOptStr: string): TCompilerOpt;
 | |
|     function FindOptionById(aId: integer): TCompilerOpt;
 | |
|     function SelectOption(aOptAndValue: string): Boolean;
 | |
|     procedure DeselectAll;
 | |
|   public
 | |
|     property CompilerOpts: TCompilerOptList read fCompilerOpts;
 | |
|   end;
 | |
| 
 | |
|   { TCompilerOptSet }
 | |
| 
 | |
|   // A set of options. A combination of chars or numbers following the option char.
 | |
|   TCompilerOptSet = class(TCompilerOptGroup)
 | |
|   private
 | |
|     fCommonIndent: integer; // Common indentation for this group fixed during parse.
 | |
|     function SetNumberOpt(aValue: string): Boolean;
 | |
|     function SetBooleanOpt(aValue: string): Boolean;
 | |
|   protected
 | |
|     procedure AddOptions(aDescr: string; aIndent: integer);
 | |
|     procedure ParseEditKind; override;
 | |
|   public
 | |
|     constructor Create(aOwnerReader: TCompilerOptReader;
 | |
|       aOwnerGroup: TCompilerOptGroup; aCommonIndent: integer);
 | |
|     destructor Destroy; override;
 | |
|     function CollectSelectedOptions(aUseComments: Boolean): string;
 | |
|     procedure SelectOptions(aOptStr: string);
 | |
|     property CommonIndent: integer read fCommonIndent write fCommonIndent;
 | |
|   end;
 | |
| 
 | |
|   { TCompilerOptReader }
 | |
| 
 | |
|   TCompilerOptReader = class
 | |
|   private
 | |
|     fCurOrigLine: integer;        // Current line num when parsing original data.
 | |
|     // Defines (-d...) are separated from custom options and stored here.
 | |
|     fDefines: TStringList;
 | |
|     // Options not accepted by parser. They may still be valid (a macro maybe)
 | |
|     fInvalidOptions: TStringList;        // and will be included in output.
 | |
|     // List of categories parsed from "fpc -i". Contains category names,
 | |
|     //  Objects[] contains another StringList for the selection list.
 | |
|     fSupportedCategories: TStringList;
 | |
|     // Hierarchy of options parsed from "fpc -h".
 | |
|     fRootOptGroup: TCompilerOptGroup;
 | |
|     fCompilerExecutable: string;  // Compiler path must be set by caller.
 | |
|     fFpcVersion: string;          // Parsed from "fpc -h".
 | |
|     fIsNewFpc: Boolean;
 | |
|     fParsedTarget: String;
 | |
|     fErrorMsg: String;
 | |
|     fGeneratedOptions: TStringList; // Options generated from GUI.
 | |
|     fUseComments: Boolean;        // Add option's description into generated data.
 | |
|     function AddChoicesNew(aOpt: string): TStrings;
 | |
|     function AddNewCategory(aCategoryName: String): TStringList;
 | |
|     function AddOptInLowestOrigLine(OutStrings: TStrings): Boolean;
 | |
|     procedure CopyOptions(aRoot: TCompilerOpt);
 | |
|     function FindLowestOrigLine(aStrings: TStrings; out aOrigLine: Integer): integer;
 | |
|     function IsGroup(aOpt: string; var aCategoryList: TStrings): Boolean;
 | |
|     function ReadCategorySelections(aChar: Char): TStringList;
 | |
|     function ReadVersion(s: string): Boolean;
 | |
|     procedure CreateNewGroupItem(aGroup: TCompilerOptGroup; aTxt: string);
 | |
|     procedure AddGroupItems(aGroup: TCompilerOptGroup; aItems: TStrings);
 | |
|     function ParseI(aLines: TStringList): TModalResult;
 | |
|     function ParseH(aLines: TStringList): TModalResult;
 | |
|   public
 | |
|     constructor Create;
 | |
|     destructor Destroy; override;
 | |
|     procedure Clear;
 | |
|     function UpdateTargetParam: Boolean;
 | |
|     function ReadAndParseOptions: TModalResult;
 | |
|     function FilterOptions(aFilter: string; aOnlySelected: Boolean): Boolean;
 | |
|     function FindOptionById(aId: integer): TCompilerOpt;
 | |
|     function FromCustomOptions(aStrings: TStrings): TModalResult;
 | |
|     function ToCustomOptions(aStrings: TStrings; aUseComments: Boolean): TModalResult;
 | |
|   public
 | |
|     property Defines: TStringList read fDefines;
 | |
|     //property SupportedCategories: TStringList read fSupportedCategories;
 | |
|     property RootOptGroup: TCompilerOptGroup read fRootOptGroup;
 | |
|     property CompilerExecutable: string read fCompilerExecutable write fCompilerExecutable;
 | |
|     property ParsedTarget: String read fParsedTarget write fParsedTarget;
 | |
|     property ErrorMsg: String read fErrorMsg write fErrorMsg;
 | |
|   end;
 | |
| 
 | |
|   { TCompilerOptThread - thread for reading 'fpc -h' output }
 | |
| 
 | |
|   TCompilerOptThread = class(TThread)
 | |
|   private
 | |
|     fReader: TCompilerOptReader;
 | |
|     fReadTime: TDateTime;
 | |
|     fStartedOnce: boolean;
 | |
|     function GetErrorMsg: string;
 | |
|     procedure Clear; // (main thread)
 | |
|   protected
 | |
|     procedure Execute; override;
 | |
|   public
 | |
|     constructor Create(aReader: TCompilerOptReader);
 | |
|     destructor Destroy; override;
 | |
|     procedure StartParsing; // (main thread)
 | |
|     procedure EndParsing; // (main thread)
 | |
|   public
 | |
|     property ReadTime: TDateTime read fReadTime;
 | |
|     property ErrorMsg: string read GetErrorMsg;
 | |
|   end;
 | |
| 
 | |
| implementation
 | |
| 
 | |
| { TCompiler }
 | |
| 
 | |
| {------------------------------------------------------------------------------
 | |
|   TCompiler Constructor
 | |
| ------------------------------------------------------------------------------}
 | |
| 
 | |
| constructor TCompiler.Create;
 | |
| begin
 | |
|   inherited Create;
 | |
| end;
 | |
| 
 | |
| {------------------------------------------------------------------------------
 | |
|   TCompiler Destructor
 | |
| ------------------------------------------------------------------------------}
 | |
| destructor TCompiler.Destroy;
 | |
| begin
 | |
|   inherited Destroy;
 | |
| end;
 | |
| 
 | |
| {------------------------------------------------------------------------------
 | |
|   TCompiler Compile
 | |
| ------------------------------------------------------------------------------}
 | |
| function TCompiler.Compile(AProject: TProject; const WorkingDir,
 | |
|   CompilerFilename, CompilerParams: string; BuildAll, SkipLinking,
 | |
|   SkipAssembler, CurrentDirectoryIsTestDir: boolean; const aCompileHint: string
 | |
|   ): TModalResult;
 | |
| var
 | |
|   CmdLine : String;
 | |
|   Abort : Boolean;
 | |
|   Tool: TAbstractExternalTool;
 | |
|   FPCParser: TFPCParser;
 | |
|   Title: String;
 | |
|   TargetOS: String;
 | |
|   TargetCPU: String;
 | |
|   TargetFilename: String;
 | |
| begin
 | |
|   Result:=mrCancel;
 | |
|   if ConsoleVerbosity>=1 then
 | |
|     DebugLn('TCompiler.Compile WorkingDir="',WorkingDir,'" CompilerFilename="',CompilerFilename,'" CompilerParams="',CompilerParams,'"');
 | |
| 
 | |
|   try
 | |
|     CheckIfFileIsExecutable(CompilerFilename);
 | |
|   except
 | |
|     on E: Exception do begin
 | |
|       WriteError(Format(lisCompilerErrorInvalidCompiler, [E.Message]));
 | |
|       if CompilerFilename='' then begin
 | |
|         WriteError(lisCompilerHintYouCanSetTheCompilerPath);
 | |
|       end;
 | |
|       exit;
 | |
|     end;
 | |
|   end;
 | |
|   CmdLine := '';
 | |
|   if BuildAll then
 | |
|     CmdLine := CmdLine+' -B';
 | |
|   if SkipLinking and SkipAssembler then
 | |
|     CmdLine := CmdLine+' -s'
 | |
|   else if SkipLinking then
 | |
|     CmdLine := CmdLine+' -Cn';
 | |
| 
 | |
|   if CompilerParams<>'' then
 | |
|     CmdLine := CmdLine+' '+CompilerParams;
 | |
|   if Assigned(FOnCmdLineCreate) then begin
 | |
|     Abort:=false;
 | |
|     FOnCmdLineCreate(CmdLine,Abort);
 | |
|     if Abort then begin
 | |
|       Result:=mrAbort;
 | |
|       exit;
 | |
|     end;
 | |
|   end;
 | |
|   if ConsoleVerbosity>=0 then
 | |
|     DebugLn('[TCompiler.Compile] CmdLine="',CompilerFilename+CmdLine,'"');
 | |
| 
 | |
|   Title:=lisCompileProject;
 | |
|   if AProject.BuildModes.Count>1 then
 | |
|     Title+=Format(lisMode, [AProject.ActiveBuildMode.Identifier]);
 | |
|   TargetOS:=AProject.CompilerOptions.GetEffectiveTargetOS;
 | |
|   if TargetOS<>GetCompiledTargetOS then
 | |
|     Title+=Format(lisOS, [TargetOS]);
 | |
|   TargetCPU:=AProject.CompilerOptions.GetEffectiveTargetCPU;
 | |
|   if TargetCPU<>GetCompiledTargetCPU then
 | |
|     Title+=Format(lisCPU, [TargetCPU]);
 | |
|   TargetFilename:=AProject.GetShortFilename(
 | |
|           AProject.CompilerOptions.CreateTargetFilename,false);
 | |
|   if TargetFilename<>'' then
 | |
|     Title+=Format(lisTarget2, [TargetFilename]);
 | |
| 
 | |
|   Tool:=ExternalToolList.Add(Title);
 | |
|   Tool.Reference(Self,ClassName);
 | |
|   try
 | |
|     Tool.Data:=TIDEExternalToolData.Create(IDEToolCompileProject,'',AProject.ProjectInfoFile);
 | |
|     Tool.FreeData:=true;
 | |
|     Tool.Hint:=aCompileHint;
 | |
|     Tool.Process.Executable:=CompilerFilename;
 | |
|     Tool.CmdLineParams:=CmdLine;
 | |
|     Tool.Process.CurrentDirectory:=WorkingDir;
 | |
|     Tool.CurrentDirectoryIsTestDir:=CurrentDirectoryIsTestDir;
 | |
|     FPCParser:=TFPCParser(Tool.AddParsers(SubToolFPC));
 | |
|     FPCParser.ShowLinesCompiled:=EnvironmentOptions.MsgViewShowFPCMsgLinesCompiled;
 | |
|     FPCParser.HideHintsSenderNotUsed:=not AProject.CompilerOptions.ShowHintsForSenderNotUsed;
 | |
|     FPCParser.HideHintsUnitNotUsedInMainSource:=not AProject.CompilerOptions.ShowHintsForUnusedUnitsInMainSrc;
 | |
|     if (not AProject.CompilerOptions.ShowHintsForUnusedUnitsInMainSrc)
 | |
|     and (AProject.MainFilename<>'') then
 | |
|       FPCParser.FilesToIgnoreUnitNotUsed.Add(AProject.MainFilename);
 | |
|     Tool.AddParsers(SubToolMake);
 | |
|     Tool.Execute;
 | |
|     Tool.WaitForExit;
 | |
|     if Tool.ErrorMessage='' then
 | |
|       Result:=mrOK;
 | |
|   finally
 | |
|     Tool.Release(Self);
 | |
|   end;
 | |
|   if ConsoleVerbosity>=0 then
 | |
|     DebugLn('[TCompiler.Compile] end');
 | |
| end;
 | |
| 
 | |
| procedure TCompiler.WriteError(const Msg: string);
 | |
| begin
 | |
|   DebugLn('TCompiler.WriteError ',Msg);
 | |
|   if IDEMessagesWindow<>nil then
 | |
|     IDEMessagesWindow.AddCustomMessage(mluError,Msg);
 | |
| end;
 | |
| 
 | |
| // Compiler options parsed from "fpc -h" and "fpc -i".
 | |
| 
 | |
| var
 | |
|   OptionIdCounter: integer;
 | |
| 
 | |
| 
 | |
| function NextOptionId: integer;
 | |
| begin
 | |
|   Result := OptionIdCounter;
 | |
|   Inc(OptionIdCounter);
 | |
| end;
 | |
| 
 | |
| function CalcIndentation(s: string): integer;
 | |
| begin
 | |
|   Result := 0;
 | |
|   while (Result < Length(s)) and (s[Result+1] = ' ') do
 | |
|     Inc(Result);
 | |
| end;
 | |
| 
 | |
| function IsIgnoredOption(aOpt: string): Boolean;
 | |
| begin
 | |
|   if Length(aOpt) < 2 then Exit(False);
 | |
|   // Ignore : * information
 | |
|   //          * all file names and paths
 | |
|   //          * executable path
 | |
|   //          * change name of produced executable
 | |
|   //          * define and undefine
 | |
|   //          * set language mode
 | |
|   //          * target operating system
 | |
|   Result := aOpt[2] in ['i', 'F', 'e', 'o', 'd', 'u', 'M', 'T'];
 | |
| end;
 | |
| 
 | |
| 
 | |
| { TCompilerOpt }
 | |
| 
 | |
| constructor TCompilerOpt.Create(aOwnerGroup: TCompilerOptGroup);
 | |
| begin
 | |
|   inherited Create;
 | |
|   fOwnerGroup := aOwnerGroup;
 | |
|   if Assigned(aOwnerGroup) then
 | |
|     aOwnerGroup.fCompilerOpts.Add(Self);
 | |
|   fId := NextOptionId;
 | |
|   fOrigLine := -1;
 | |
| end;
 | |
| 
 | |
| destructor TCompilerOpt.Destroy;
 | |
| begin
 | |
|   inherited Destroy;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOpt.AddChoicesByOptOld;
 | |
| // From FPC 2.6.x output
 | |
| 
 | |
|   procedure AddChoices(aCategory: string);
 | |
|   // Add selection choices for this option. Data originates from "fpc -i".
 | |
|   var
 | |
|     i: Integer;
 | |
|   begin
 | |
|     with fOwnerGroup.fOwnerReader do
 | |
|       if fSupportedCategories.Find(aCategory, i) then
 | |
|         fChoices := fSupportedCategories.Objects[i] as TStrings
 | |
|       else
 | |
|         raise Exception.CreateFmt('No selection list for "%s" found.', [aCategory]);
 | |
|   end;
 | |
| 
 | |
| begin
 | |
|   if Pos('fpc -i', fDescription) = 0 then Exit;
 | |
|   fEditKind := oeList;                 // Values will be got later.
 | |
|   case fOption of
 | |
|     '-Ca': AddChoices('ABI targets:');
 | |
|     '-Cf': AddChoices('FPU instruction sets:');
 | |
|     '-Cp': AddChoices('CPU instruction sets:');
 | |
| //      '-Oo', '-Oo[NO]': AddChoices('Optimizations:');
 | |
|     '-Op': AddChoices('CPU instruction sets:');
 | |
| //      '-OW': AddChoices('Whole Program Optimizations:');
 | |
| //      '-Ow': AddChoices('Whole Program Optimizations:');
 | |
|     else
 | |
|       raise Exception.Create('Don''t know where to get selection list for option '+fOption);
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOpt.ParseEditKind;
 | |
| begin
 | |
|   // Guess whether this option can be edited and what is the EditKind
 | |
|   fEditKind := oeBoolean;                  // Default kind
 | |
|   if (Length(fSuffix) = 3) and (fSuffix[1] = '<') and (fSuffix[3] = '>') then
 | |
|     case fSuffix[2] of
 | |
|       'x': fEditKind:=oeText;              // <x>
 | |
|       'n': fEditKind:=oeNumber;            // <n>
 | |
|     end;
 | |
|   if fOwnerGroup.fOwnerReader.fIsNewFpc then begin
 | |
|     fChoices := fOwnerGroup.fOwnerReader.AddChoicesNew(fDescription);
 | |
|     if Assigned(fChoices) then
 | |
|       fEditKind := oeList;
 | |
|   end
 | |
|   else
 | |
|     AddChoicesByOptOld;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOpt.ParseOption(aDescr: string; aIndent: integer);
 | |
| var
 | |
|   i: Integer;
 | |
| begin
 | |
|   fIndentation := aIndent;
 | |
|   // Separate the actual option and description from each other
 | |
|   if aDescr[1] <> '-' then
 | |
|     raise Exception.CreateFmt('Option "%s" does not start with "-"', [aDescr]);
 | |
|   i := 1;
 | |
|   while (i <= Length(aDescr)) and (aDescr[i] <> ' ') do
 | |
|     Inc(i);
 | |
|   fOption := Copy(aDescr, 1, i-1);
 | |
|   while (i <= Length(aDescr)) and (aDescr[i] = ' ') do
 | |
|     Inc(i);
 | |
|   fDescription := Copy(aDescr, i, Length(aDescr));
 | |
|   i := Length(fOption);
 | |
|   if (i > 3) and (fOption[i-2] = '<') and (fOption[i] = '>') then
 | |
|   begin
 | |
|     // Move <x> in the end to Suffix. We need the pure option later.
 | |
|     fSuffix := Copy(fOption, i-2, i);
 | |
|     fOption := Copy(fOption, 1, i-3);
 | |
|   end;
 | |
|   if fOwnerGroup.fIgnored or IsIgnoredOption(fOption) then
 | |
|     fIgnored := True;
 | |
|   ParseEditKind;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOpt.Filter(aFilter: string; aOnlySelected: Boolean);
 | |
| var
 | |
|   //iOpt, iDes: SizeInt;
 | |
|   HideNonSelected: Boolean;
 | |
| begin
 | |
|   HideNonSelected := (fValue='') and aOnlySelected;
 | |
|   Visible := not (fIgnored or HideNonSelected)
 | |
|     and ( (aFilter='') or (Pos(aFilter,UTF8LowerCase(fOption))>0)
 | |
|                        or (Pos(aFilter,UTF8LowerCase(fDescription))>0) );
 | |
| {
 | |
|   if aFilter = '' then
 | |
|     Visible := not (fIgnored or HideNonSelected)
 | |
|   else begin
 | |
|     iOpt := Pos(aFilter,UTF8LowerCase(fOption));
 | |
|     iDes := Pos(aFilter,UTF8LowerCase(fDescription));
 | |
|     Visible := not (fIgnored or HideNonSelected) and ( (iOpt>0) or (iDes>0) );
 | |
|     if Visible then
 | |
|       DebugLn(['TCompilerOpt.Filter match "', aFilter, '": iOpt=', iOpt,
 | |
|         ', iDes=', iDes, ', Ignore=', fIgnored, ', aOnlySelected=', aOnlySelected,
 | |
|         ', Opt'=fOption, ', Descr=', fDescription]);
 | |
|   end;
 | |
| }
 | |
| end;
 | |
| 
 | |
| const
 | |
|   CommentId = '-dLazIdeComment_';
 | |
| 
 | |
| function TCompilerOpt.Comment: string;
 | |
| begin
 | |
|   Result := '  ' + CommentId + StringReplace(fDescription,' ','_',[rfReplaceAll]);
 | |
| end;
 | |
| 
 | |
| function TCompilerOpt.GenerateOptValue(aUseComments: Boolean): string;
 | |
| begin
 | |
|   if fValue = '' then Exit('');
 | |
|   if fValue = 'True' then                  // Boolean
 | |
|     Result := fOption
 | |
|   else                                     // or value of other kind
 | |
|     Result := fOption + StrToCmdLineParam(Value);
 | |
|   // ToDo: Show "//" comment in editor and change to a define when storing.
 | |
|   //   Result := '    // ' + aOpt.Description
 | |
|   if aUseComments then  // Replace illegal characters with '_' in comment
 | |
|     Result := Result + Comment;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOpt.SetValue(aValue: string; aOrigLine: integer);
 | |
| begin
 | |
|   fValue := aValue;
 | |
|   fOrigLine := aOrigLine;
 | |
| end;
 | |
| 
 | |
| function TCompilerOpt.CalcLeft(aDefaultLeft, aLimit: integer): integer;
 | |
| var
 | |
|   Len: Integer;
 | |
| begin
 | |
|   Len := (fIndentation div 2) + Length(fOption);      // Approximation
 | |
|   if Len > aLimit then
 | |
|     Result := aDefaultLeft + (Len-aLimit)*8
 | |
|   else
 | |
|     Result := aDefaultLeft;
 | |
| end;
 | |
| 
 | |
| { TCompilerOptGroup }
 | |
| 
 | |
| constructor TCompilerOptGroup.Create(aOwnerReader: TCompilerOptReader; aOwnerGroup: TCompilerOptGroup);
 | |
| begin
 | |
|   inherited Create(aOwnerGroup);
 | |
|   fOwnerReader := aOwnerReader;
 | |
|   fCompilerOpts := TCompilerOptList.Create;
 | |
| end;
 | |
| 
 | |
| destructor TCompilerOptGroup.Destroy;
 | |
| begin
 | |
|   fCompilerOpts.Free;
 | |
|   inherited Destroy;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptGroup.Clear;
 | |
| begin
 | |
|   fCompilerOpts.Clear;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptGroup.FindOption(aOptStr: string): TCompilerOpt;
 | |
| 
 | |
|   function FindOptionSub(aRoot: TCompilerOpt): TCompilerOpt;
 | |
|   var
 | |
|     Children: TCompilerOptList;
 | |
|     i: Integer;
 | |
|   begin
 | |
|     Result := Nil;
 | |
|     if aRoot is TCompilerOptGroup then
 | |
|     begin
 | |
|       Children := TCompilerOptGroup(aRoot).CompilerOpts;
 | |
|       if aRoot is TCompilerOptSet then
 | |
|       begin                  // TCompilerOptSet
 | |
|         if AnsiStartsStr(aRoot.Option, aOptStr) then
 | |
|         begin
 | |
|           with TCompilerOptSet(aRoot) do
 | |
|             SelectOptions(Copy(aOptStr, Length(aRoot.Option)+1, Length(aOptStr)));
 | |
|           Result := aRoot;
 | |
|         end;
 | |
|       end
 | |
|       else begin             // TCompilerOptGroup
 | |
|         for i := 0 to Children.Count-1 do         // Recursive call for children.
 | |
|         begin
 | |
|           Result := FindOptionSub(TCompilerOpt(Children[i]));
 | |
|           if Assigned(Result) then Break;
 | |
|         end;
 | |
|       end;
 | |
|     end
 | |
|     else begin               // TCompilerOpt
 | |
|       if aRoot.Option = aOptStr then
 | |
|         Result := aRoot
 | |
|       else if (aRoot.EditKind = oeText) and AnsiStartsStr(aRoot.Option, aOptStr) then
 | |
|       begin
 | |
|         aRoot.SetValue(Copy(aOptStr, Length(aRoot.Option)+1, Length(aOptStr)),
 | |
|                        fOwnerReader.fCurOrigLine);
 | |
|         Result := aRoot;
 | |
|       end;
 | |
|     end;
 | |
|   end;
 | |
| 
 | |
| begin
 | |
|   Result := FindOptionSub(Self);
 | |
| end;
 | |
| 
 | |
| function TCompilerOptGroup.FindOptionById(aId: integer): TCompilerOpt;
 | |
| 
 | |
|   function FindOptionSub(aRoot: TCompilerOpt): TCompilerOpt;
 | |
|   var
 | |
|     Children: TCompilerOptList;
 | |
|     i: Integer;
 | |
|   begin
 | |
|     Result := Nil;
 | |
|     if aRoot is TCompilerOptGroup then
 | |
|     begin
 | |
|       Children := TCompilerOptGroup(aRoot).CompilerOpts;
 | |
|       for i := 0 to Children.Count-1 do         // Recursive call for children.
 | |
|       begin
 | |
|         Result := FindOptionSub(TCompilerOpt(Children[i]));
 | |
|         if Assigned(Result) then Break;
 | |
|       end;
 | |
|     end
 | |
|     else begin               // TCompilerOpt
 | |
|       if aRoot.fId = aId then
 | |
|         Result := aRoot;
 | |
|     end;
 | |
|   end;
 | |
| 
 | |
| begin
 | |
|   Result := FindOptionSub(Self);
 | |
| end;
 | |
| 
 | |
| function TCompilerOptGroup.OneCharOptions(aOptAndValue: string): TCompilerOpt;
 | |
| // Split and select option characters like in -Criot.
 | |
| // Returns reference to the last option object if all characters were valid opts.
 | |
| var
 | |
|   i: Integer;
 | |
|   OptBase: String;
 | |
|   List: TList;
 | |
| begin
 | |
|   List := TList.Create;
 | |
|   try
 | |
|     OptBase := Copy(aOptAndValue, 1, 2);
 | |
|     // First check if all options are valid. Change them only if they are valid.
 | |
|     for i := 3 to Length(aOptAndValue) do
 | |
|     begin
 | |
|       Result := FindOption(OptBase + aOptAndValue[i]);
 | |
|       if Assigned(Result) then
 | |
|         List.Add(Result)
 | |
|       else
 | |
|         Break;
 | |
|     end;
 | |
|     // Set boolean options but only if they all are valid.
 | |
|     if Assigned(Result) then
 | |
|       for i := 0 to List.Count-1 do
 | |
|         TCompilerOpt(List[i]).SetValue('True', fOwnerReader.fCurOrigLine);
 | |
|   finally
 | |
|     List.Free;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptGroup.SelectOption(aOptAndValue: string): Boolean;
 | |
| var
 | |
|   Opt: TCompilerOpt;
 | |
|   Param: string;
 | |
|   OptLen, ParamLen: integer;
 | |
| begin
 | |
|   Opt := FindOption(aOptAndValue);
 | |
|   if Assigned(Opt) then
 | |
|   begin
 | |
|     // Found. Set boolean option, other type of options are already set.
 | |
|     if Opt.EditKind = oeBoolean then
 | |
|       Opt.SetValue('True', fOwnerReader.fCurOrigLine);
 | |
|   end
 | |
|   else begin
 | |
|     // Option was not found, try separating the parameter.
 | |
|     // ToDo: figure out the length in a more clever way.
 | |
|     if (Length(aOptAndValue) < 3) or (aOptAndValue[1] <> '-') then
 | |
|       Exit(False);
 | |
|     if aOptAndValue[2] in ['e', 'u', 'I', 'k', 'o'] then
 | |
|       OptLen := 2
 | |
|     else
 | |
|       OptLen := 3;
 | |
|     ParamLen := Length(aOptAndValue) - OptLen;
 | |
|     Opt := Nil;
 | |
|     if (ParamLen > 1)
 | |
|     and (aOptAndValue[OptLen+1] in ['''', '"'])
 | |
|     and (aOptAndValue[Length(aOptAndValue)] in ['''', '"']) then
 | |
|       Param := Copy(aOptAndValue, OptLen+2, ParamLen-2) // Strip quotes
 | |
|     else begin
 | |
|       Param := Copy(aOptAndValue, OptLen+1, ParamLen);
 | |
|       if OptLen = 3 then // Can contain one char options like -Criot. Can be combined.
 | |
|         Opt := OneCharOptions(aOptAndValue);
 | |
|     end;
 | |
|     if Opt = Nil then
 | |
|     begin
 | |
|       Opt := FindOption(Copy(aOptAndValue, 1, OptLen));
 | |
|       if Assigned(Opt) then
 | |
|       begin
 | |
|         Assert(Opt.Value='', 'TCompilerOptGroup.SelectOption: Opt.Value is already set.');
 | |
|         Opt.SetValue(Param, fOwnerReader.fCurOrigLine)
 | |
|       end;
 | |
|     end;
 | |
|   end;
 | |
|   Result := Assigned(Opt);
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptGroup.DeselectAll;
 | |
| 
 | |
|   procedure DeselectSub(aRoot: TCompilerOpt);
 | |
|   var
 | |
|     Children: TCompilerOptList;
 | |
|     i: Integer;
 | |
|   begin
 | |
|     if aRoot is TCompilerOptGroup then
 | |
|     begin
 | |
|       Children := TCompilerOptGroup(aRoot).CompilerOpts;
 | |
|       for i := 0 to Children.Count-1 do         // Recursive call for children.
 | |
|         DeselectSub(TCompilerOpt(Children[i]));
 | |
|     end
 | |
|     else
 | |
|       aRoot.SetValue('', -1);       // TCompilerOpt
 | |
|   end;
 | |
| 
 | |
| begin
 | |
|   DeselectSub(Self);
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptGroup.ParseEditKind;
 | |
| begin
 | |
|   fEditKind := oeGroup;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptGroup.ParseOption(aDescr: string; aIndent: integer);
 | |
| var
 | |
|   i: Integer;
 | |
| begin
 | |
|   inherited ParseOption(aDescr, aIndent);
 | |
|   i := Length(fOption);
 | |
|   fIncludeNegativeOpt := Copy(fOption, i-3, 4) = '[NO]';
 | |
|   if fIncludeNegativeOpt then
 | |
|     SetLength(fOption, i-4);
 | |
| end;
 | |
| 
 | |
| { TCompilerOptSet }
 | |
| 
 | |
| constructor TCompilerOptSet.Create(aOwnerReader: TCompilerOptReader;
 | |
|   aOwnerGroup: TCompilerOptGroup; aCommonIndent: integer);
 | |
| begin
 | |
|   inherited Create(aOwnerReader, aOwnerGroup);
 | |
|   fCommonIndent := aCommonIndent;
 | |
| end;
 | |
| 
 | |
| destructor TCompilerOptSet.Destroy;
 | |
| begin
 | |
|   inherited Destroy;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptSet.CollectSelectedOptions(aUseComments: Boolean): string;
 | |
| // Collect subitems of a set to one option.
 | |
| var
 | |
|   Opt: TCompilerOpt;
 | |
|   i: Integer;
 | |
|   s: string;
 | |
| begin
 | |
|   s := '';
 | |
|   for i := 0 to fCompilerOpts.Count-1 do
 | |
|   begin
 | |
|     Opt := TCompilerOpt(fCompilerOpts[i]);
 | |
|     if Opt.Value <> '' then
 | |
|       case Opt.EditKind of
 | |
|         oeSetElem  : s := s + Opt.Option;
 | |
|         oeSetNumber: s := s + Opt.Value;
 | |
|       end;
 | |
|   end;
 | |
|   if s <> '' then begin
 | |
|     Result := Option + s;
 | |
|     if aUseComments then
 | |
|       Result := Result + Comment;
 | |
|   end
 | |
|   else
 | |
|     Result := '';
 | |
| end;
 | |
| 
 | |
| function TCompilerOptSet.SetNumberOpt(aValue: string): Boolean;
 | |
| // Find a numeric value in the set and update its value. Return True on success.
 | |
| var
 | |
|   i: Integer;
 | |
|   Opt: TCompilerOpt;
 | |
| begin
 | |
|   for i := 0 to fCompilerOpts.Count-1 do
 | |
|   begin
 | |
|     Opt := TCompilerOpt(fCompilerOpts[i]);
 | |
|     if Opt.EditKind = oeSetNumber then
 | |
|     begin
 | |
|       Opt.SetValue(aValue, fOwnerReader.fCurOrigLine);
 | |
|       Exit(True);           // Found and updated.
 | |
|     end;
 | |
|   end;
 | |
|   Result := False;          // Not found.
 | |
| end;
 | |
| 
 | |
| function TCompilerOptSet.SetBooleanOpt(aValue: string): Boolean;
 | |
| // Find a single letter value in the set and update its value. Return True on success.
 | |
| var
 | |
|   i: Integer;
 | |
|   Opt: TCompilerOpt;
 | |
| begin
 | |
|   for i := 0 to fCompilerOpts.Count-1 do
 | |
|   begin
 | |
|     Opt := TCompilerOpt(fCompilerOpts[i]);
 | |
|     if (Opt.EditKind = oeSetElem) and (Opt.Option = aValue) then
 | |
|     begin
 | |
|       Opt.SetValue('True', fOwnerReader.fCurOrigLine);
 | |
|       Exit(True);           // Found and updated.
 | |
|     end;
 | |
|   end;
 | |
|   Result := False;          // Not found.
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptSet.SelectOptions(aOptStr: string);
 | |
| // Select options in this set based on the given characters.
 | |
| var
 | |
|   i, Start: Integer;
 | |
|   OneOpt: string;
 | |
|   OptOk: Boolean;
 | |
| begin
 | |
|   i := 1;
 | |
|   while i <= Length(aOptStr) do
 | |
|   begin
 | |
|     Start := i;
 | |
|     if aOptStr[i] in ['0'..'9'] then
 | |
|       while (i <= Length(aOptStr)) and (aOptStr[i] in ['0'..'9']) do
 | |
|         Inc(i)
 | |
|     else
 | |
|       Inc(i);
 | |
|     OneOpt := Copy(aOptStr, Start, i-Start);
 | |
|     if OneOpt[1] in ['0'..'9'] then
 | |
|       OptOk := SetNumberOpt(OneOpt)
 | |
|     else
 | |
|       OptOk := False;
 | |
|     if not (OptOk or SetBooleanOpt(OneOpt)) then
 | |
|       raise Exception.CreateFmt('Option %s is not found in set %s.', [OneOpt, fOption]);
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptSet.AddOptions(aDescr: string; aIndent: integer);
 | |
| // Set can have one letter options and <n> for numbers
 | |
| 
 | |
|   procedure NewSetNumber(aDescr: string);
 | |
|   var
 | |
|     OptSet: TCompilerOpt;
 | |
|   begin
 | |
|     OptSet := TCompilerOpt.Create(Self);          // Add it under a group
 | |
|     OptSet.fIndentation := aIndent;
 | |
|     OptSet.fOption := 'Number';
 | |
|     OptSet.fDescription := aDescr;
 | |
|     OptSet.fEditKind := oeSetNumber;
 | |
|   end;
 | |
| 
 | |
|   procedure NewSetElem(aDescr: string);
 | |
|   var
 | |
|     OptSet: TCompilerOpt;
 | |
|   begin
 | |
|     // Ignore -vl and -vs
 | |
|     if (fOption = '-v') and (aDescr[1] in ['l', 's']) then Exit;
 | |
|     OptSet := TCompilerOpt.Create(Self);          // Add it under a group
 | |
|     OptSet.fIndentation := aIndent;
 | |
|     OptSet.fOption := aDescr[1];
 | |
|     OptSet.fDescription := Copy(aDescr, 2, Length(aDescr));
 | |
|     OptSet.fEditKind := oeSetElem;
 | |
|   end;
 | |
| 
 | |
| var
 | |
|   Opt1, Opt2: string;
 | |
|   i: Integer;
 | |
| begin
 | |
|   if AnsiStartsStr('<n>', aDescr) then
 | |
|     NewSetNumber(aDescr)
 | |
|   else begin
 | |
|     i := PosEx(':', aDescr, 4);
 | |
|     if (i > 0) and (aDescr[i-1]=' ') and (aDescr[i-2]<>' ') and (aDescr[i-3]=' ') then
 | |
|     begin
 | |
|       // Found another option on the same line, like ' a :'
 | |
|       Opt2 := Copy(aDescr, i-2, Length(aDescr));
 | |
|       if aDescr[3] = ':' then
 | |
|         Opt1 := TrimRight(Copy(aDescr, 1, i-3))
 | |
|       else
 | |
|         Opt1 := '';
 | |
|     end
 | |
|     else begin
 | |
|       Opt2 := '';
 | |
|       Opt1 := aDescr;
 | |
|     end;
 | |
|     if Opt1 <> '' then         // Can be empty when line in help output is split.
 | |
|       NewSetElem(Opt1)
 | |
|     else if fCompilerOpts.Count > 0 then
 | |
|       aIndent := TCompilerOpt(fCompilerOpts[0]).Indentation;
 | |
|     if Opt2 <> '' then
 | |
|       NewSetElem(Opt2);
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptSet.ParseEditKind;
 | |
| begin
 | |
|   fEditKind := oeSet;
 | |
| end;
 | |
| 
 | |
| 
 | |
| { TCompilerOptReader }
 | |
| 
 | |
| constructor TCompilerOptReader.Create;
 | |
| begin
 | |
|   inherited Create;
 | |
|   fDefines := TStringList.Create;
 | |
|   fInvalidOptions := TStringList.Create;
 | |
|   fSupportedCategories := TStringList.Create;
 | |
|   fSupportedCategories.Sorted := True;
 | |
|   fGeneratedOptions := TStringList.Create;
 | |
|   fRootOptGroup := TCompilerOptGroup.Create(Self, Nil);
 | |
| end;
 | |
| 
 | |
| destructor TCompilerOptReader.Destroy;
 | |
| begin
 | |
|   Clear;
 | |
|   fRootOptGroup.Free;
 | |
|   fGeneratedOptions.Free;
 | |
|   fSupportedCategories.Free;
 | |
|   fInvalidOptions.Free;
 | |
|   fDefines.Free;
 | |
|   inherited Destroy;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptReader.Clear;
 | |
| var
 | |
|   i: Integer;
 | |
| begin
 | |
|   fRootOptGroup.Clear;
 | |
|   for i := 0 to fSupportedCategories.Count-1 do
 | |
|     fSupportedCategories.Objects[i].Free;
 | |
|   fSupportedCategories.Clear;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.AddChoicesNew(aOpt: string): TStrings;
 | |
| // From FPC 2.7.1+ output
 | |
| const
 | |
|   FpcIStart = 'see fpc -i or fpc -i';
 | |
| var
 | |
|   ch: Char;
 | |
|   i: integer;
 | |
| begin
 | |
|   Result := Nil;
 | |
|   i := Pos(FpcIStart, aOpt);
 | |
|   if i = 0 then Exit;
 | |
|   Assert(Length(aOpt) >= i+Length(FpcIStart));
 | |
|   ch := aOpt[i+Length(FpcIStart)]; // Pick the next char from description.
 | |
|   if fSupportedCategories.Find(ch, i) then
 | |
|     Result := fSupportedCategories.Objects[i] as TStrings
 | |
|   else begin
 | |
|     Result := ReadCategorySelections(ch);
 | |
|     Result.Insert(0, ''); // First an empty string. Allows removing selection.
 | |
|     fSupportedCategories.AddObject(ch, Result);
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.IsGroup(aOpt: string; var aCategoryList: TStrings): Boolean;
 | |
| // This option should be a group instead of a selection list.
 | |
| // The information is not available in fpc -h output.
 | |
| var
 | |
|   i: Integer;
 | |
|   CategoryName: string;
 | |
| begin
 | |
|   Result := False;
 | |
|   if fIsNewFpc then
 | |
|   begin
 | |
|     // FPC 2.7.1+
 | |
|     if AnsiStartsStr('-Oo', aOpt)
 | |
|     or AnsiStartsStr('-OW', aOpt)
 | |
|     or AnsiStartsStr('-Ow', aOpt) then
 | |
|     begin
 | |
|       aCategoryList := AddChoicesNew(aOpt);
 | |
|       Result := Assigned(aCategoryList);
 | |
|     end;
 | |
|   end
 | |
|   else begin
 | |
|     // FPC 2.6.x
 | |
|     CategoryName := '';
 | |
|     if AnsiStartsStr('-Oo', aOpt) then
 | |
|       CategoryName := 'Optimizations:'
 | |
|     else if AnsiStartsStr('-OW', aOpt) or AnsiStartsStr('-Ow', aOpt) then
 | |
|       CategoryName := 'Whole Program Optimizations:';
 | |
|     Result := CategoryName <> '';
 | |
|     if Result then
 | |
|       if fSupportedCategories.Find(CategoryName, i) then
 | |
|         aCategoryList := fSupportedCategories.Objects[i] as TStrings
 | |
|       else
 | |
|         raise Exception.CreateFmt('No list of options found for "%s".', [CategoryName]);
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.AddNewCategory(aCategoryName: String): TStringList;
 | |
| begin
 | |
|   Result := TStringList.Create;
 | |
|   Result.Add('');      // First an empty string. Allows removing selection.
 | |
|   fSupportedCategories.AddObject(aCategoryName, Result);
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.ParseI(aLines: TStringList): TModalResult;
 | |
| const
 | |
|   Supported = 'Supported ';
 | |
| var
 | |
|   i, j: Integer;
 | |
|   Line, TrimmedLine: String;
 | |
|   Category, sl: TStringList;
 | |
| begin
 | |
|   Result := mrOK;
 | |
|   Category := Nil;
 | |
|   sl := TStringList.Create;
 | |
|   try
 | |
|     sl.StrictDelimiter := True;
 | |
|     sl.Delimiter := ',';
 | |
|     for i := 0 to aLines.Count-1 do
 | |
|     begin
 | |
|       Line := aLines[i];
 | |
|       TrimmedLine := Trim(Line);
 | |
|       if Assigned(Category) then
 | |
|       begin
 | |
|         if TrimmedLine = '' then
 | |
|           Category := Nil             // End of category.
 | |
|         else begin
 | |
|           if Line[1] <> ' ' then
 | |
|             raise Exception.Create('TCompilerReader.ParseI: Line should start with a space.');
 | |
|           sl.Clear;
 | |
|           // Some old FPC versions had a comma separated list.
 | |
|           sl.DelimitedText := Trim(Line);
 | |
|           for j := 0 to sl.Count-1 do
 | |
|             Category.Add(sl[j]);
 | |
|         end;
 | |
|       end
 | |
|       else if AnsiStartsStr(Supported, Line) then
 | |
|         Category := AddNewCategory(Copy(Line, Length(Supported)+1, Length(Line)));
 | |
|     end;
 | |
|   finally
 | |
|     sl.Free;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.ReadVersion(s: string): Boolean;
 | |
| const
 | |
|   VersBegin = 'Free Pascal Compiler version ';
 | |
| var
 | |
|   Start, V1, V2: Integer;
 | |
|   OutputI: TStringList;      // fpc -Fr$(FPCMsgFile) -i
 | |
| begin
 | |
|   Result := AnsiStartsStr(VersBegin, s);
 | |
|   if Result then
 | |
|   begin
 | |
|     fIsNewFpc := False;
 | |
|     Start := Length(VersBegin)+1;
 | |
|     V1 := PosEx(' ', s, Start);
 | |
|     if V1 > 0 then
 | |
|     begin
 | |
|       fFpcVersion := Copy(s, Start, V1-Start);
 | |
|       if (Length(fFpcVersion)>2) then begin
 | |
|         V1 := StrToIntDef(fFpcVersion[1], 0);
 | |
|         V2 := StrToIntDef(fFpcVersion[3], 0);
 | |
|         fIsNewFpc := ((V1=2) and (V2>=7)) or (V1>2);
 | |
|       end;
 | |
|       // The rest 2 fields are date and target CPU.
 | |
|     end;
 | |
|     if not fIsNewFpc then
 | |
|     begin
 | |
|       // Get categories with FPC -i, once we know the version is old (2.6.x).
 | |
|       OutputI := RunTool(fCompilerExecutable, fParsedTarget + ' -i');
 | |
|       if OutputI = Nil then Exit(False);
 | |
|       try
 | |
|         Result := ParseI(OutputI) = mrOK;
 | |
|       finally
 | |
|         OutputI.Free;
 | |
|       end;
 | |
|     end;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptReader.CreateNewGroupItem(aGroup: TCompilerOptGroup; aTxt: string);
 | |
| var
 | |
|   Opt: TCompilerOpt;
 | |
| begin
 | |
|   Opt := TCompilerOpt.Create(aGroup);  // Add it under a group
 | |
|   Opt.fOption := aGroup.Option + aTxt;
 | |
|   Opt.fIndentation := aGroup.Indentation+4;
 | |
|   Opt.fEditKind := oeBoolean;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptReader.AddGroupItems(aGroup: TCompilerOptGroup; aItems: TStrings);
 | |
| var
 | |
|   i: Integer;
 | |
| begin
 | |
|   for i := 1 to aItems.Count-1 do        // Skip the first empty item.
 | |
|   begin
 | |
|     CreateNewGroupItem(aGroup, aItems[i]);
 | |
|     if aGroup.fIncludeNegativeOpt then
 | |
|       CreateNewGroupItem(aGroup, 'NO'+aItems[i]);
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.ParseH(aLines: TStringList): TModalResult;
 | |
| const
 | |
|   OptSetId = 'a combination of';
 | |
| var
 | |
|   i, ThisInd, NextInd, OptSetInd: Integer;
 | |
|   ThisLine: String;
 | |
|   Opt: TCompilerOpt;
 | |
|   LastGroup, SubGroup: TCompilerOptGroup;
 | |
|   GroupItems: TStrings;
 | |
| begin
 | |
|   Result := mrOK;
 | |
|   LastGroup := fRootOptGroup;
 | |
|   GroupItems:=nil;
 | |
|   for i := 0 to aLines.Count-1 do
 | |
|   begin
 | |
|     ThisLine := StringReplace(aLines[i],'-Agas-darwinAssemble','-Agas-darwin Assemble',[]);
 | |
|     ThisInd := CalcIndentation(ThisLine);
 | |
|     ThisLine := Trim(ThisLine);
 | |
|     if LastGroup is TCompilerOptSet then
 | |
|     begin                  // Fix strangely split line indents in options groups.
 | |
|       OptSetInd := TCompilerOptSet(LastGroup).CommonIndent;
 | |
|       if (ThisLine[1] <> '-') and (ThisInd > OptSetInd) then
 | |
|         ThisInd := OptSetInd;
 | |
|     end;
 | |
|     // Top header line for compiler version, check only once.
 | |
|     if (fFpcVersion = '') and ReadVersion(ThisLine) then Continue;
 | |
|     if ThisInd < 2 then Continue;
 | |
|     if (ThisLine = '') or (ThisInd > 30)
 | |
|     or (ThisLine[1] = '@')
 | |
|     or (Pos('-? ', ThisLine) > 0)
 | |
|     or (Pos('-h ', ThisLine) > 0) then Continue;
 | |
|     if i < aLines.Count-1 then
 | |
|       NextInd := CalcIndentation(aLines[i+1])
 | |
|     else
 | |
|       NextInd := -1;
 | |
|     if NextInd > ThisInd then
 | |
|     begin
 | |
|       if LastGroup is TCompilerOptSet then
 | |
|         NextInd := TCompilerOptSet(LastGroup).CommonIndent
 | |
|       else begin
 | |
|         if Pos(OptSetId, ThisLine) > 0 then       // Header for sets
 | |
|           // Hard-code indent to NextInd, for strangely split lines later in help output.
 | |
|           LastGroup := TCompilerOptSet.Create(Self, LastGroup, NextInd)
 | |
|         else                                      // Group header for options
 | |
|           LastGroup := TCompilerOptGroup.Create(Self, LastGroup);
 | |
|         LastGroup.ParseOption(ThisLine, ThisInd);
 | |
|       end;
 | |
|     end;
 | |
|     if NextInd <= ThisInd then
 | |
|     begin
 | |
|       // This is an option
 | |
|       if LastGroup is TCompilerOptSet then      // Add it to a set (may add many)
 | |
|         TCompilerOptSet(LastGroup).AddOptions(ThisLine, ThisInd)
 | |
|       else begin
 | |
|         if IsGroup(ThisLine, GroupItems) then
 | |
|         begin
 | |
|           SubGroup := TCompilerOptGroup.Create(Self, LastGroup);
 | |
|           SubGroup.ParseOption(ThisLine, ThisInd);
 | |
|           AddGroupItems(SubGroup, GroupItems);
 | |
|         end
 | |
|         else begin
 | |
|           Opt := TCompilerOpt.Create(LastGroup);  // Add it under a group
 | |
|           Opt.ParseOption(ThisLine, ThisInd);
 | |
|         end;
 | |
|       end;
 | |
|       if (NextInd <> -1) and (NextInd < ThisInd) then
 | |
|         LastGroup := LastGroup.fOwnerGroup;       // Return to a previous group
 | |
|     end;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.UpdateTargetParam: Boolean;
 | |
| // Updates target OS and CPU parameter using global macros.
 | |
| // Returns true if the value has changed since last time.
 | |
| var
 | |
|   NewTarget: string;
 | |
| begin
 | |
|   NewTarget := '-T$(TargetOS) -P$(TargetCPU)';
 | |
|   if not GlobalMacroList.SubstituteStr(NewTarget) then
 | |
|     raise Exception.CreateFmt('UpdateTargetParam: Cannot substitute macros "%s".',
 | |
|                               [NewTarget]);
 | |
|   Result := fParsedTarget <> NewTarget;
 | |
|   if Result then
 | |
|     fParsedTarget := NewTarget;      // fParsedTarget is used as a param for FPC.
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.ReadCategorySelections(aChar: Char): TStringList;
 | |
| // Get the selection list for a category using "fpc -i+char", for new FPC versions.
 | |
| begin
 | |
|   Result:=RunTool(fCompilerExecutable, fParsedTarget + ' -i' + aChar);
 | |
|   Result.Sort;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.ReadAndParseOptions: TModalResult;
 | |
| // fpc -Fr$(FPCMsgFile) -h
 | |
| var
 | |
|   OutputH: TStringList;
 | |
| begin
 | |
|   if fCompilerExecutable = '' then
 | |
|     fCompilerExecutable := 'fpc';        // Let's hope "fpc" is found in PATH.
 | |
|   OptionIdCounter := 0;
 | |
|   fErrorMsg := '';
 | |
|   try
 | |
|     // FPC with option -h
 | |
|     OutputH := RunTool(fCompilerExecutable, fParsedTarget + ' -h');
 | |
|     if OutputH = Nil then Exit(mrCancel);
 | |
|     Result := ParseH(OutputH);
 | |
|   finally
 | |
|     OutputH.Free;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.FilterOptions(aFilter: string; aOnlySelected: Boolean): Boolean;
 | |
| // Filter all options recursively, setting their Visible flag as needed.
 | |
| // Returns True if Option(group) or child options have visible items.
 | |
| 
 | |
|   function FilterOptionsSub(aRoot: TCompilerOpt): Boolean;
 | |
|   var
 | |
|     Children: TCompilerOptList;
 | |
|     i: Integer;
 | |
|   begin
 | |
|     // Filter the root item
 | |
|     aRoot.Filter(aFilter, aOnlySelected);         // Sets Visible flag
 | |
|     // Filter children in a group
 | |
|     if aRoot is TCompilerOptGroup then
 | |
|     begin
 | |
|       Children := TCompilerOptGroup(aRoot).CompilerOpts;
 | |
|       for i := 0 to Children.Count-1 do           // Recursive call for children.
 | |
|         aRoot.Visible := FilterOptionsSub(TCompilerOpt(Children[i])) or aRoot.Visible;
 | |
|     end;
 | |
|     Result := aRoot.Visible;
 | |
|   end;
 | |
| 
 | |
| begin
 | |
|   Result := FilterOptionsSub(fRootOptGroup);
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.FindOptionById(aId: integer): TCompilerOpt;
 | |
| begin
 | |
|   Result := fRootOptGroup.FindOptionById(aId);
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.FromCustomOptions(aStrings: TStrings): TModalResult;
 | |
| // Example:  $(IDEBuildOptions) -dCR -dgc -Criot
 | |
| var
 | |
|   i, j: Integer;
 | |
|   s: String;
 | |
|   sl: TStringList;
 | |
| begin
 | |
|   Result := mrOK;
 | |
|   fCurOrigLine := 0;
 | |
|   fRootOptGroup.DeselectAll;
 | |
|   fDefines.Clear;
 | |
|   fInvalidOptions.Clear;
 | |
|   sl := TStringList.Create;
 | |
|   try
 | |
|     // Separate options that are on one line.
 | |
|     for i := 0 to aStrings.Count-1 do
 | |
|     begin
 | |
|       s := Trim(aStrings[i]);
 | |
|       if s = '' then Continue;
 | |
|       sl.Clear;
 | |
|       SplitCmdLineParams(s, sl);
 | |
|       for j := 0 to sl.Count-1 do begin
 | |
|         s := sl[j];
 | |
|         // Put the option into fDefines or fInvalidOptions, or set in options collection.
 | |
|         if AnsiStartsStr('-d', s) and (Length(s) > 2) then
 | |
|         begin
 | |
|           if not AnsiStartsStr(CommentId, s) then    // Skip a generated comment.
 | |
|             fDefines.Add(s)
 | |
|         end
 | |
|         else
 | |
|           if not fRootOptGroup.SelectOption(s) then
 | |
|             fInvalidOptions.AddObject(s, TObject({%H-}Pointer(PtrUInt(i))));
 | |
|         Inc(fCurOrigLine);
 | |
|       end;
 | |
|     end;
 | |
|   finally
 | |
|     sl.Free;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptReader.CopyOptions(aRoot: TCompilerOpt);
 | |
| // Collect non-default options from GUI to fGeneratedOptions
 | |
| var
 | |
|   Children: TCompilerOptList;
 | |
|   i: Integer;
 | |
|   s: string;
 | |
| begin
 | |
|   if aRoot is TCompilerOptGroup then
 | |
|   begin
 | |
|     Children := TCompilerOptGroup(aRoot).CompilerOpts;
 | |
|     if aRoot is TCompilerOptSet then
 | |
|     begin                                       // TCompilerOptSet
 | |
|       s := TCompilerOptSet(aRoot).CollectSelectedOptions(fUseComments);
 | |
|       if s <> '' then
 | |
|         fGeneratedOptions.AddObject(s, TObject({%H-}Pointer(PtrUInt(aRoot.fOrigLine))));
 | |
|     end
 | |
|     else begin                                  // TCompilerOptGroup
 | |
|       for i := 0 to Children.Count-1 do
 | |
|         CopyOptions(TCompilerOpt(Children[i])); // Recursive call for children.
 | |
|     end;
 | |
|   end
 | |
|   else if aRoot.Value <> '' then                // TCompilerOpt
 | |
|     fGeneratedOptions.AddObject(aRoot.GenerateOptValue(fUseComments),
 | |
|                                 TObject({%H-}Pointer(PtrUINt(aRoot.fOrigLine))));
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.FindLowestOrigLine(aStrings: TStrings;
 | |
|                                                out aOrigLine: Integer): integer;
 | |
| // Return index in aStrings for an option that has the lowest original line number.
 | |
| // aOrigLine returns the original line number.
 | |
| var
 | |
|   i, OriLine, MinOrigLine: Integer;
 | |
| begin
 | |
|   Result := -1;
 | |
|   aOrigLine := -1;
 | |
|   MinOrigLine := MaxInt;
 | |
|   for i := 0 to aStrings.Count-1 do
 | |
|   begin
 | |
|     OriLine := Integer({%H-}PtrUInt(aStrings.Objects[i]));
 | |
|     if (OriLine > -1) and (OriLine < MinOrigLine) then
 | |
|     begin
 | |
|       MinOrigLine := OriLine;
 | |
|       aOrigLine := OriLine;
 | |
|       Result := i;
 | |
|     end;
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.AddOptInLowestOrigLine(OutStrings: TStrings): Boolean;
 | |
| // Copy an option that had the lowest original line number.
 | |
| // Returns True if options from original data was found.
 | |
| var
 | |
|   iGen, iInv: Integer;
 | |
|   iGenOrig, iInvOrig: Integer;
 | |
| begin
 | |
|   // Find lowest lines from both generated and invalid options
 | |
|   iGen := FindLowestOrigLine(fGeneratedOptions, iGenOrig);
 | |
|   iInv := FindLowestOrigLine(fInvalidOptions, iInvOrig);
 | |
|   // then add the one that is lower.
 | |
|   if (iGenOrig = -1) and (iInvOrig = -1) then Exit(False);
 | |
|   Result := True;
 | |
|   if ( (iGenOrig > -1) and (iInvOrig > -1) and (iGenOrig <= iInvOrig) )
 | |
|   or ( (iGenOrig > -1) and (iInvOrig = -1) ) then
 | |
|   begin
 | |
|     OutStrings.Add(fGeneratedOptions[iGen]);
 | |
|     fGeneratedOptions[iGen] := '';
 | |
|     fGeneratedOptions.Objects[iGen] := TObject(Pointer(-1)); // Mark as processed.
 | |
|   end
 | |
|   else begin
 | |
|     OutStrings.Add(fInvalidOptions[iInv]);
 | |
|     fInvalidOptions[iInv] := '';
 | |
|     fInvalidOptions.Objects[iInv] := TObject(Pointer(-1));
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptReader.ToCustomOptions(aStrings: TStrings;
 | |
|   aUseComments: Boolean): TModalResult;
 | |
| // Copy options to a list if they have a non-default value (True for boolean).
 | |
| var
 | |
|   i: Integer;
 | |
| begin
 | |
|   Result := mrOK;
 | |
|   fUseComments := aUseComments;
 | |
|   fGeneratedOptions.Clear;
 | |
|   CopyOptions(fRootOptGroup);
 | |
|   // Options are now in fGeneratedOptions. Move them to aStrings in a right order.
 | |
|   aStrings.Clear;
 | |
|   // First collect options that were in the original list.
 | |
|   while AddOptInLowestOrigLine(aStrings) do ;
 | |
|   // Then add all the rest.
 | |
|   for i := 0 to fGeneratedOptions.Count-1 do
 | |
|     if fGeneratedOptions[i] <> '' then
 | |
|       aStrings.Add(fGeneratedOptions[i]);
 | |
|   // Then defines
 | |
|   aStrings.AddStrings(fDefines);
 | |
| end;
 | |
| 
 | |
| { TCompilerOptThread }
 | |
| 
 | |
| constructor TCompilerOptThread.Create(aReader: TCompilerOptReader);
 | |
| begin
 | |
|   inherited Create(True);
 | |
|   //FreeOnTerminate:=True;
 | |
|   fStartedOnce:=false;
 | |
|   fReader:=aReader;
 | |
| end;
 | |
| 
 | |
| destructor TCompilerOptThread.Destroy;
 | |
| begin
 | |
|   if fStartedOnce then
 | |
|     WaitFor;
 | |
|   Clear;
 | |
|   inherited Destroy;
 | |
| end;
 | |
| 
 | |
| function TCompilerOptThread.GetErrorMsg: string;
 | |
| begin
 | |
|   Result := fReader.ErrorMsg;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptThread.Clear;
 | |
| begin
 | |
|   ;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptThread.StartParsing;
 | |
| begin
 | |
|   if fStartedOnce then
 | |
|     WaitFor;
 | |
|   fReader.CompilerExecutable:=LazarusIDE.GetFPCompilerFilename;
 | |
|   fReader.UpdateTargetParam;
 | |
|   Start;
 | |
|   fStartedOnce:=true;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptThread.EndParsing;
 | |
| begin
 | |
|   if fStartedOnce then
 | |
|     WaitFor;
 | |
| end;
 | |
| 
 | |
| procedure TCompilerOptThread.Execute;
 | |
| var
 | |
|   StartTime: TDateTime;
 | |
| begin
 | |
|   StartTime := Now;
 | |
|   try
 | |
|     fReader.ReadAndParseOptions;
 | |
|   except
 | |
|     on E: Exception do
 | |
|       fReader.ErrorMsg := 'Error reading compiler: '+E.Message;
 | |
|   end;
 | |
|   fReadTime := Now-StartTime;
 | |
| end;
 | |
| 
 | |
| 
 | |
| end.
 | |
| 
 | 
