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

src/ce_dmdwrap.pas

@@ -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,16 +368,40 @@ begin
 end;
 
 {$REGION TDocOpts --------------------------------------------------------------}
-procedure TDocOpts.getOpts(const aList: TStrings);
+procedure TDocOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
+var
+  baseopt: TDocOpts;
 begin
-  if fGenDoc then
+  if base = nil then
-    aList.Add('-D');
+  begin
-  if fGenJson then
+    if fGenDoc then
-    aList.Add('-X');
+      aList.Add('-D');
-  if fDocDir <> '' then
+    if fGenJson then
-    aList.Add('-Dd' + symbolExpander.get(fDocDir));
+      aList.Add('-X');
-  if fJsonFname <> '' then
+    if fDocDir <> '' then
-    aList.Add('-Xf' + symbolExpander.get(fJsonFname));
+      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,21 +476,38 @@ 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 base = nil then
-  if opt <> '' then aList.Add(opt);
+  begin
-  if fVerbose then aList.Add('-v');
+    dep := DepStr[fDepHandling];
-  if fWarnings then aList.Add('-w');
+    if dep <> '' then aList.Add(dep);
-  if fWarnEx then aList.Add('-wi');
+    if fVerbose then aList.Add('-v');
-  if fVtls then aList.Add('-vtls');
+    if fWarnings then aList.Add('-w');
-  if fQuiet then aList.Add('-quiet');
+    if fWarnEx then aList.Add('-wi');
-  if fVgc then aList.Add('-vgc');
+    if fVtls then aList.Add('-vtls');
-  if fCol then aList.Add('-vcolumns');
+    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,45 +600,51 @@ 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 base = nil then
-  if opt <> '' then aList.Add(opt);
+  begin
-  opt := trgKindStr[fTrgKind];
+    str := binKindStr[fBinKind];
-  if opt <> '' then aList.Add(opt);
+    if str <> '' then aList.Add(str);
-  if fUnittest then aList.Add('-unittest');
+    str := trgKindStr[fTrgKind];
-  if fInline then aList.Add('-inline');
+    if str <> '' then aList.Add(str);
-  if fOptimz then aList.Add('-O');
+    if fUnittest then aList.Add('-unittest');
-  if fGenStack then aList.Add('-gs');
+    if fInline then aList.Add('-inline');
-  if fStackStomp then aList.Add('-gx');
+    if fOptimz then aList.Add('-O');
-  if fAllInst then aList.Add('-allinst');
+    if fGenStack then aList.Add('-gs');
-  if fAddMain then aList.Add('-main');
+    if fStackStomp then aList.Add('-gx');
-  if fRelease then aList.Add('-release');
+    if fAllInst then aList.Add('-allinst');
-  for opt in fVerIds do begin
+    if fAddMain then aList.Add('-main');
-    if length(opt) > 0 then
+    if fRelease then aList.Add('-release');
-      if opt[1] = ';' then
+    for str in fVerIds do begin
-        continue;
+      if length(str) > 0 then
-    if length(opt) > 1 then
+        if str[1] = ';' then
-      if opt[1..2] = '//' then
+          continue;
-        continue;
+      if length(str) > 1 then
-    aList.Add('-version=' + opt );
+        if str[1..2] = '//' then
-  end;
+          continue;
-  //
+      aList.Add('-version=' + str);
-  if fRelease then
+    end;
-    begin
+    //
-      if fBoundsCheck <> safeOnly then
+    if fRelease then
+      begin
+        if fBoundsCheck <> safeOnly then
+          aList.Add('-boundscheck=' + bchKindStr[fBoundsCheck] );
+      end
+    else
+      if fBoundsCheck <> onAlways then
         aList.Add('-boundscheck=' + bchKindStr[fBoundsCheck] );
-    end
+  end else
-  else
+  begin
-    if fBoundsCheck <> onAlways then
+    //TODO-cNativeProjects: get output options if base config is specified.
-      aList.Add('-boundscheck=' + bchKindStr[fBoundsCheck] );
+  end;
-
 end;
 
 procedure TOutputOpts.assign(aValue: TPersistent);
@@ -722,18 +775,25 @@ 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 fDebug then aList.Add('-debug');
+  if base = nil then
-  if fDbgLevel <> 0 then
+  begin
-    aList.Add('-debug=' + intToStr(fDbgLevel));
+    if fDebug then aList.Add('-debug');
-  for idt in fDbgIdents do
+    if fDbgLevel <> 0 then
-    aList.Add('-debug=' + idt);
+      aList.Add('-debug=' + intToStr(fDbgLevel));
-  if fDbgD then aList.Add('-g');
+    for idt in fDbgIdents do
-  if fDbgC then aList.Add('-gc');
+      aList.Add('-debug=' + idt);
-  if fGenMap then aList.Add('-map');
+    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,31 +892,38 @@ 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
-  exts := TStringList.Create;
+  if base = nil then
-  try
+  begin
-    exts.AddStrings(['.d', '.di', '.dd']);
+    exts := TStringList.Create;
-    for str in fExtraSrcs do
+    try
-    begin
+      exts.AddStrings(['.d', '.di', '.dd']);
-      str := symbolExpander.get(str);
+      for str in fExtraSrcs do
-      if not listAsteriskPath(str, aList, exts) then
+      begin
-        aList.Add(str);
+        str := symbolExpander.get(str);
+        if not listAsteriskPath(str, aList, exts) then
+          aList.Add(str);
+      end;
+    finally
+      exts.Free;
     end;
-  finally
+    for str in fImpMod do
-    exts.Free;
+      aList.Add('-I'+ symbolExpander.get(str));
+    for str in fImpStr do
+      aList.Add('-J'+ symbolExpander.get(str));
+    if fFname <> '' then
+      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;
-  for str in fImpMod do
-    aList.Add('-I'+ symbolExpander.get(str));
-  for str in fImpStr do
-    aList.Add('-J'+ symbolExpander.get(str));
-  if fFname <> '' then
-    aList.Add('-of' + symbolExpander.get(fFname));
-  if fObjDir <> '' then
-    aList.Add('-od' + symbolExpander.get(fObjDir));
 end;
 
 procedure TPathsOpts.assign(aValue: TPersistent);
@@ -954,27 +1021,34 @@ begin
   inherited;
 end;
 
-procedure TOtherOpts.getOpts(const aList: TStrings);
+procedure TOtherOpts.getOpts(aList: TStrings; base: TOptsGroup = nil);
 var
   str1, str2: string;
+  baseopt: TOtherOpts;
 begin
-  for str1 in fCustom do if str1 <> '' then
+  if base = nil then
+    begin
+    for str1 in fCustom do if str1 <> '' then
+    begin
+      if length(str1) > 0 then
+        if str1[1] = ';' then
+          continue;
+      if length(str1) > 1 then
+        if str1[1..2] = '//' then
+          continue;
+      if str1[1] <> '-' then
+        str2 := '-' + str1
+      else
+        str2 := str1;
+      aList.AddText(symbolExpander.get(str2));
+    end;
+  end else
   begin
-    if length(str1) > 0 then
+    //TODO-cNativeProjects: get others options if base config is specified.
-      if str1[1] = ';' then
-        continue;
-    if length(str1) > 1 then
-      if str1[1..2] = '//' then
-        continue;
-    if str1[1] <> '-' then
-      str2 := '-' + str1
-    else
-      str2 := str1;
-    aList.AddText(symbolExpander.get(str2));
   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,14 +1238,25 @@ begin
   result := format('<configuration %d>', [ID]);
 end;
 
-procedure TCompilerConfiguration.getOpts(const aList: TStrings);
+procedure TCompilerConfiguration.getOpts(aList: TStrings; base: TCompilerConfiguration = nil);
 begin
-  fDocOpts.getOpts(aList);
+  if (base = nil) or (base = self) then
-  fDebugOpts.getOpts(aList);
+  begin
-  fMsgOpts.getOpts(aList);
+    fDocOpts.getOpts(aList);
-  fOutputOpts.getOpts(aList);
+    fDebugOpts.getOpts(aList);
-  fPathsOpts.getOpts(aList);
+    fMsgOpts.getOpts(aList);
-  fOthers.getOpts(aList);
+    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

src/ce_nativeproject.pas

@@ -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,7 +409,10 @@ begin
     // but always adds -I<path>
     LibMan.getLibSources(libAliasesPtr, aList);
     // config
-    currentConfiguration.getOpts(aList);
+    if currentConfiguration.isOverriddenConfiguration then
+      currentConfiguration.getOpts(aList, fBaseConfig)
+    else
+      currentConfiguration.getOpts(aList);
   finally
     ex_files.Free;
     ex_folds.Free;