diff --git a/icons/other/check_boxes_series.png b/icons/other/check_boxes_series.png
new file mode 100644
index 00000000..4e4d313b
Binary files /dev/null and b/icons/other/check_boxes_series.png differ
diff --git a/icons/other/check_boxes_series24.png b/icons/other/check_boxes_series24.png
new file mode 100644
index 00000000..e8fc9ef1
Binary files /dev/null and b/icons/other/check_boxes_series24.png differ
diff --git a/icons/other/check_boxes_series32.png b/icons/other/check_boxes_series32.png
new file mode 100644
index 00000000..b8850271
Binary files /dev/null and b/icons/other/check_boxes_series32.png differ
diff --git a/lazproj/coedit.lpi b/lazproj/coedit.lpi
index 60aea56d..b121b71d 100644
--- a/lazproj/coedit.lpi
+++ b/lazproj/coedit.lpi
@@ -13,7 +13,7 @@
-
+
@@ -387,6 +387,9 @@
+
+
+
diff --git a/src/ce_ceproject.pas b/src/ce_ceproject.pas
index b509de37..2f15e7fd 100644
--- a/src/ce_ceproject.pas
+++ b/src/ce_ceproject.pas
@@ -124,6 +124,7 @@ type
procedure run(const runArgs: string = '');
function compiled: Boolean;
procedure compile;
+ procedure test;
function targetUpToDate: boolean;
procedure checkMissingFiles;
//
@@ -1098,6 +1099,10 @@ begin
result := expandFilenameEx(fBasePath, result);
end;
+procedure TCENativeProject.test;
+begin
+end;
+
function isValidNativeProject(const filename: string): boolean;
var
maybe: TCENativeProject;
diff --git a/src/ce_dubproject.pas b/src/ce_dubproject.pas
index 27f3dde4..6b782336 100644
--- a/src/ce_dubproject.pas
+++ b/src/ce_dubproject.pas
@@ -104,6 +104,8 @@ type
destructor destroy; override;
end;
+ TDubCommand = (dcBuild, dcRun, dcTest);
+
TCEDubProject = class(TComponent, ICECommonProject)
private
fIsSdl: boolean;
@@ -130,6 +132,7 @@ type
fCompiled: boolean;
fMsgs: ICEMessagesDisplay;
fLocalPackages: TDubLocalPackages;
+ fNextTerminatedCommand: TDubCommand;
procedure doModified;
procedure updateFields;
procedure updatePackageNameFromJson;
@@ -142,7 +145,7 @@ type
procedure dubProcOutput(proc: TObject);
procedure dubProcTerminated(proc: TObject);
function getCurrentCustomConfig: TJSONObject;
- procedure compileOrRun(run: boolean; const runArgs: string = '');
+ procedure executeDub(command: TDubCommand; const runArgs: string = '');
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
@@ -182,6 +185,7 @@ type
procedure compile;
function compiled: boolean;
procedure run(const runArgs: string = '');
+ procedure test;
function targetUpToDate: boolean;
//
property json: TJSONObject read fJSON;
@@ -225,6 +229,10 @@ const
DubDefaultConfigName = '(default config)';
+ dubCmd2Arg: array[TDubCommand] of string = ('build', 'run', 'test');
+ dubCmd2PreMsg: array[TDubCommand] of string = ('compiling ', 'running ', 'testing ');
+ dubCmd2PostMsg: array[TDubCommand] of string = ('compiled', 'executed', 'tested');
+
{$REGION TDubLocalPackages -----------------------------------------------------}
constructor TDubLocalPackage.create;
begin
@@ -886,55 +894,63 @@ end;
procedure TCEDubProject.dubProcTerminated(proc: TObject);
var
- prjname: string;
+ n: string;
+ i: ICECommonProject;
begin
+ i := self as ICECommonProject;
dubProcOutput(proc);
- prjname := shortenPath(filename);
- fCompiled := fDubProc.ExitStatus = 0;
- if fCompiled then
- fMsgs.message(prjname + ' has been successfully compiled',
- self as ICECommonProject, amcProj, amkInf)
+ n := shortenPath(filename);
+ if fNextTerminatedCommand = dcBuild then
+ fCompiled := fDubProc.ExitStatus = 0;
+ // note: fCompiled is also used to indicate if there's something produced
+ // so the 'or' RHS is there for fNextTerminatedCommand <> dcBuild;
+ if fCompiled or (fDubProc.ExitStatus = 0) then
+ begin
+ fMsgs.message(n + ' has been successfully ' +
+ dubCmd2PostMsg[fNextTerminatedCommand], i, amcProj, amkInf)
+ end
else
begin
- fMsgs.message(prjname + ' has not been compiled',
- self as ICECommonProject, amcProj, amkWarn);
+ fMsgs.message(n + ' has not been successfully ' +
+ dubCmd2PostMsg[fNextTerminatedCommand], i, amcProj, amkWarn);
fMsgs.message(format('error: DUB has returned the status %s',
- [prettyReturnStatus(fDubProc)]), self as ICECommonProject, amcProj, amkErr);
+ [prettyReturnStatus(fDubProc)]), i, amcProj, amkErr);
end;
- subjProjCompiled(fProjectSubject, self as ICECommonProject, fCompiled);
+ subjProjCompiled(fProjectSubject, i, fCompiled);
SetCurrentDirUTF8(fPreCompilePath);
end;
-procedure TCEDubProject.compileOrRun(run: boolean; const runArgs: string = '');
+procedure TCEDubProject.executeDub(command: TDubCommand; const runArgs: string = '');
var
olddir: string;
prjname: string;
rargs: TStringList;
+ prj: ICECommonProject;
begin
+ prj := self as ICECommonProject;;
if fDubProc.isNotNil and fDubProc.Active then
begin
- fMsgs.message('the project is already being compiled',
- self as ICECommonProject, amcProj, amkWarn);
+ fMsgs.message('the project is already being processed by DUB', prj, amcProj, amkWarn);
exit;
end;
killProcess(fDubProc);
fCompiled := false;
if not fFilename.fileExists then
begin
- dlgOkInfo('The DUB project must be saved before being compiled or run !');
+ dlgOkInfo('The project must be saved before being ' +
+ dubCmd2PreMsg[command] + 'by DUB !');
exit;
end;
- fMsgs.clearByData(Self as ICECommonProject);
+ fNextTerminatedCommand := command;
+ fMsgs.clearByData(prj);
prjname := shortenPath(fFilename);
fDubProc:= TCEProcess.Create(nil);
olddir := GetCurrentDir;
try
- if not run then
- begin
- subjProjCompiling(fProjectSubject, self as ICECommonProject);
- fMsgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
- if modified then saveToFile(fFilename);
- end;
+ subjProjCompiling(fProjectSubject, prj);
+ fMsgs.message(dubCmd2PreMsg[command] + prjname, prj, amcProj, amkInf);
+ if modified then
+ saveToFile(fFilename);
chDir(fFilename.extractFilePath);
fDubProc.Executable := 'dub' + exeExt;
if not dubBuildOptions.showConsole then
@@ -949,22 +965,14 @@ begin
end;
fDubProc.CurrentDirectory := fFilename.extractFilePath;
fDubProc.XTermProgram:=consoleProgram;
- if not run then
- begin
- fDubProc.Parameters.Add('build');
- fDubProc.OnTerminate:= @dubProcTerminated;
- end
- else
- begin
- fDubProc.Parameters.Add('run');
- fDubProc.OnTerminate:= @dubProcOutput;
- end;
+ fDubProc.Parameters.Add(dubCmd2Arg[command]);
+ fDubProc.OnTerminate:= @dubProcTerminated;
fDubProc.Parameters.Add('--build=' + fBuildTypes[fBuiltTypeIx]);
if (fConfigs.Count <> 1) and (fConfigs[0] <> DubDefaultConfigName) then
fDubProc.Parameters.Add('--config=' + fConfigs[fConfigIx]);
fDubProc.Parameters.Add('--compiler=' + DubCompilerFilename);
dubBuildOptions.getOpts(fDubProc.Parameters);
- if run and runArgs.isNotEmpty then
+ if (command <> dcBuild) and runArgs.isNotEmpty then
begin
fDubProc.Parameters.Add('--');
rargs := TStringList.Create;
@@ -984,7 +992,7 @@ end;
procedure TCEDubProject.compile;
begin
fPreCompilePath := GetCurrentDirUTF8;
- compileOrRun(false);
+ executeDub(dcBuild);
end;
function TCEDubProject.compiled: boolean;
@@ -994,7 +1002,12 @@ end;
procedure TCEDubProject.run(const runArgs: string = '');
begin
- compileOrRun(true, runArgs);
+ executeDub(dcRun, runArgs);
+end;
+
+procedure TCEDubProject.test;
+begin
+ executeDub(dcTest);
end;
function TCEDubProject.targetUpToDate: boolean;
diff --git a/src/ce_interfaces.pas b/src/ce_interfaces.pas
index e6ee2e02..f3143beb 100644
--- a/src/ce_interfaces.pas
+++ b/src/ce_interfaces.pas
@@ -90,6 +90,8 @@ type
function compiled: boolean;
// tries to execute the project output.
procedure run(const runArgs: string = '');
+ // test the project (only for DUB)
+ procedure test;
// returns true if the target has not to be recompiled
function targetUpToDate: boolean;
diff --git a/src/ce_main.lfm b/src/ce_main.lfm
index f662fcc2..1b835111 100644
--- a/src/ce_main.lfm
+++ b/src/ce_main.lfm
@@ -1807,6 +1807,12 @@ object CEMainForm: TCEMainForm
object MenuItem49: TMenuItem
Action = actProjRunWithArgs
end
+ object MenuItem76: TMenuItem
+ Caption = '-'
+ end
+ object MenuItem110: TMenuItem
+ Action = actProjTest
+ end
end
object MenuItem100: TMenuItem
Caption = 'Projects group'
@@ -1955,6 +1961,12 @@ object CEMainForm: TCEMainForm
object MenuItem46: TMenuItem
Action = actProjRunWithArgs
end
+ object MenuItem111: TMenuItem
+ Caption = '-'
+ end
+ object MenuItem112: TMenuItem
+ Action = actProjTest
+ end
end
object mnuOpts: TMenuItem
Caption = 'Options'
@@ -2376,6 +2388,12 @@ object CEMainForm: TCEMainForm
OnExecute = actEdFormatExecute
OnUpdate = updateDocumentBasedAction
end
+ object actProjTest: TAction
+ Category = 'Project'
+ Caption = 'Test project'
+ OnExecute = actProjTestExecute
+ OnUpdate = updateProjectBasedAction
+ end
end
object ApplicationProperties1: TApplicationProperties
OnActivate = ApplicationProperties1Activate
diff --git a/src/ce_main.pas b/src/ce_main.pas
index 4b0be157..ef247f8a 100644
--- a/src/ce_main.pas
+++ b/src/ce_main.pas
@@ -106,6 +106,7 @@ type
actFileCloseAll: TAction;
actFileNewClip: TAction;
actEdFormat: TAction;
+ actProjTest: TAction;
actLayoutReset: TAction;
actProjDscan: TAction;
actProjGroupCompileCustomSync: TAction;
@@ -159,7 +160,11 @@ type
MenuItem107: TMenuItem;
MenuItem108: TMenuItem;
MenuItem109: TMenuItem;
+ MenuItem110: TMenuItem;
+ MenuItem111: TMenuItem;
+ MenuItem112: TMenuItem;
MenuItem31: TMenuItem;
+ MenuItem76: TMenuItem;
MenuItem77: TMenuItem;
mnuOpts: TMenuItem;
mnuItemMruGroup: TMenuItem;
@@ -289,6 +294,7 @@ type
procedure actProjSaveGroupAsExecute(Sender: TObject);
procedure actProjSaveGroupExecute(Sender: TObject);
procedure actProjSelUngroupedExecute(Sender: TObject);
+ procedure actProjTestExecute(Sender: TObject);
procedure actSetRunnableSwExecute(Sender: TObject);
procedure ApplicationProperties1Activate(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
@@ -1423,6 +1429,9 @@ begin
actProjRun.ImageIndex:= i;
actProjRunWithArgs.ImageIndex:= i;
+ i := loadIcon('CHECK_BOXES_SERIES');
+ actProjTest.ImageIndex:=i;
+
i := loadIcon('LAYOUT');
mnuLayout.ImageIndex:= i;
@@ -3803,6 +3812,15 @@ begin
dlgOkInfo(fProject.getCommandLine, 'Compilation command line');
end;
+procedure TCEMainForm.actProjTestExecute(Sender: TObject);
+begin
+ if not assigned(fProject) then
+ exit;
+ if checkProjectLock then
+ exit;
+ fProject.test;
+end;
+
procedure TCEMainForm.actProjDscanExecute(Sender: TObject);
var
lst: TStringList;