mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-01 12:04:59 +02:00
456 lines
13 KiB
ObjectPascal
456 lines
13 KiB
ObjectPascal
{ /***************************************************************************
|
|
compoptsmodes.pas - Lazarus IDE unit
|
|
---------------------------------------
|
|
Conditional compiler options and build modes.
|
|
|
|
***************************************************************************/
|
|
|
|
***************************************************************************
|
|
* *
|
|
* 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
|
* *
|
|
***************************************************************************
|
|
|
|
Author: Mattias Gaertner
|
|
|
|
Abstract:
|
|
- compiler options depending on build modes and environment
|
|
}
|
|
unit CompOptsModes;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
{$i ide.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLProc, Laz_XMLCfg, ExprEval,
|
|
IDEProcs, ProjectIntf;
|
|
|
|
type
|
|
|
|
{ TCompilerDiffTool
|
|
A tool to create the difference between two option sets }
|
|
|
|
TCompilerDiffTool = class
|
|
private
|
|
FDiff: TStrings;
|
|
FDiffer: boolean;
|
|
FPath: string;
|
|
procedure SetDiff(const AValue: TStrings);
|
|
procedure SetDiffer(const AValue: boolean);
|
|
procedure SetPath(const AValue: string);
|
|
public
|
|
constructor Create(DiffList: TStrings);
|
|
procedure AddDiffItem(const PropertyName, Value: string);
|
|
procedure AddDiff(const PropertyName: string; const Old, New: string);
|
|
procedure AddDiff(const PropertyName: string; const Old, New: integer);
|
|
procedure AddDiff(const PropertyName: string; const Old, New: boolean);
|
|
procedure AddPathsDiff(const PropertyName: string; const Old, New: string);
|
|
procedure AddSetDiff(const PropertyName: string; const Old, New: integer;
|
|
const EnumNames: PString);
|
|
property Diff: TStrings read FDiff write SetDiff;
|
|
property Path: string read FPath write SetPath;
|
|
property Differ: boolean read FDiffer write SetDiffer;
|
|
end;
|
|
|
|
{ TCompOptConditionals }
|
|
|
|
TCompOptConditionals = class(TLazCompOptConditionals)
|
|
private
|
|
FChangeStamp: integer;
|
|
FErrorMsg: string;
|
|
FErrorNode: TCompOptCondNode;
|
|
FEvaluator: TExpressionEvaluator;
|
|
FEvaluatorStamp: integer;
|
|
FValuesValid: boolean;
|
|
FValues: array[TCOCValueType] of string;
|
|
function GetValues(const ValueType: TCOCValueType): string;
|
|
procedure SetEvaluator(const AValue: TExpressionEvaluator);
|
|
procedure AddValue(const ValueType: TCOCValueType; Value: string);
|
|
public
|
|
constructor Create(TheEvaluator: TExpressionEvaluator);
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure ClearNodes;
|
|
procedure InvalidateValues; override;
|
|
procedure Assign(Source: TLazCompOptConditionals); override;
|
|
procedure CreateDiff(CompOpts: TLazCompOptConditionals;
|
|
Tool: TCompilerDiffTool); virtual;
|
|
procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
|
DoSwitchPathDelims: boolean); virtual;
|
|
procedure SaveToXMLConfig(XMLConfig: TXMLConfig; const Path: string); virtual;
|
|
property Values[ValueType: TCOCValueType]: string read GetValues;
|
|
property Evaluator: TExpressionEvaluator read FEvaluator write SetEvaluator;
|
|
property ChangeStamp: integer read FChangeStamp;
|
|
procedure IncreaseChangeStamp; inline;
|
|
property ErrorNode: TCompOptCondNode read FErrorNode write FErrorNode;
|
|
property ErrorMsg: string read FErrorMsg write FErrorMsg;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TCompOptConditionals }
|
|
|
|
function TCompOptConditionals.GetValues(const ValueType: TCOCValueType): string;
|
|
|
|
function ComputeIfNode(Node: TCompOptCondNode;
|
|
out ExprResult: boolean): boolean;
|
|
var
|
|
ResultStr: String;
|
|
begin
|
|
case Node.NodeType of
|
|
cocntIf,cocntElseIf:
|
|
begin
|
|
ResultStr:=FEvaluator.Eval(Node.Value);
|
|
if FEvaluator.ErrorPosition>=0 then begin
|
|
FErrorNode:=Node;
|
|
FErrorMsg:='error in expression at column '+IntToStr(FEvaluator.ErrorPosition);
|
|
exit(false);
|
|
end;
|
|
ExprResult:=ResultStr<>'0';
|
|
end;
|
|
cocntIfdef:
|
|
ExprResult:=FEvaluator.IsDefined(Node.Value);
|
|
cocntIfNdef:
|
|
ExprResult:=not FEvaluator.IsDefined(Node.Value);
|
|
else
|
|
FErrorNode:=Node;
|
|
FErrorMsg:='unexpected node of type '+COCNodeTypeNames[Node.NodeType];
|
|
exit(false);
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
function ComputeNode(ParentNode: TCompOptCondNode; Index: integer): boolean;
|
|
var
|
|
ExprResult: boolean;
|
|
Node: TCompOptCondNode;
|
|
begin
|
|
Result:=false;
|
|
while Index<ParentNode.Count do begin
|
|
Node:=ParentNode.Childs[Index];
|
|
case Node.NodeType of
|
|
|
|
cocntIf,cocntIfdef,cocntIfNdef:
|
|
while true do begin
|
|
if (Node.NodeType=cocntElse) then
|
|
ExprResult:=true
|
|
else if (not ComputeIfNode(Node,ExprResult)) then
|
|
exit;
|
|
if ExprResult then begin
|
|
// execute childs
|
|
if Node.Count>0 then
|
|
if not ComputeNode(Node,0) then exit;
|
|
// skip all else
|
|
inc(Index);
|
|
while (Index<ParentNode.Count) do begin
|
|
Node:=ParentNode.Childs[Index];
|
|
if not (Node.NodeType in [cocntElseIf,cocntElse]) then break;
|
|
if ParentNode.Childs[Index-1].NodeType=cocntElse then begin
|
|
FErrorNode:=Node;
|
|
FErrorMsg:='ElseIf not allowed after Else';
|
|
exit(false);
|
|
end;
|
|
inc(Index);
|
|
end;
|
|
break;
|
|
end else begin
|
|
// skip childs
|
|
inc(Index);
|
|
end;
|
|
if Index>=ParentNode.Count then break;
|
|
Node:=ParentNode.Childs[Index];
|
|
end;
|
|
|
|
cocntAddValue:
|
|
begin
|
|
AddValue(Node.ValueType,Node.Value);
|
|
inc(Index);
|
|
end;
|
|
|
|
else
|
|
fErrorNode:=Node;
|
|
FErrorMsg:='unexpected node of type '+COCNodeTypeNames[Node.NodeType];
|
|
exit(false);
|
|
end;
|
|
end;
|
|
Result:=true;
|
|
end;
|
|
|
|
var
|
|
v: TCOCValueType;
|
|
begin
|
|
if FEvaluator=nil then begin
|
|
Result:='';
|
|
exit;
|
|
end;
|
|
if (not FValuesValid)
|
|
or (FEvaluator.ChangeStamp<>FEvaluatorStamp) then begin
|
|
for v:=Low(FValues) to High(FValues) do
|
|
FValues[v]:='';
|
|
ComputeNode(Root,0);
|
|
FValuesValid:=true;
|
|
FEvaluatorStamp:=FEvaluator.ChangeStamp;
|
|
end;
|
|
Result:=FValues[ValueType];
|
|
end;
|
|
|
|
procedure TCompOptConditionals.SetEvaluator(const AValue: TExpressionEvaluator
|
|
);
|
|
begin
|
|
if FEvaluator=AValue then exit;
|
|
FEvaluator:=AValue;
|
|
InvalidateValues;
|
|
end;
|
|
|
|
procedure TCompOptConditionals.AddValue(const ValueType: TCOCValueType;
|
|
Value: string);
|
|
begin
|
|
Value:=Trim(Value);
|
|
if Value='' then exit;
|
|
case ValueType of
|
|
cocvtNone: ; // ignore
|
|
cocvtUnitPath,cocvtSrcPath,cocvtIncludePath,cocvtObjectPath,cocvtLibraryPath,
|
|
cocvtDebugPath:
|
|
begin
|
|
FValues[ValueType]:=MergeSearchPaths(FValues[ValueType],Value);
|
|
end;
|
|
cocvtLinkerOptions,cocvtCustomOptions:
|
|
begin
|
|
if FValues[ValueType]<>'' then
|
|
FValues[ValueType]:=FValues[ValueType]+' ';
|
|
FValues[ValueType]:=FValues[ValueType]+Value;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
constructor TCompOptConditionals.Create(TheEvaluator: TExpressionEvaluator);
|
|
begin
|
|
FEvaluator:=TheEvaluator;
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TCompOptConditionals.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TCompOptConditionals.Clear;
|
|
begin
|
|
ClearNodes;
|
|
end;
|
|
|
|
procedure TCompOptConditionals.ClearNodes;
|
|
begin
|
|
FValuesValid:=false;
|
|
FErrorNode:=nil;
|
|
FErrorMsg:='';
|
|
Root.ClearNodes;
|
|
end;
|
|
|
|
procedure TCompOptConditionals.InvalidateValues;
|
|
begin
|
|
FValuesValid:=false;
|
|
FErrorNode:=nil;
|
|
FErrorMsg:='';
|
|
end;
|
|
|
|
procedure TCompOptConditionals.Assign(Source: TLazCompOptConditionals);
|
|
begin
|
|
ClearNodes;
|
|
Root.Assign(Source.Root);
|
|
end;
|
|
|
|
procedure TCompOptConditionals.CreateDiff(CompOpts: TLazCompOptConditionals;
|
|
Tool: TCompilerDiffTool);
|
|
|
|
procedure Diff(CurNode, OtherNode: TCompOptCondNode);
|
|
var
|
|
i: Integer;
|
|
OldPath: String;
|
|
begin
|
|
Tool.AddDiff('NodeType',COCNodeTypeNames[CurNode.NodeType],COCNodeTypeNames[OtherNode.NodeType]);
|
|
Tool.AddDiff('ValueType',COCValueTypeNames[CurNode.ValueType],COCValueTypeNames[OtherNode.ValueType]);
|
|
Tool.AddDiff('Value',CurNode.Value,OtherNode.Value);
|
|
if CurNode.Count<>OtherNode.Count then begin
|
|
Tool.AddDiff('Count',IntToStr(CurNode.Count),IntToStr(OtherNode.Count));
|
|
exit;
|
|
end;
|
|
for i:=0 to CurNode.Count-1 do begin
|
|
OldPath:=Tool.Path;
|
|
Tool.Path:=Tool.Path+'Item'+IntToStr(i)+'/';
|
|
Diff(CurNode.Childs[i],OtherNode.Childs[i]);
|
|
Tool.Path:=OldPath;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Diff(Root,CompOpts.Root);
|
|
end;
|
|
|
|
procedure TCompOptConditionals.LoadFromXMLConfig(XMLConfig: TXMLConfig;
|
|
const Path: string; DoSwitchPathDelims: boolean);
|
|
|
|
procedure LoadNode(Node: TCompOptCondNode; const SubPath: string);
|
|
var
|
|
NewCount: LongInt;
|
|
i: Integer;
|
|
NewChild: TCompOptCondNode;
|
|
begin
|
|
Node.ClearNodes;
|
|
Node.NodeType:=COCNodeTypeNameToType(XMLConfig.GetValue(SubPath+'NodeType',''));
|
|
Node.ValueType:=COCValueTypeNameToType(XMLConfig.GetValue(SubPath+'ValueType',''));
|
|
Node.Value:=XMLConfig.GetValue(SubPath+'Value','');
|
|
// load childs
|
|
NewCount:=XMLConfig.GetValue(SubPath+'ChildCount',0);
|
|
for i:=1 to NewCount do begin
|
|
NewChild:=TCompOptCondNode.Create(Node.Owner);
|
|
Node.AddLast(NewChild);
|
|
LoadNode(NewChild,SubPath+'Item'+IntToStr(i)+'/');
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
LoadNode(Root,Path);
|
|
Root.NodeType:=cocntNone;
|
|
Root.ValueType:=cocvtNone;
|
|
Root.Value:='';
|
|
end;
|
|
|
|
procedure TCompOptConditionals.SaveToXMLConfig(XMLConfig: TXMLConfig;
|
|
const Path: string);
|
|
|
|
procedure SaveNode(Node: TCompOptCondNode; const SubPath: string);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
XMLConfig.SetDeleteValue(SubPath+'NodeType',COCNodeTypeNames[Node.NodeType],
|
|
COCNodeTypeNames[cocntNone]);
|
|
XMLConfig.SetDeleteValue(SubPath+'ValueType',COCValueTypeNames[Node.ValueType],
|
|
COCValueTypeNames[cocvtNone]);
|
|
XMLConfig.SetDeleteValue(SubPath+'Value',Node.Value,'');
|
|
// save childs
|
|
XMLConfig.SetDeleteValue(SubPath+'ChildCount',Node.Count,0);
|
|
for i:=0 to Node.Count-1 do
|
|
SaveNode(Node.Childs[i],SubPath+'Item'+IntToStr(i+1)+'/');
|
|
end;
|
|
|
|
begin
|
|
SaveNode(Root,Path);
|
|
end;
|
|
|
|
procedure TCompOptConditionals.IncreaseChangeStamp; inline;
|
|
begin
|
|
if FChangeStamp<High(Integer) then
|
|
inc(FChangeStamp)
|
|
else
|
|
FChangeStamp:=Low(Integer);
|
|
end;
|
|
|
|
{ TCompilerDiffTool }
|
|
|
|
procedure TCompilerDiffTool.SetDiff(const AValue: TStrings);
|
|
begin
|
|
if FDiff=AValue then exit;
|
|
FDiff:=AValue;
|
|
end;
|
|
|
|
procedure TCompilerDiffTool.SetDiffer(const AValue: boolean);
|
|
begin
|
|
if FDiffer=AValue then exit;
|
|
FDiffer:=AValue;
|
|
end;
|
|
|
|
procedure TCompilerDiffTool.SetPath(const AValue: string);
|
|
begin
|
|
if FPath=AValue then exit;
|
|
FPath:=AValue;
|
|
// ! config path, not file path. Always /, not PathDelim
|
|
if (FPath<>'') and (Path[length(Path)]<>'/') then FPath:=FPath+'/';
|
|
end;
|
|
|
|
constructor TCompilerDiffTool.Create(DiffList: TStrings);
|
|
begin
|
|
FDiff:=DiffList;
|
|
if Diff<>nil then
|
|
Diff.Clear;
|
|
end;
|
|
|
|
procedure TCompilerDiffTool.AddDiffItem(const PropertyName, Value: string);
|
|
begin
|
|
Differ:=true;
|
|
if Diff<>nil then
|
|
Diff.Add(Path+PropertyName+'='+Value);
|
|
end;
|
|
|
|
procedure TCompilerDiffTool.AddDiff(const PropertyName: string; const Old,
|
|
New: string);
|
|
begin
|
|
if Old=New then exit;
|
|
AddDiffItem(PropertyName,New);
|
|
end;
|
|
|
|
procedure TCompilerDiffTool.AddDiff(const PropertyName: string; const Old,
|
|
New: integer);
|
|
begin
|
|
if Old=New then exit;
|
|
AddDiffItem(PropertyName,IntToStr(New));
|
|
end;
|
|
|
|
procedure TCompilerDiffTool.AddDiff(const PropertyName: string; const Old,
|
|
New: boolean);
|
|
begin
|
|
if Old=New then exit;
|
|
AddDiffItem(PropertyName,dbgs(New));
|
|
end;
|
|
|
|
procedure TCompilerDiffTool.AddPathsDiff(const PropertyName: string; const Old,
|
|
New: string);
|
|
begin
|
|
if Old=New then exit;
|
|
AddDiff(PropertyName,Old,New);
|
|
end;
|
|
|
|
procedure TCompilerDiffTool.AddSetDiff(const PropertyName: string; const Old,
|
|
New: integer; const EnumNames: PString);
|
|
var
|
|
i: Integer;
|
|
Mask: LongInt;
|
|
s: String;
|
|
begin
|
|
if Old=New then exit;
|
|
Mask := 1;
|
|
s:='';
|
|
for i := 0 to 31 do begin
|
|
if (New and Mask) <> (Old and Mask) then begin
|
|
if s<>'' then s:=s+',';
|
|
if (New and Mask) <> 0 then
|
|
s:=s+'+'
|
|
else
|
|
s:=s+'-';
|
|
s:=s+EnumNames[i];
|
|
end;
|
|
Mask := Mask shl 1;
|
|
end;
|
|
AddDiffItem(PropertyName,s);
|
|
end;
|
|
|
|
end.
|
|
|