paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 15:18:09 +02:00
Code Issues Packages Projects Releases Wiki Activity
f771d54e4a
lazarus/ide/compiler.pp

1470 lines
46 KiB
ObjectPascal
Raw Blame History

{
/***************************************************************************
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, Contnrs, StrUtils,
{$IF FPC_FULLVERSION >= 30200}System.{$ENDIF}UITypes,
// LazUtils
FPCAdds, LazUTF8, LazFileUtils, LazUtilities, LazLoggerBase,
// Codetools
DefineTemplates, LinkScanner, CodeToolManager,
// BuildIntf
IDEExternToolIntf,
// IdeIntf
IDEMsgIntf, LazIDEIntf,
// IdeConfig
TransferMacros,
// IDE
IDECmdLine, LazarusIDEStrConsts, CompilerOptions, Project;
type
TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean) of object;
{ TCompiler }
TCompiler = class(TObject)
private
FOnCmdLineCreate : TOnCmdLineCreate;
procedure WriteError(const Msg: string);
public
constructor Create;
destructor Destroy; override;
function Compile(AProject: TProject;
const WorkingDir, CompilerFilename, CompilerParams: string;
BuildAll, SkipLinking, SkipAssembler, CurrentDirectoryIsTestDir: boolean;
const aCompileHint: string): TModalResult;
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;
function ParseOption(aDescr: string; aIndent: integer): Boolean; 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;
function ParseOption(aDescr: string; aIndent: integer): Boolean; 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: TStringListUTF8Fast;
// 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, SubTool: String;
CompilerKind: TPascalCompiler;
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
exit(mrAbort);
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<>FPCAdds.GetCompiledTargetOS then
Title+=Format(lisOS, [TargetOS]);
TargetCPU:=AProject.CompilerOptions.GetEffectiveTargetCPU;
if TargetCPU<>FPCAdds.GetCompiledTargetCPU then
Title+=Format(lisCPU, [TargetCPU]);
TargetFilename:=AProject.CompilerOptions.CreateTargetFilename;
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;
SubTool:=SubToolFPC;
CompilerKind:=CodeToolBoss.GetPascalCompilerForDirectory(WorkingDir);
if CompilerKind=pcPas2js then
SubTool:=SubToolPas2js;
FPCParser:=TFPCParser(Tool.AddParsers(SubTool));
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(Msg,' [TCompiler.WriteError]');
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;
function TCompilerOpt.ParseOption(aDescr: string; aIndent: integer): Boolean;
var
i: Integer;
begin
Result := True;
fIndentation := aIndent;
if aDescr[1] <> '-' then Exit(False); // Skip free text explanations.
// Separate the actual option and description from each other
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;
function TCompilerOptGroup.ParseOption(aDescr: string; aIndent: integer): Boolean;
var
i: Integer;
begin
Result := inherited ParseOption(aDescr, aIndent);
if not Result then Exit;
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 := TStringListUTF8Fast.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.GetCompilerFilename;
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.
Reference in New Issue View Git Blame Copy Permalink