From f908e60e26f4e61ef8a730634e53b97b487a64aa Mon Sep 17 00:00:00 2001 From: Basile Burg Date: Sat, 12 Jul 2014 01:56:05 +0200 Subject: [PATCH] r17 --- lazproj/test/coeditproj/test.coedit | 7 +- lazproj/test/src/bar.d | 3 + src/ce_dlang.pas | 2 +- src/ce_dmdwrap.pas | 178 ++++++++++++++++++++++------ src/ce_editor.pas | 2 +- src/ce_main.lfm | 39 +++--- src/ce_main.pas | 18 +++ 7 files changed, 197 insertions(+), 52 deletions(-) diff --git a/lazproj/test/coeditproj/test.coedit b/lazproj/test/coeditproj/test.coedit index 0108656e..202879d0 100644 --- a/lazproj/test/coeditproj/test.coedit +++ b/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 diff --git a/lazproj/test/src/bar.d b/lazproj/test/src/bar.d index c748073c..8521aec8 100644 --- a/lazproj/test/src/bar.d +++ b/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"); } } diff --git a/src/ce_dlang.pas b/src/ce_dlang.pas index cb786cfc..d913cf2a 100644 --- a/src/ce_dlang.pas +++ b/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 diff --git a/src/ce_dmdwrap.pas b/src/ce_dmdwrap.pas index c660b191..a987d3cb 100644 --- a/src/ce_dmdwrap.pas +++ b/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 @@ -52,7 +60,7 @@ type (***************************************************************************** * Describes the different depreciation treatments. *) - TDepHandling = (silent, warning, error); + TDepHandling = (silent, warning, error); (***************************************************************************** * Encapsulates the options/args related to the compiler output messages. @@ -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; -(******************************************************************************* - * TDocOpts - *) +{$REGION 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} -(******************************************************************************* - * TMsgOpts - *) +{$REGION TMsgOpts **************************************************************} constructor TMsgOpts.create; begin fDepHandling := TDepHandling.warning; @@ -412,14 +434,12 @@ begin fQuiet := aValue; doChanged; end; +{$ENDREGION} -(******************************************************************************* - * TOutputOpts - *) +{$REGION 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} -(******************************************************************************* - * TDebugOpts - *) -procedure TDebugOpts.getOpts(const aList: TStrings); +{$REGION TDebugOpts ************************************************************} +constructor TDebugOpts.create; 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; -(******************************************************************************* - * TPathsOpts - *) +procedure TDebugOpts.setDbgLevel(const aValue: Integer); +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} -(******************************************************************************* - * TOtherOpts - *) +{$REGION TOtherOpts ************************************************************} constructor TOtherOpts.create; begin fCustom := TStringList.Create; @@ -739,10 +849,9 @@ begin fCustom.Assign(aValue); doChanged; end; +{$ENDREGION} -(******************************************************************************* - * TCompilerConfiguration - *) +{$REGION 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, diff --git a/src/ce_editor.pas b/src/ce_editor.pas index 4b557617..196cae67 100644 --- a/src/ce_editor.pas +++ b/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; diff --git a/src/ce_main.lfm b/src/ce_main.lfm index 7e95a49f..9a98130f 100644 --- a/src/ce_main.lfm +++ b/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 diff --git a/src/ce_main.pas b/src/ce_main.pas index affca375..f32d9d79 100644 --- a/src/ce_main.pas +++ b/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 ***************************************************************}