mirror of https://gitlab.com/basile.b/dexed.git
native project + dmd wrapper modified to support #37
- partially implemented processing of overriden config - remaining `getOpt()`functs to adapt are listed in Laz TODO list
This commit is contained in:
Basile Burg
parent
6f5a8e42cb
commit
d2578128bd
|
|
@ -31,7 +31,7 @@ type
|
|||
protected
|
||||
property onChange: TNotifyEvent read fOnChange write fOnChange;
|
||||
public
|
||||
procedure getOpts(const aList: TStrings); virtual; abstract;
|
||||
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); virtual; abstract;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
|
|
@ -54,7 +54,7 @@ type
|
|||
property JSONFilename: TCEFilename read fJsonFname write setJSONFile;
|
||||
public
|
||||
procedure assign(aValue: TPersistent); override;
|
||||
procedure getOpts(const aList: TStrings); override;
|
||||
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
||||
end;
|
||||
|
||||
|
||||
|
|
@ -96,7 +96,7 @@ type
|
|||
public
|
||||
constructor create;
|
||||
procedure assign(aValue: TPersistent); override;
|
||||
procedure getOpts(const aList: TStrings); override;
|
||||
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
||||
end;
|
||||
|
||||
(**
|
||||
|
|
@ -158,7 +158,7 @@ type
|
|||
constructor create;
|
||||
destructor destroy; override;
|
||||
procedure assign(aValue: TPersistent); override;
|
||||
procedure getOpts(const aList: TStrings); override;
|
||||
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
|
|
@ -179,7 +179,7 @@ type
|
|||
procedure setDbgC(const aValue: boolean);
|
||||
procedure setGenMap(const aValue: boolean);
|
||||
procedure setDbgLevel(const aValue: Integer);
|
||||
procedure setDbgIdents(const aValue: TStringList);
|
||||
procedure setDbgIdents(aValue: TStringList);
|
||||
published
|
||||
property debug: boolean read fDebug write setDebug default false;
|
||||
property debugIdentifiers: TStringList read fDbgIdents write setDbgIdents;
|
||||
|
|
@ -191,7 +191,7 @@ type
|
|||
constructor create;
|
||||
destructor destroy; override;
|
||||
procedure assign(aValue: TPersistent); override;
|
||||
procedure getOpts(const aList: TStrings); override;
|
||||
procedure getOpts(aList: TStrings;base: TOptsGroup = nil); override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
|
|
@ -223,7 +223,7 @@ type
|
|||
constructor create;
|
||||
destructor destroy; override;
|
||||
procedure assign(aValue: TPersistent); override;
|
||||
procedure getOpts(const aList: TStrings); override;
|
||||
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
|
|
@ -232,14 +232,14 @@ type
|
|||
TOtherOpts = class(TOptsGroup)
|
||||
private
|
||||
fCustom: TStringList;
|
||||
procedure setCustom(const aValue: TStringList);
|
||||
procedure setCustom(aValue: TStringList);
|
||||
published
|
||||
property customOptions: TStringList read fCustom write setCustom;
|
||||
public
|
||||
constructor create;
|
||||
destructor destroy; override;
|
||||
procedure assign(aValue: TPersistent); override;
|
||||
procedure getOpts(const aList: TStrings); override;
|
||||
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
||||
end;
|
||||
|
||||
(*****************************************************************************
|
||||
|
|
@ -261,14 +261,14 @@ type
|
|||
protected
|
||||
property executable: TCEFilename read fExecutable write setExecutable;
|
||||
property workingDirectory: TCEPathname read fWorkDir write setWorkDir;
|
||||
property options: TProcessOptions read fOptions write setOptions;
|
||||
property options: TProcessOptions read fOptions write setOptions default [];
|
||||
property parameters: TStringList read fParameters write setParameters;
|
||||
property showWindow: TShowWindowOptions read fShowWin write setShowWin;
|
||||
property showWindow: TShowWindowOptions read fShowWin write setShowWin default swoNone;
|
||||
public
|
||||
constructor create;
|
||||
destructor destroy; override;
|
||||
procedure assign(source: TPersistent); override;
|
||||
procedure getOpts(const aList: TStrings); override;
|
||||
procedure getOpts(aList: TStrings; base: TOptsGroup = nil); override;
|
||||
{ TAsyncProcess "Parameters" inherits from UTF8 process,
|
||||
and the property reader is not anymore "fParameters" but "fUTF8Parameters"
|
||||
without the overload aProcess does not get the Parameters if aProcess is TAsynProcess...}
|
||||
|
|
@ -318,6 +318,8 @@ type
|
|||
fPreProcOpt: TCompileProcOptions;
|
||||
fPostProcOpt: TCompileProcOptions;
|
||||
fRunProjOpt: TProjectRunOptions;
|
||||
fIsBaseConfiguration: boolean;
|
||||
fIsOverriddenConfiguration: boolean;
|
||||
procedure doChanged;
|
||||
procedure subOptsChanged(sender: TObject);
|
||||
procedure setName(const aValue: string);
|
||||
|
|
@ -330,6 +332,8 @@ type
|
|||
procedure setPreProcOpt(const aValue: TCompileProcOptions);
|
||||
procedure setPostProcOpt(const aValue: TCompileProcOptions);
|
||||
procedure setRunProjOpt(const aValue: TProjectRunOptions);
|
||||
procedure setisBaseConfiguration(const aValue: boolean);
|
||||
procedure setisOverriddenConfiguration(const aValue: boolean);
|
||||
protected
|
||||
function nameFromID: string;
|
||||
published
|
||||
|
|
@ -343,11 +347,13 @@ type
|
|||
property preBuildProcess: TCompileProcOptions read fPreProcOpt write setPreProcOpt;
|
||||
property postBuildProcess: TCompileProcOptions read fPostProcOpt write setPostProcOpt;
|
||||
property runOptions: TProjectRunOptions read fRunProjOpt write setRunProjOpt;
|
||||
property isBaseConfiguration: boolean read fIsBaseConfiguration write setisBaseConfiguration default false;
|
||||
property isOverriddenConfiguration: boolean read fIsOverriddenConfiguration write setisOverriddenConfiguration default false;
|
||||
public
|
||||
constructor create(aCollection: TCollection); override;
|
||||
destructor destroy; override;
|
||||
procedure assign(aValue: TPersistent); override;
|
||||
procedure getOpts(const aList: TStrings);
|
||||
procedure getOpts(aList: TStrings; base: TCompilerConfiguration = nil);
|
||||
property onChanged: TNotifyEvent read fOnChanged write fOnChanged;
|
||||
end;
|
||||
|
||||
|
|
@ -362,7 +368,11 @@ begin
|
|||
end;
|
||||
|
||||
{$REGION TDocOpts --------------------------------------------------------------}
|
||||
procedure TDocOpts.getOpts(const aList: TStrings);
|
||||
procedure TDocOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
||||
var
|
||||
baseopt: TDocOpts;
|
||||
begin
|
||||
if base = nil then
|
||||
begin
|
||||
if fGenDoc then
|
||||
aList.Add('-D');
|
||||
|
|
@ -372,6 +382,26 @@ begin
|
|||
aList.Add('-Dd' + symbolExpander.get(fDocDir));
|
||||
if fJsonFname <> '' then
|
||||
aList.Add('-Xf' + symbolExpander.get(fJsonFname));
|
||||
end else
|
||||
begin
|
||||
baseopt := TDocOpts(base);
|
||||
if baseopt.fGenDoc or fGenDoc then
|
||||
aList.Add('-D');
|
||||
if baseopt.fGenJson or fGenJson then
|
||||
aList.Add('-X');
|
||||
if (baseopt.fDocDir <> '') and (fDocDir <> '') then
|
||||
aList.Add('-Dd' + symbolExpander.get(fDocDir))
|
||||
else if (fDocDir <> '') then
|
||||
aList.Add('-Dd' + symbolExpander.get(fDocDir))
|
||||
else if (baseopt.fDocDir <> '') then
|
||||
aList.Add('-Dd' + symbolExpander.get(baseopt.fDocDir));
|
||||
if (baseopt.fJsonFname <> '') and (fJsonFname <> '') then
|
||||
aList.Add('-Xf' + symbolExpander.get(fJsonFname))
|
||||
else if fJsonFname <> '' then
|
||||
aList.Add('-Xf' + symbolExpander.get(fJsonFname))
|
||||
else if (baseopt.fJsonFname <> '') then
|
||||
aList.Add('-Dd' + symbolExpander.get(baseopt.fJsonFname));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDocOpts.assign(aValue: TPersistent);
|
||||
|
|
@ -446,14 +476,17 @@ begin
|
|||
fWarnings := true;
|
||||
end;
|
||||
|
||||
procedure TMsgOpts.getOpts(const aList: TStrings);
|
||||
procedure TMsgOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
||||
var
|
||||
opt : string;
|
||||
dep, depbase: string;
|
||||
baseopt: TMsgOpts;
|
||||
const
|
||||
DepStr : array[TDepHandling] of string = ('-d', '', '-de');
|
||||
begin
|
||||
opt := DepStr[fDepHandling];
|
||||
if opt <> '' then aList.Add(opt);
|
||||
if base = nil then
|
||||
begin
|
||||
dep := DepStr[fDepHandling];
|
||||
if dep <> '' then aList.Add(dep);
|
||||
if fVerbose then aList.Add('-v');
|
||||
if fWarnings then aList.Add('-w');
|
||||
if fWarnEx then aList.Add('-wi');
|
||||
|
|
@ -461,6 +494,20 @@ begin
|
|||
if fQuiet then aList.Add('-quiet');
|
||||
if fVgc then aList.Add('-vgc');
|
||||
if fCol then aList.Add('-vcolumns');
|
||||
end else
|
||||
begin
|
||||
baseopt := TMsgOpts(base);
|
||||
dep := DepStr[fDepHandling];
|
||||
depbase := DepStr[baseopt.fDepHandling];
|
||||
if dep <> depbase then aList.Add(dep) else aList.Add(depbase);
|
||||
if baseopt.fVerbose or fVerbose then aList.Add('-v');
|
||||
if baseopt.fWarnings or fWarnings then aList.Add('-w');
|
||||
if baseopt.fWarnEx or fWarnEx then aList.Add('-wi');
|
||||
if baseopt.fVtls or fVtls then aList.Add('-vtls');
|
||||
if baseopt.fQuiet or fQuiet then aList.Add('-quiet');
|
||||
if baseopt.fVgc or fVgc then aList.Add('-vgc');
|
||||
if baseopt.fCol or fCol then aList.Add('-vcolumns');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMsgOpts.assign(aValue: TPersistent);
|
||||
|
|
@ -553,18 +600,21 @@ begin
|
|||
inherited;
|
||||
end;
|
||||
|
||||
procedure TOutputOpts.getOpts(const aList: TStrings);
|
||||
procedure TOutputOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
||||
var
|
||||
opt: string;
|
||||
str, strbase: string;
|
||||
baseopt: TOutputOpts;
|
||||
const
|
||||
trgKindStr: array[TTargetSystem] of string = ('', '-m32','-m64');
|
||||
binKindStr: array[TProjectBinaryKind] of string = ('', '-lib', '-shared', '-c');
|
||||
bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off');
|
||||
begin
|
||||
opt := binKindStr[fBinKind];
|
||||
if opt <> '' then aList.Add(opt);
|
||||
opt := trgKindStr[fTrgKind];
|
||||
if opt <> '' then aList.Add(opt);
|
||||
if base = nil then
|
||||
begin
|
||||
str := binKindStr[fBinKind];
|
||||
if str <> '' then aList.Add(str);
|
||||
str := trgKindStr[fTrgKind];
|
||||
if str <> '' then aList.Add(str);
|
||||
if fUnittest then aList.Add('-unittest');
|
||||
if fInline then aList.Add('-inline');
|
||||
if fOptimz then aList.Add('-O');
|
||||
|
|
@ -573,14 +623,14 @@ begin
|
|||
if fAllInst then aList.Add('-allinst');
|
||||
if fAddMain then aList.Add('-main');
|
||||
if fRelease then aList.Add('-release');
|
||||
for opt in fVerIds do begin
|
||||
if length(opt) > 0 then
|
||||
if opt[1] = ';' then
|
||||
for str in fVerIds do begin
|
||||
if length(str) > 0 then
|
||||
if str[1] = ';' then
|
||||
continue;
|
||||
if length(opt) > 1 then
|
||||
if opt[1..2] = '//' then
|
||||
if length(str) > 1 then
|
||||
if str[1..2] = '//' then
|
||||
continue;
|
||||
aList.Add('-version=' + opt );
|
||||
aList.Add('-version=' + str);
|
||||
end;
|
||||
//
|
||||
if fRelease then
|
||||
|
|
@ -591,7 +641,10 @@ begin
|
|||
else
|
||||
if fBoundsCheck <> onAlways then
|
||||
aList.Add('-boundscheck=' + bchKindStr[fBoundsCheck] );
|
||||
|
||||
end else
|
||||
begin
|
||||
//TODO-cNativeProjects: get output options if base config is specified.
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOutputOpts.assign(aValue: TPersistent);
|
||||
|
|
@ -722,9 +775,12 @@ begin
|
|||
inherited;
|
||||
end;
|
||||
|
||||
procedure TDebugOpts.getOpts(const aList: TStrings);
|
||||
procedure TDebugOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
||||
var
|
||||
idt: string;
|
||||
idt, idtbase: string;
|
||||
baseopt: TDebugOpts;
|
||||
begin
|
||||
if base = nil then
|
||||
begin
|
||||
if fDebug then aList.Add('-debug');
|
||||
if fDbgLevel <> 0 then
|
||||
|
|
@ -734,6 +790,10 @@ begin
|
|||
if fDbgD then aList.Add('-g');
|
||||
if fDbgC then aList.Add('-gc');
|
||||
if fGenMap then aList.Add('-map');
|
||||
end else
|
||||
begin
|
||||
//TODO-cNativeProjects: get debug options if base config is specified.
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDebugOpts.assign(aValue: TPersistent);
|
||||
|
|
@ -802,7 +862,7 @@ begin
|
|||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TDebugOpts.setDbgIdents(const aValue: TStringList);
|
||||
procedure TDebugOpts.setDbgIdents(aValue: TStringList);
|
||||
begin
|
||||
fDbgIdents.Assign(aValue);
|
||||
updateForceDbgBool;
|
||||
|
|
@ -832,10 +892,13 @@ begin
|
|||
// EndUpdate is not called to avoid an infinite loop
|
||||
end;
|
||||
|
||||
procedure TPathsOpts.getOpts(const aList: TStrings);
|
||||
procedure TPathsOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
||||
var
|
||||
str: string;
|
||||
exts: TStringList;
|
||||
baseopt: TPathsOpts;
|
||||
begin
|
||||
if base = nil then
|
||||
begin
|
||||
exts := TStringList.Create;
|
||||
try
|
||||
|
|
@ -857,6 +920,10 @@ begin
|
|||
aList.Add('-of' + symbolExpander.get(fFname));
|
||||
if fObjDir <> '' then
|
||||
aList.Add('-od' + symbolExpander.get(fObjDir));
|
||||
end else
|
||||
begin
|
||||
//TODO-cNativeProjects: get paths options if base config is specified.
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPathsOpts.assign(aValue: TPersistent);
|
||||
|
|
@ -954,9 +1021,12 @@ begin
|
|||
inherited;
|
||||
end;
|
||||
|
||||
procedure TOtherOpts.getOpts(const aList: TStrings);
|
||||
procedure TOtherOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
||||
var
|
||||
str1, str2: string;
|
||||
baseopt: TOtherOpts;
|
||||
begin
|
||||
if base = nil then
|
||||
begin
|
||||
for str1 in fCustom do if str1 <> '' then
|
||||
begin
|
||||
|
|
@ -972,9 +1042,13 @@ begin
|
|||
str2 := str1;
|
||||
aList.AddText(symbolExpander.get(str2));
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
//TODO-cNativeProjects: get others options if base config is specified.
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TOtherOpts.setCustom(const aValue: TStringList);
|
||||
procedure TOtherOpts.setCustom(aValue: TStringList);
|
||||
begin
|
||||
fCustom.Assign(aValue);
|
||||
doChanged;
|
||||
|
|
@ -1009,12 +1083,13 @@ begin
|
|||
else inherited;
|
||||
end;
|
||||
|
||||
procedure TCustomProcOptions.getOpts(const aList: TStrings);
|
||||
procedure TCustomProcOptions.getOpts(aList: TStrings; base: TOptsGroup = nil);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TCustomProcOptions.setProcess(var aProcess: TProcess);
|
||||
begin
|
||||
//TODO-cNativeProjects: adapt TCustomProcOptions.setProcess to base/override system
|
||||
aProcess.Parameters.Clear;
|
||||
aProcess.Parameters.AddText(symbolExpander.get(Parameters.Text));
|
||||
aProcess.Executable := fExecutable;
|
||||
|
|
@ -1152,6 +1227,8 @@ begin
|
|||
fPreProcOpt.assign(src.fPreProcOpt);
|
||||
fPostProcOpt.assign(src.fPostProcOpt);
|
||||
fRunProjOpt.assign(src.fRunProjOpt);
|
||||
//
|
||||
// isBase / isOverriden not copied by purpose.
|
||||
end
|
||||
else inherited;
|
||||
end;
|
||||
|
|
@ -1161,7 +1238,9 @@ begin
|
|||
result := format('<configuration %d>', [ID]);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.getOpts(const aList: TStrings);
|
||||
procedure TCompilerConfiguration.getOpts(aList: TStrings; base: TCompilerConfiguration = nil);
|
||||
begin
|
||||
if (base = nil) or (base = self) then
|
||||
begin
|
||||
fDocOpts.getOpts(aList);
|
||||
fDebugOpts.getOpts(aList);
|
||||
|
|
@ -1169,6 +1248,15 @@ begin
|
|||
fOutputOpts.getOpts(aList);
|
||||
fPathsOpts.getOpts(aList);
|
||||
fOthers.getOpts(aList);
|
||||
end else
|
||||
begin
|
||||
fDocOpts.getOpts(aList, base.fDocOpts);
|
||||
fDebugOpts.getOpts(aList, base.fDebugOpts);
|
||||
fMsgOpts.getOpts(aList, base.fMsgOpts);
|
||||
fOutputOpts.getOpts(aList, base.fOutputOpts);
|
||||
fPathsOpts.getOpts(aList, base.fPathsOpts);
|
||||
fOthers.getOpts(aList, base.fOthers);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setName(const aValue: string);
|
||||
|
|
@ -1235,6 +1323,19 @@ procedure TCompilerConfiguration.setRunProjOpt(const aValue: TProjectRunOptions)
|
|||
begin
|
||||
fRunProjOpt.assign(aValue);
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setisBaseConfiguration(const aValue: boolean);
|
||||
begin
|
||||
fIsBaseConfiguration := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
|
||||
procedure TCompilerConfiguration.setisOverriddenConfiguration(const aValue: boolean);
|
||||
begin
|
||||
fIsBaseConfiguration := false;
|
||||
fIsOverriddenConfiguration := aValue;
|
||||
doChanged;
|
||||
end;
|
||||
{$ENDREGION}
|
||||
|
||||
initialization
|
||||
|
|
|
|||
|
|
@ -39,8 +39,10 @@ type
|
|||
fRunner: TCEProcess;
|
||||
fOutputFilename: string;
|
||||
fCanBeRun: boolean;
|
||||
fBaseConfig: TCompilerConfiguration;
|
||||
procedure updateOutFilename;
|
||||
procedure doChanged;
|
||||
procedure getBaseConfig;
|
||||
procedure setLibAliases(const aValue: TStringList);
|
||||
procedure subMemberChanged(sender : TObject);
|
||||
procedure setOptsColl(const aValue: TCollection);
|
||||
|
|
@ -241,6 +243,20 @@ begin
|
|||
endUpdate;
|
||||
end;
|
||||
|
||||
procedure TCENativeProject.getBaseConfig;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
fBaseConfig := nil;
|
||||
for i:= 0 to fConfigs.Count-1 do
|
||||
if configuration[i].isBaseConfiguration then
|
||||
fBaseConfig := configuration[i];
|
||||
for i := 0 to fConfigs.Count-1 do
|
||||
if configuration[i].isBaseConfiguration then
|
||||
if configuration[i] <> fBaseConfig then
|
||||
configuration[i].isBaseConfiguration := false;
|
||||
end;
|
||||
|
||||
procedure TCENativeProject.subMemberChanged(sender : TObject);
|
||||
begin
|
||||
beginUpdate;
|
||||
|
|
@ -275,6 +291,7 @@ var
|
|||
begin
|
||||
fModified := true;
|
||||
updateOutFilename;
|
||||
getBaseConfig;
|
||||
subjProjChanged(fProjectSubject, self);
|
||||
if assigned(fOnChange) then fOnChange(Self);
|
||||
{$IFDEF DEBUG}
|
||||
|
|
@ -392,6 +409,9 @@ begin
|
|||
// but always adds -I<path>
|
||||
LibMan.getLibSources(libAliasesPtr, aList);
|
||||
// config
|
||||
if currentConfiguration.isOverriddenConfiguration then
|
||||
currentConfiguration.getOpts(aList, fBaseConfig)
|
||||
else
|
||||
currentConfiguration.getOpts(aList);
|
||||
finally
|
||||
ex_files.Free;
|
||||
|
|
|
|||
Loading…
Reference in New Issue