paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 23:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: conditionals for package compilation

Browse Source 
git-svn-id: trunk@27400 -
This commit is contained in:
mattias 2010-09-17 21:56:55 +00:00
parent b99dd8a8ef
commit 28afd00d86
6 changed files with 130 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
components/codetools/codetoolscfgscript.pas
View File

@ -40,6 +40,8 @@ unit CodeToolsCfgScript;
{$mode objfpc}{$H+}
{$inline on}
{off $Define VerboseCTCfgScript}
interface
uses
@ -86,6 +88,7 @@ type
property Values[const Name: string]: string read GetValues write SetValues; default;
procedure Undefine(Name: PChar);
procedure Define(Name: PChar; const Value: string);
function IsDefined(Name: PChar): boolean;
property Tree: TAVLTree read FItems;
procedure WriteDebugReport(const Title: string; const Prefix: string = '');
end;
@ -511,9 +514,12 @@ begin
end;
l:=Src^.StrLen;
Dest^.StrLen:=l;
ReAllocMem(Dest^.StrStart,l);
if l>0 then
if l>0 then begin
ReAllocMem(Dest^.StrStart,l+1);
System.Move(Src^.StrStart^,Dest^.StrStart^,l);
Dest^.StrStart[l]:=#0;
end else
ReAllocMem(Dest^.StrStart,0);
end;
ctcsvNumber:
begin
@ -563,7 +569,7 @@ begin
begin
s:=IntToStr(V^.Number);
V^.StrLen:=length(s);
V^.StrStart:= GetMem(length(s)+1);
V^.StrStart:=GetMem(length(s)+1);
System.Move(s[1],V^.StrStart^,length(s)+1);
V^.ValueType:=ctcsvString;
end;
@ -880,9 +886,11 @@ begin
end;
l:=length(s);
V^.StrLen:=l;
ReAllocMem(V^.StrStart,l);
if l>0 then
System.Move(s[1],V^.StrStart^,l);
if l>0 then begin
ReAllocMem(V^.StrStart,l+1);
System.Move(s[1],V^.StrStart^,l+1); // +1 for the #0
end else
ReAllocMem(V^.StrStart,0);
end;
procedure SetCTCSVariableAsNumber(const V: PCTCfgScriptVariable; const i: int64
@ -1080,6 +1088,11 @@ begin
end;
end;
function TCTCfgScriptVariables.IsDefined(Name: PChar): boolean;
begin
Result:=GetVariable(Name)<>nil;
end;
procedure TCTCfgScriptVariables.WriteDebugReport(const Title: string;
const Prefix: string);
var
@ -1133,7 +1146,9 @@ var
Handled: Boolean;
StartTop: LongInt;
begin
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.ParseStatement Atom=',GetAtom]);
{$ENDIF}
StartTop:=FStack.Top;
case AtomStart^ of
#0: ;
@ -1231,7 +1246,9 @@ begin
ExprIsTrue:=CTCSVariableIsTrue(FStack.TopItemOperand);
FStack.Pop;
end;
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunIf expression=',ExprIsTrue]);
{$ENDIF}
// read then
if CompareIdentifiers(AtomStart,'then')<>0 then
@ -1282,11 +1299,15 @@ var
OperatorStart: PChar;
begin
VarStart:=AtomStart;
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunAssignment ',GetIdentifier(VarStart)]);
{$ENDIF}
StartTop:=FStack.TopTyp;
FStack.Push(ctcssAssignment,VarStart);
ReadRawNextPascalAtom(Src,AtomStart);
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunAssignment Operator=',GetAtom]);
{$ENDIF}
// read :=
if AtomStart^=#0 then begin
AddError('missing :=');
@ -1301,7 +1322,9 @@ begin
ReadRawNextPascalAtom(Src,AtomStart);
if RunExpression and (not Skip) then begin
Variable:=Variables.GetVariable(VarStart,true);
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunAssignment BEFORE ',GetIdentifier(VarStart),'=(Old=',dbgs(Variable),') ',GetAtom(OperatorStart),' ',dbgs(FStack.TopItemOperand)]);
{$ENDIF}
case OperatorStart^ of
':': // :=
SetCTCSVariableValue(FStack.TopItemOperand,Variable);
@ -1309,7 +1332,9 @@ begin
AddCTCSVariables(FStack.TopItemOperand,Variable);
end;
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunAssignment AFTER ',GetIdentifier(VarStart),' = ',dbgs(Variable)]);
{$ENDIF}
end;
// clean up stack
while FStack.TopTyp>StartTop do FStack.Pop;
@ -1383,7 +1408,9 @@ begin
while FStack.Top>StartTop do FStack.Pop;
// execute function
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunFunction FunctionName="',GetAtom(FunctionName),'" Parameter=',dbgs(PCTCfgScriptVariable(@Value))]);
{$ENDIF}
case UpChars[FunctionName^] of
'I':
if CompareIdentifiers(FunctionName,'int64')=0 then
@ -1396,7 +1423,9 @@ begin
end;
// put result on stack as operand
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunFunction FunctionName="',GetAtom(FunctionName),'" Result=',dbgs(PCTCfgScriptVariable(@Value))]);
{$ENDIF}
FStack.Push(ctcssOperand,FunctionName);
SetCTCSVariableValue(@Value,FStack.TopItemOperand);
@ -1415,9 +1444,10 @@ var
if Count=0 then exit;
OldLen:=Operand^.StrLen;
NewLen:=OldLen+Count;
ReAllocMem(Operand^.StrStart,NewLen);
ReAllocMem(Operand^.StrStart,NewLen+1);
System.Move(p^,Operand^.StrStart[OldLen],Count);
Operand^.StrLen:=NewLen;
Operand^.StrStart[NewLen]:=#0;
end;
var
@ -1603,7 +1633,9 @@ begin
StartTop:=FStack.Top;
FStack.Push(ctcssExpression,ExprStart);
while true do begin
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunExpression Atom=',GetAtom]);
{$ENDIF}
case AtomStart^ of
#0:
break;
@ -1623,9 +1655,7 @@ begin
end else if (FStack.TopTyp=ctcssOperand)
and (FStack.Top>0) and (FStack.Items[FStack.Top-1].Typ=ctcssRoundBracketOpen)
then begin
WriteDebugReportStack('AAA1');
FStack.Delete(FStack.Top-1);
WriteDebugReportStack('AAA2');
end else
break;
end;
@ -1659,7 +1689,9 @@ begin
begin
// a keyword or an identifier
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunExpression StackTop=',dbgs(FStack.TopTyp),' Atom=',GetAtom]);
{$ENDIF}
// execute
Handled:=false;
case UpChars[AtomStart^] of
@ -1746,7 +1778,9 @@ begin
end;
if (not Handled) then begin
if not OperandAllowed then break;
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunExpression ',GetAtom(AtomStart),' ',IsFunction(AtomStart)]);
{$ENDIF}
if IsFunction(AtomStart) then begin
// a function
if not RunFunction then begin
@ -1808,7 +1842,9 @@ begin
FStack.Delete(FStack.Top-1);
Item:=FStack.TopItem;
inc(StartTop);
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.RunExpression Result="',dbgs(PCTCfgScriptVariable(@Item^.Operand)),'" ']);
{$ENDIF}
end;
end;
@ -1912,7 +1948,9 @@ var
begin
Result:=true;
repeat
{$IFDEF VerboseCTCfgScript}
WriteDebugReportStack('ExecuteStack MaxLevel='+dbgs(MaxLevel));
{$ENDIF}
if (FStack.TopTyp<>ctcssOperand) or (FStack.Top<=0) then
exit;
OperatorItem:=@FStack.Items[FStack.Top-1];
@ -1923,7 +1961,9 @@ begin
// execute operator
Typ:=AtomToCTCfgOperator(OperatorItem^.StartPos);
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.ExecuteStack execute operator "',GetAtom(OperatorItem^.StartPos),'" Typ=',dbgs(Typ)]);
{$ENDIF}
case Typ of
ctcsoNot:
@ -1958,7 +1998,7 @@ begin
if not CompareCTCSVariables(@LeftOperandItem^.Operand,@OperandItem^.Operand,
OperandsEqual,LeftIsLowerThanRight)
then begin
b:=false;
b:=false;
end else begin
case Typ of
ctcsoEqual:
@ -1975,6 +2015,9 @@ begin
b:=OperandsEqual or not LeftIsLowerThanRight;
end;
end;
{$IFDEF VerboseCTCfgScript}
debugln(['TCTConfigScriptEngine.ExecuteStack ',GetCTCSVariableAsString(@LeftOperandItem^.Operand),' ',GetCTCSVariableAsString(@OperandItem^.Operand),' Equal=',OperandsEqual,' LT=',LeftIsLowerThanRight,' Result=',Result]);
{$ENDIF}
FStack.Pop(3);
end else begin
FStack.Pop(2);

2
ide/basebuildmanager.pas
View File

@ -45,6 +45,8 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetBuildMacroOverride(const MacroName: string): string; virtual; abstract;
function GetBuildMacroOverrides: TStrings; virtual; abstract;
function GetTargetOS(UseCache: boolean): string; virtual; abstract;
function GetTargetCPU(UseCache: boolean): string; virtual; abstract;
function GetLCLWidgetType(UseCache: boolean): string; virtual; abstract;

24
ide/buildmanager.pas
View File

@ -123,6 +123,8 @@ type
procedure SetupCompilerInterface;
procedure SetupInputHistories;
function GetBuildMacroOverride(const MacroName: string): string; override;
function GetBuildMacroOverrides: TStrings; override;
function GetTargetOS(UseCache: boolean): string; override;
function GetTargetCPU(UseCache: boolean): string; override;
function GetLCLWidgetType(UseCache: boolean): string; override;
@ -314,6 +316,28 @@ begin
end;
end;
function TBuildManager.GetBuildMacroOverride(const MacroName: string): string;
begin
Result:='';
if SysUtils.CompareText(MacroName,'TargetOS')=0 then
Result:=OverrideTargetOS
else if SysUtils.CompareText(MacroName,'TargetCPU')=0 then
Result:=OverrideTargetCPU
else if SysUtils.CompareText(MacroName,'LCLWidgetType')=0 then
Result:=OverrideLCLWidgetType;
end;
function TBuildManager.GetBuildMacroOverrides: TStrings;
begin
Result:=TStringList.Create;
if OverrideTargetOS<>'' then
Result.Values['TargetOS']:=OverrideTargetOS;
if OverrideTargetCPU<>'' then
Result.Values['TargetCPU']:=OverrideTargetCPU;
if OverrideLCLWidgetType<>'' then
Result.Values['LCLWidgetType']:=OverrideLCLWidgetType;
end;
function TBuildManager.GetTargetOS(UseCache: boolean): string;
begin
if UseCache then ;

22
ide/compileroptions.pp
View File

@ -705,7 +705,7 @@ type
TGetBuildMacroValues = function(Options: TBaseCompilerOptions;
IncludeSelf: boolean): TCTCfgScriptVariables of object;
var
GetBuildMacroValues: TGetBuildMacroValues = nil; // set by TPkgManager
GetBuildMacroValues: TGetBuildMacroValues = nil; // set by TPkgManager, do not change or free the variables
function LoadXMLCompileReasons(const AConfig: TXMLConfig;
const APath: String; const DefaultReasons: TCompileReasons): TCompileReasons;
@ -3408,16 +3408,16 @@ begin
Vars:=GetBuildMacroValues(TBaseCompilerOptions(Owner),true);
if Vars<>nil then begin
case Option of
pcosUnitPath: ;
pcosIncludePath: ;
pcosObjectPath: ;
pcosLibraryPath: ;
pcosSrcPath: ;
pcosLinkerOptions: ;
pcosCustomOptions: ;
pcosOutputDir: ;
pcosCompilerPath: ;
pcosDebugPath: ;
pcosUnitPath: s:=MergeSearchPaths(s,Vars['UnitPath']);
pcosIncludePath: s:=MergeSearchPaths(s,Vars['IncPath']);
pcosObjectPath: s:=MergeSearchPaths(s,Vars['ObjectPath']);
pcosLibraryPath: s:=MergeSearchPaths(s,Vars['LibraryPath']);
pcosSrcPath: s:=MergeSearchPaths(s,Vars['SrcPath']);
pcosLinkerOptions: s:=MergeLinkerOptions(s,Vars['LinkerOptions']);
pcosCustomOptions: s:=MergeCustomOptions(s,Vars['CustomOptions']);
pcosOutputDir: if Vars.IsDefined('OutputDirectory') then s:=Vars.Values['OutputDirectory'];
pcosCompilerPath: if Vars.IsDefined('CompilerPath') then s:=Vars.Values['CompilerPath'];
pcosDebugPath: s:=MergeSearchPaths(s,Vars['DebugPath']);
end;
end;
end;

2
packager/packagedefs.pas
View File

@ -2045,7 +2045,7 @@ begin
if Macro<>nil then
begin
s:=GetCTCSVariableAsString(Macro);
debugln(['TLazPackage.OnMacroListSubstitution Pkg=',Name,' Macro=',MacroName,' Value="',s,'"']);
//debugln(['TLazPackage.OnMacroListSubstitution Pkg=',Name,' Macro=',MacroName,' Value="',s,'"']);
Handled:=true;
exit;
end;

42
packager/pkgmanager.pas
View File

@ -45,7 +45,7 @@ uses
{$ENDIF}
// FCL, LCL
TypInfo, Classes, SysUtils, LCLProc, Forms, Controls, Dialogs, Menus,
StringHashList, Translations, LResources,
InterfaceBase, StringHashList, Translations, LResources,
// codetools
CodeToolsCfgScript, CodeToolsConfig, CodeToolManager, CodeCache,
BasicCodeTools, FileProcs, Laz_XMLCfg,
@ -783,10 +783,10 @@ function TPkgManager.OnGetBuildMacroValues(Options: TBaseCompilerOptions;
if Macro.Identifier='' then continue;
Value:=Values.GetVariable(PChar(Macro.Identifier));
if Value=nil then begin
debugln(['AddAllInherited InhPkg=',APackage.Name,' Macro="',Macro.Identifier,'" no value']);
//debugln(['AddAllInherited InhPkg=',APackage.Name,' Macro="',Macro.Identifier,'" no value']);
continue;
end else begin
debugln(['AddAllInherited InhPkg=',APackage.Name,' Macro="',Macro.Identifier,'" Value="',dbgs(Value),'"']);
//debugln(['AddAllInherited InhPkg=',APackage.Name,' Macro="',Macro.Identifier,'" Value="',dbgs(Value),'"']);
AddTo.AddOverride(Value);
end;
end;
@ -808,12 +808,45 @@ function TPkgManager.OnGetBuildMacroValues(Options: TBaseCompilerOptions;
var
ParseOpts: TParsedCompilerOptions;
Values: TCTCfgScriptVariables;
Overrides: TStrings;
i: Integer;
s: String;
begin
Result:=nil;
if Options=nil then begin
// return the values of the active project
if (Project1=nil) or (Project1.MacroValues=nil) then exit;
Result:=Project1.MacroValues.CfgVars;
// set overrides
Overrides:=BuildBoss.GetBuildMacroOverrides;
try
for i:=0 to Overrides.Count-1 do
Result.Values[Overrides.Names[i]]:=Overrides.ValueFromIndex[i];
finally
Overrides.Free;
end;
// add the defaults
if not Result.IsDefined('TargetOS') then begin
s:=Project1.CompilerOptions.TargetOS;
if s='' then
s:=GetDefaultTargetOS;
Result.Values['TargetOS']:=s;
end;
if not Result.IsDefined('TargetCPU') then begin
s:=Project1.CompilerOptions.TargetCPU;
if s='' then
s:=GetDefaultTargetCPU;
Result.Values['TargetCPU']:=s;
end;
if not Result.IsDefined('LCLWidgetType') then begin
s:=Project1.CompilerOptions.LCLWidgetType;
if s='' then
s:=LCLPlatformDirNames[GetDefaultLCLWidgetType];
Result.Values['LCLWidgetType']:=s;
end;
//Result.WriteDebugReport('OnGetBuildMacroValues project values');
exit;
end;
@ -842,11 +875,14 @@ begin
// add macro values of self
if Values<>nil then
Result.Assign(Values);
//Result.WriteDebugReport('TPkgManager.OnGetBuildMacroValues before execute: '+dbgstr(Options.Conditionals),' ');
if not ParseOpts.MacroValues.Execute(Options.Conditionals) then begin
debugln(['TPkgManager.OnGetBuildMacroValues Error: ',ParseOpts.MacroValues.GetErrorStr(0)]);
debugln(Options.Conditionals);
end;
//Result.WriteDebugReport('TPkgManager.OnGetBuildMacroValues executed: '+dbgstr(Options.Conditionals),' ');
// the macro values of the active project take precedence
SetProjectMacroValues;