forks
/
dexed
mirror of https://gitlab.com/basile.b/dexed.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

add support for dub test, close #289

This commit is contained in:
Basile Burg 2018-04-14 02:19:04 +02:00
parent ab68e7287e
commit da889090db
9 changed files with 95 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
icons/other/check_boxes_series.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
icons/other/check_boxes_series24.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
icons/other/check_boxes_series32.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.8 KiB

5
lazproj/coedit.lpi
View File

@ -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>

5
src/ce_ceproject.pas
View File

@ -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;

83
src/ce_dubproject.pas
View File

@ -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;

2
src/ce_interfaces.pas
View File

@ -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;

18
src/ce_main.lfm
View File

@ -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

18
src/ce_main.pas
View File

@ -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;