r17

lazproj/test/coeditproj/test.coedit

@@ -6,7 +6,11 @@ object _1: TCEProject
       documentationOptions.generateJSON = False
       documentationOptions.DocumentationDirectory = '..\doc'
       debugingOptions.debug = True
-      debugingOptions.debugIdentifier = '2'
+      debugingOptions.debugIdentifiers.Strings = (
+        'a'
+        'b'
+      )
+      debugingOptions.debugLevel = 2
       debugingOptions.addDInformations = False
       debugingOptions.addCInformations = False
       debugingOptions.generateMapFile = False
@@ -35,6 +39,7 @@ object _1: TCEProject
       documentationOptions.DocumentationDirectory = '..\doc'
       debugingOptions.debug = False
       debugingOptions.debugIdentifier = '3'
+      debugingOptions.debugLevel = 0
       debugingOptions.addDInformations = False
       debugingOptions.addCInformations = False
       debugingOptions.generateMapFile = False

lazproj/test/src/bar.d

@@ -12,5 +12,8 @@ class Bar{
         debug(1) writeln("bar says: debug level < 2");
         debug(2) writeln("bar says: debug level < 3");
         debug(3) writeln("bar says: debug level < 4");
+        debug(a) writeln("bar says: debug ident a");
+        debug(b) writeln("bar says: debug ident b");
+        debug(c) writeln("bar says: debug ident c");
     }
 }

src/ce_dlang.pas

@@ -838,6 +838,7 @@ var
   mtok: boolean;
 begin
   result := '';
+  mtok := false;
   for ltk in aTokenList do
   begin
     if mtok then
@@ -856,7 +857,6 @@ begin
           mtok := true;
   end;
 end;
-
 {$ENDREGION}
 
 initialization

src/ce_dmdwrap.pas

@@ -7,6 +7,14 @@ interface
 uses
   classes, sysutils;
 
+(*
+
+procedure to add a new compiler option:
+- the option must be published with a setter proc, in the setter 'doChanged' must be called.
+- getOpts must be updated to generate the new option.
+- Assign() must be updated to copy the new option. (used when cloning a configuration)
+
+*)
 
 type
 
@@ -84,15 +92,20 @@ type
     procedure getOpts(const aList: TStrings); override;
   end;
 
-  (*****************************************************************************
+  (**
-   * Describes the target registry size
+   * Describes the target registry size.
    *)
   TTargetSystem = (auto, os32bit, os64bit);
+
   (**
-   * Describes the output kind
+   * Describes the output kind.
    *)
   TBinaryKind = (executable, staticlib, sharedlib, obj);
 
+  (**
+   * Describes the bounds check kinds.
+   *)
+  TBoundCheckKind = (onAlways, safeOnly, offAlways);
 
   (*****************************************************************************
    * Encapsulates the options/args related to the analysis & the code gen.
@@ -105,16 +118,19 @@ type
     fVerId: string;
     fVerIds: TStringList;
     fInline: boolean;
+    fBoundsCheck: TBoundCheckKind;
     fNoBounds: boolean;
     fOptimz: boolean;
     fGenStack: boolean;
     fMain: boolean;
     fRelease: boolean;
+    procedure depPatch;
     procedure setUt(const aValue: boolean);
     procedure setVerId(const aValue: string);
     procedure setTrgKind(const aValue: TTargetSystem);
     procedure setBinKind(const aValue: TBinaryKind);
     procedure setInline(const aValue: boolean);
+    procedure setBoundsCheck(const aValue: TBoundCheckKind);
     procedure setNoBounds(const aValue: boolean);
     procedure setOptims(const aValue: boolean);
     procedure setGenStack(const aValue: boolean);
@@ -126,12 +142,13 @@ type
     property binaryKind: TBinaryKind read fBinKind write setBinKind;
     property inlining: boolean read fInline write setInline;
     property noBoundsCheck: boolean read fNoBounds write setNoBounds;
+    property boundsCheck: TBoundCheckKind read fBoundsCheck write setBoundsCheck;
     property optimizations: boolean read fOptimz write setOptims;
     property generateStackFrame: boolean read fGenStack write setGenStack;
     property addMain: boolean read fMain write setMain;
     property release: boolean read fRelease write setRelease;
     property unittest: boolean read fUt write setUt;
-    property versionIdentifier: string read fVerId write setVerId;
+    property versionIdentifier: string read fVerId write setVerId; // TODO-ccleaning:remove on beta1
     property versionIdentifiers: TStringList read fVerIds write setVerIds;
   public
     constructor create;
@@ -150,18 +167,29 @@ type
     fDbgD: boolean;
     fDbgC: boolean;
     fMap: boolean;
+    fDbgIdents: TStringList;
+    fDbgLevel: Integer;
+    fForceDbgBool: boolean;
+    procedure depPatch;
+    procedure updateForceDbgBool;
     procedure setDbg(const aValue: boolean);
     procedure setDbgIdent(const aValue: string);
     procedure setDbgD(const aValue: boolean);
     procedure setDbgC(const aValue: boolean);
     procedure setMap(const aValue: boolean);
+    procedure setDbgLevel(const aValue: Integer);
+    procedure setDbgIdents(const aValue: TStringList);
   published
     property debug: boolean read fDbg write setDbg;
-    property debugIdentifier: string read fDbgIdent write setDbgIdent;
+    property debugIdentifier: string read fDbgIdent write setDbgIdent; // TODO-ccleaning:remove on beta1
+    property debugIdentifiers: TStringList read fDbgIdents write setDbgIdents;
+    property debugLevel: Integer read fDbgLevel write setDbgLevel;
     property addDInformations: boolean read fDbgD write setDbgD;
     property addCInformations: boolean read fDbgC write setDbgC;
     property generateMapFile: boolean read fMap write setMap;
   public
+    constructor create;
+    destructor destroy; override;
     procedure assign(aValue: TPersistent); override;
     procedure getOpts(const aList: TStrings); override;
   end;
@@ -255,17 +283,12 @@ implementation
 uses
   ce_common;
 
-(*******************************************************************************
- * TOptsGroup
- *)
 procedure TOptsGroup.doChanged;
 begin
   if assigned(fOnChange) then fOnChange(self);
 end;
 
-(*******************************************************************************
+{$REGION TDocOpts **************************************************************}
- * TDocOpts
- *)
 procedure TDocOpts.getOpts(const aList: TStrings);
 begin
   if fGenDoc then aList.Add('-D');
@@ -330,10 +353,9 @@ begin
   if fJsonFname <> '' then setGenJSON(true);
   doChanged;
 end;
+{$ENDREGION}
 
-(*******************************************************************************
+{$REGION TMsgOpts **************************************************************}
- * TMsgOpts
- *)
 constructor TMsgOpts.create;
 begin
   fDepHandling := TDepHandling.warning;
@@ -412,14 +434,12 @@ begin
   fQuiet := aValue;
   doChanged;
 end;
+{$ENDREGION}
 
-(*******************************************************************************
+{$REGION TOutputOpts ***********************************************************}
- * TOutputOpts
- *)
 constructor TOutputOpts.create;
 begin
   fVerIds := TStringList.Create;
-  //fVerId := 'deprecated_field';
 end;
 
 destructor TOutputOpts.destroy;
@@ -428,19 +448,32 @@ begin
   inherited;
 end;
 
+procedure TOutputOpts.depPatch;
+begin
+  // patch deprecated fields
+  if fVerId <> '' then
+  begin
+    if fVerIds.IndexOf(fVerId) = -1 then
+      fVerIds.Add(fVerId);
+    fVerId := '';
+  end;
+end;
+
 procedure TOutputOpts.getOpts(const aList: TStrings);
 var
   opt: string;
 const
   trgKindStr: array[TTargetSystem] of string = ('', '-m32','-m64');
   binKindStr: array[TBinaryKind] of string = ('', '-lib', '-shared', '-c');
+  bchKindStr: array[TBoundCheckKind] of string = ('on', 'safeonly', 'off');
 begin
+  depPatch;
+  //
   opt := binKindStr[fBinKind];
   if opt <> '' then aList.Add(opt);
   opt := trgKindStr[fTrgKind];
   if opt <> '' then aList.Add(opt);
   if fUt then aList.Add('-unittest');
-  if fVerId <> '' then aList.Add('-version=' + fVerId);
   if fInline then aList.Add('-inline');
   if fNoBounds then aList.Add('-noboundscheck');
   if fOptimz then aList.Add('-O');
@@ -449,6 +482,16 @@ begin
   if fRelease then aList.Add('-release');
   for opt in fVerIds do
     aList.Add('-version=' + opt );
+  //
+  if fRelease then
+    begin
+      if fBoundsCheck <> safeOnly then
+        (*generate option*);
+    end
+  else
+    if fBoundsCheck <> onAlways then
+      (*generate option*);
+
 end;
 
 procedure TOutputOpts.assign(aValue: TPersistent);
@@ -462,12 +505,15 @@ begin
     fTrgKind := src.fTrgKind;
     fUt := src.fUt;
     fVerId := src.fVerId;
+    fVerIds.Assign(src.fVerIds);
     fInline := src.fInline;
     fNoBounds := src.fNoBounds;
     fOptimz := src.fOptimz;
     fGenStack := src.fGenStack;
     fMain := src.fMain;
     fRelease := src.fRelease;
+    //
+    depPatch;
   end
   else inherited;
 end;
@@ -513,11 +559,20 @@ begin
   doChanged;
 end;
 
+procedure TOutputOpts.setBoundsCheck(const aValue: TBoundCheckKind);
+begin
+  if fBoundsCheck = aValue then exit;
+  fBoundsCheck := aValue;
+  doChanged;
+end;
+
 procedure TOutputOpts.setNoBounds(const aValue: boolean);
 begin
   if fNoBounds = aValue then exit;
   fNoBounds := aValue;
   doChanged;
+   // turns old option to TBoundCheckKind.onAlways if true and set
+   // fNoBounds to false (wont be written anymore).
 end;
 
 procedure TOutputOpts.setOptims(const aValue: boolean);
@@ -547,14 +602,40 @@ begin
   fRelease := aValue;
   doChanged;
 end;
+{$ENDREGION}
 
-(*******************************************************************************
+{$REGION TDebugOpts ************************************************************}
- * TDebugOpts
+constructor TDebugOpts.create;
- *)
-procedure TDebugOpts.getOpts(const aList: TStrings);
 begin
+  fDbgIdents := TStringList.Create;
+end;
+
+destructor TDebugOpts.destroy;
+begin
+  fDbgIdents.Free;
+  inherited;
+end;
+
+procedure TDebugOpts.depPatch;
+begin
+  // patch deprecated field
+  if fDbgIdent <> '' then
+  begin
+    if fDbgIdents.IndexOf(fDbgIdent) = -1 then
+      fDbgIdents.Add(fDbgIdent);
+    fDbgIdent := '';
+  end;
+end;
+
+procedure TDebugOpts.getOpts(const aList: TStrings);
+var
+  idt: string;
+begin
+  depPatch;
   if fDbg then aList.Add('-debug');
-  if fDbgIdent <> '' then aList.Add('-debug=' + fDbgIdent);
+  if fDbgLevel <> 0 then aList.Add('-debug=' + intToStr(fDbgLevel));
+  for idt in fDbgIdents do
+    aList.Add('-debug=' + idt);
   if fDbgD then aList.Add('-g');
   if fDbgC then aList.Add('-gc');
   if fMap then aList.Add('-map');
@@ -569,15 +650,30 @@ begin
     src := TDebugOpts(aValue);
     fDbg := src.fDbg;
     fDbgIdent := src.fDbgIdent;
+    fDbgIdents.Assign(src.fDbgIdents);
+    fDbgLevel := src.fDbgLevel;
     fDbgD := src.fDbgD;
     fDbgC := src.fDbgC;
     fMap := src.fMap;
+    //
+    depPatch;
   end
   else inherited;
 end;
 
+procedure TDebugOpts.updateForceDbgBool;
+begin
+  fForceDbgBool := (fDbgLevel > 0) or  (fDbgIdents.Count > 0);
+  if fForceDbgBool then setDbg(true);
+end;
+
 procedure TDebugOpts.setDbg(const aValue: boolean);
 begin
+  if fForceDbgBool then
+  begin
+    fDbg := true;
+    exit;
+  end;
   if fDbg = aValue then exit;
   fDbg := aValue;
   doChanged;
@@ -611,9 +707,24 @@ begin
   doChanged;
 end;
 
-(*******************************************************************************
+procedure TDebugOpts.setDbgLevel(const aValue: Integer);
- * TPathsOpts
+begin
- *)
+  if fDbgLevel = aValue then exit;
+  fDbgLevel := aValue;
+  if fDbgLevel < 0 then fDbgLevel := 0;
+  updateForceDbgBool;
+  doChanged;
+end;
+
+procedure TDebugOpts.setDbgIdents(const aValue: TStringList);
+begin
+  fDbgIdents.Assign(aValue);
+  updateForceDbgBool;
+  doChanged;
+end;
+{$ENDREGION}
+
+{$REGION TPathsOpts ************************************************************}
 constructor TPathsOpts.create;
 begin
   fSrcs := TStringList.Create;
@@ -693,10 +804,9 @@ begin
   patchPlateformPaths(fImpt);
   doChanged;
 end;
+{$ENDREGION}
 
-(*******************************************************************************
+{$REGION TOtherOpts ************************************************************}
- * TOtherOpts
- *)
 constructor TOtherOpts.create;
 begin
   fCustom := TStringList.Create;
@@ -739,10 +849,9 @@ begin
   fCustom.Assign(aValue);
   doChanged;
 end;
+{$ENDREGION}
 
-(*******************************************************************************
+{$REGION TCompilerConfiguration ************************************************}
- * TCompilerConfiguration
- *)
 constructor TCompilerConfiguration.create(aCollection: TCollection);
 begin
   inherited create(aCollection);
@@ -857,6 +966,7 @@ procedure TCompilerConfiguration.setOthers(const aValue: TOtherOpts);
 begin
   fOthers.Assign(aValue);
 end;
+{$ENDREGION}
 
 initialization
   RegisterClasses([TCompilerConfiguration, TOtherOpts, TPathsOpts,

src/ce_editor.pas

@@ -123,7 +123,7 @@ begin
   if pageControl.ActivePageIndex <> -1 then
     mainForm.docFocusedNotify(Self, pageControl.ActivePageIndex);
   //
-  if (curr.modified or (pageCOntrol.ActivePage.Caption = '')) then
+  if (curr.modified or (pageControl.ActivePage.Caption = '')) then
   begin
     fKeyChanged := true;
     beginUpdateByDelay;

src/ce_main.lfm

@@ -1140,6 +1140,9 @@ object CEMainForm: TCEMainForm
           91F4969391FF908D8B00969391FF969391F4979492008D8A8800
         }
       end
+      object MenuItem55: TMenuItem
+        Action = actProjOptView
+      end
       object MenuItem40: TMenuItem
         Caption = '-'
       end
@@ -1786,10 +1789,30 @@ object CEMainForm: TCEMainForm
     end
     object actProjSource: TAction
       Category = 'Project'
-      Caption = 'View Project source'
+      Caption = 'View project source'
       ImageIndex = 12
       OnExecute = actProjSourceExecute
     end
+    object actEdIndent: TAction
+      Category = 'Edit'
+      Caption = 'Indent'
+      ImageIndex = 16
+      OnExecute = actEdIndentExecute
+      ShortCut = 24649
+    end
+    object actEdUnIndent: TAction
+      Category = 'Edit'
+      Caption = 'Unindent'
+      ImageIndex = 17
+      OnExecute = actEdUnIndentExecute
+      ShortCut = 24661
+    end
+    object actProjOptView: TAction
+      Category = 'Project'
+      Caption = 'View project options'
+      ImageIndex = 12
+      OnExecute = actProjOptViewExecute
+    end
     object actProjCompile: TAction
       Category = 'Project'
       Caption = 'Compile project'
@@ -1823,20 +1846,6 @@ object CEMainForm: TCEMainForm
       ImageIndex = 21
       OnExecute = actProjRunWithArgsExecute
     end
-    object actEdIndent: TAction
-      Category = 'Edit'
-      Caption = 'Indent'
-      ImageIndex = 16
-      OnExecute = actEdIndentExecute
-      ShortCut = 24649
-    end
-    object actEdUnIndent: TAction
-      Category = 'Edit'
-      Caption = 'Unindent'
-      ImageIndex = 17
-      OnExecute = actEdUnIndentExecute
-      ShortCut = 24661
-    end
   end
   object imgList: TImageList
     left = 64

src/ce_main.pas

@@ -63,6 +63,7 @@ type
     actFileSaveAs: TAction;
     actFileSave: TAction;
     actFileCompAndRunWithArgs: TAction;
+    actProjOptView: TAction;
     actProjSource: TAction;
     actProjRun: TAction;
     actProjRunWithArgs: TAction;
@@ -136,6 +137,7 @@ type
     MenuItem52: TMenuItem;
     MenuItem53: TMenuItem;
     MenuItem54: TMenuItem;
+    MenuItem55: TMenuItem;
     mnuItemMruFile: TMenuItem;
     mnuItemMruProj: TMenuItem;
     mnuItemWin: TMenuItem;
@@ -171,6 +173,7 @@ type
     procedure actEdRedoExecute(Sender: TObject);
     procedure actFileSaveAsExecute(Sender: TObject);
     procedure actFileSaveExecute(Sender: TObject);
+    procedure actProjOptViewExecute(Sender: TObject);
     procedure actProjRunExecute(Sender: TObject);
     procedure actProjRunWithArgsExecute(Sender: TObject);
     procedure actProjSaveAsExecute(Sender: TObject);
@@ -414,6 +417,7 @@ begin
     actProjRun.Enabled := hasProj;
     actProjRunWithArgs.Enabled := hasProj;
     actProjSource.Enabled := hasProj;
+    actProjOptView.Enabled := hasProj;
 
     actFileAddToProj.Enabled := hasEd and hasProj;
 
@@ -934,6 +938,7 @@ begin
   getDir(0, olddir);
   try
 
+    fMesgWidg.Clear;
     fMesgWidg.addCeInf( 'compiling ' + aProject.fileName );
 
     prjpath := extractFilePath(aProject.fileName);
@@ -1220,6 +1225,19 @@ begin
   openFile(fProject.fileName);
   EditWidget.currentEditor.Highlighter := LfmSyn;
 end;
+
+procedure TCEMainForm.actProjOptViewExecute(Sender: TObject);
+var
+  lst: TStringList;
+begin
+  lst := TStringList.Create;
+  try
+    fProject.getOpts(lst);
+    dlgOkInfo(lst.Text);
+  finally
+    lst.Free;
+  end;
+end;
 {$ENDREGION}
 
 {$REGION options ***************************************************************}