add support for dub test, close #289

lazproj/coedit.lpi

@@ -13,7 +13,7 @@
         <DpiAware Value="True/PM"/>
       </XPManifest>
       <Icon Value="0"/>
-      <Resources Count="373">
+      <Resources Count="376">
         <Resource_0 FileName="..\icons\arrow\arrow_up.png" Type="RCDATA" ResourceName="ARROW_UP"/>
         <Resource_1 FileName="..\icons\arrow\arrow_down.png" Type="RCDATA" ResourceName="ARROW_DOWN"/>
         <Resource_2 FileName="..\icons\arrow\arrow_divide.png" Type="RCDATA" ResourceName="ARROW_DIVIDE"/>
@@ -387,6 +387,9 @@
         <Resource_370 FileName="../icons/folder/move_to_folder.png" Type="RCDATA" ResourceName="MOVE_TO_FOLDER"/>
         <Resource_371 FileName="../icons/folder/move_to_folder24.png" Type="RCDATA" ResourceName="MOVE_TO_FOLDER24"/>
         <Resource_372 FileName="../icons/folder/move_to_folder32.png" Type="RCDATA" ResourceName="MOVE_TO_FOLDER32"/>
+        <Resource_373 FileName="../icons/other/check_boxes_series.png" Type="RCDATA" ResourceName="CHECK_BOXES_SERIES"/>
+        <Resource_374 FileName="../icons/other/check_boxes_series24.png" Type="RCDATA" ResourceName="CHECK_BOXES_SERIES24"/>
+        <Resource_375 FileName="../icons/other/check_boxes_series32.png" Type="RCDATA" ResourceName="CHECK_BOXES_SERIES32"/>
       </Resources>
     </General>
     <i18n>

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;

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);
+  n := shortenPath(filename);
-  fCompiled := fDubProc.ExitStatus = 0;
+  if fNextTerminatedCommand = dcBuild then
-  if fCompiled then
+    fCompiled := fDubProc.ExitStatus = 0;
-    fMsgs.message(prjname + ' has been successfully compiled',
+  // note: fCompiled is also used to indicate if there's something produced
-      self as ICECommonProject, amcProj, amkInf)
+  // 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',
+    fMsgs.message(n + ' has not been successfully ' +
-      self as ICECommonProject, amcProj, amkWarn);
+      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',
+    fMsgs.message('the project is already being processed by DUB', prj, amcProj, amkWarn);
-      self as ICECommonProject, 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
+    subjProjCompiling(fProjectSubject, prj);
-    begin
+    fMsgs.message(dubCmd2PreMsg[command] + prjname, prj, amcProj, amkInf);
-      subjProjCompiling(fProjectSubject, self as ICECommonProject);
+    if modified then
-      fMsgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
+      saveToFile(fFilename);
-      if modified then saveToFile(fFilename);
-    end;
     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
+    fDubProc.Parameters.Add(dubCmd2Arg[command]);
-    begin
+    fDubProc.OnTerminate:= @dubProcTerminated;
-      fDubProc.Parameters.Add('build');
-      fDubProc.OnTerminate:= @dubProcTerminated;
-    end
-    else
-    begin
-      fDubProc.Parameters.Add('run');
-      fDubProc.OnTerminate:= @dubProcOutput;
-    end;
     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;

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;
 

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

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;