added common project interface function targetUpToDate

This commit is contained in:
Basile Burg 2015-09-17 22:35:18 +02:00
parent 5ce45a6486
commit 20576801da
4 changed files with 53 additions and 46 deletions

View File

@ -36,6 +36,7 @@ type
function findTargetKindInd(value: TJSONObject): boolean;
procedure dubProcOutput(proc: TProcess);
function getCurrentCustomConfig: TJSONObject;
function compileOrRun(run: boolean; const runArgs: string = ''): boolean;
public
constructor create(aOwner: TComponent); override;
destructor destroy; override;
@ -66,6 +67,7 @@ type
//
function compile: boolean;
function run(const runArgs: string = ''): boolean;
function targetUpToDate: boolean;
//
property json: TJSONObject read fJSON;
//property sources: TStringList read fSrcs;
@ -280,7 +282,7 @@ begin
end;
end;
function TCEDubProject.compile: boolean;
function TCEDubProject.compileOrRun(run: boolean; const runArgs: string = ''): boolean;
var
dubproc: TProcess;
olddir: string;
@ -294,35 +296,54 @@ begin
dubproc := TProcess.Create(nil);
olddir := GetCurrentDir;
try
msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
if not run then
msgs.message('compiling ' + prjname, self as ICECommonProject, amcProj, amkInf);
chDir(extractFilePath(fFilename));
dubproc.Executable := 'dub' + exeExt;
dubproc.Options := dubproc.Options + [poStderrToOutPut, poUsePipes];
dubproc.CurrentDirectory := extractFilePath(fFilename);
dubproc.ShowWindow := swoHIDE;
dubproc.Parameters.Add('build');
if not run then
dubproc.Parameters.Add('build')
else
dubproc.Parameters.Add('run');
if fBuiltTypeIx <> 0 then
dubproc.Parameters.Add('--build=' + fBuildTypes.Strings[fBuiltTypeIx]);
if fConfigIx <> 0 then
dubproc.Parameters.Add('--config=' + fConfigs.Strings[fConfigIx]);
if run and (runArgs <> '') then
dubproc.Parameters.Add('--' + runArgs);
dubproc.Execute;
while dubproc.Running do
dubProcOutput(dubproc);
if dubproc.ExitStatus = 0 then begin
msgs.message(prjname + ' has been successfully compiled', self as ICECommonProject, amcProj, amkInf);
result := true;
end else
msgs.message(prjname + ' has not been compiled', self as ICECommonProject, amcProj, amkWarn);
if not run then
begin
if dubproc.ExitStatus = 0 then begin
msgs.message(prjname + ' has been successfully compiled', self as ICECommonProject, amcProj, amkInf);
result := true;
end else
msgs.message(prjname + ' has not been compiled', self as ICECommonProject, amcProj, amkWarn);
end;
finally
chDir(olddir);
dubproc.Free;
end;
end;
function TCEDubProject.compile: boolean;
begin
result := compileOrRun(false);
end;
function TCEDubProject.run(const runArgs: string = ''): boolean;
begin
//TODO-cDUB: implement
result := false;
result := compileOrRun(true);
end;
function TCEDubProject.targetUpToDate: boolean;
begin
// rebuilding is done automatically when the command is 'run'
result := true;
end;
{$ENDREGION --------------------------------------------------------------------}

View File

@ -74,6 +74,8 @@ type
function compile: boolean;
// tries to un the project output and returns true if it did
function run(const runArgs: string = ''): boolean;
// returns true if the target has not to be recompiled
function targetUpToDate: boolean;
end;

View File

@ -1796,47 +1796,18 @@ begin
end;
procedure TCEMainForm.actProjRunExecute(Sender: TObject);
var
i: Integer;
dt: double;
label
_rbld,
_run;
begin
if fProjectInterface.binaryKind <> executable then
begin
dlgOkInfo('Non executable projects cant be run');
exit;
end;
if not fileExists(fProjectInterface.outputFilename) then
begin
if dlgOkCancel('The project output is missing, build ?') <> mrOK then
exit;
goto _rbld;
end;
// TODO-cICECommonInterface, add function to check if rebuild needed.
if fProjectInterface.getFormat = pfNative then
begin
dt := fileAge(fNativeProject.outputFilename);
for i := 0 to fNativeProject.Sources.Count-1 do
begin
if fileAge(fNativeProject.sourceAbsolute(i)) > dt then
if dlgOkCancel('The project sources have changed since last build, rebuild ?') = mrOK then
goto _rbld
else
break;
end;
end
// DUB checks this automatically
else fProjectInterface.compile;
goto _run;
_rbld:
fProjectInterface.compile;
_run:
if fileExists(fProjectInterface.outputFilename) then
fProjectInterface.run;
if (not fProjectInterface.targetUpToDate) then if
dlgOkCancel('The project output is not up-to-date, rebuild ?') = mrOK then
fProjectInterface.compile;
if fileExists(fProjectInterface.outputFilename)
or (fProjectInterface.getFormat = pfDub) then
fProjectInterface.run;
end;
procedure TCEMainForm.actProjRunWithArgsExecute(Sender: TObject);

View File

@ -100,6 +100,7 @@ type
//
function run(const runArgs: string = ''): Boolean;
function compile: Boolean;
function targetUpToDate: boolean;
//
property configuration[ix: integer]: TCompilerConfiguration read getConfig;
property currentConfiguration: TCompilerConfiguration read getCurrConf;
@ -775,7 +776,6 @@ var
str: string;
msgs: ICEMessagesDisplay;
begin
lst := TStringList.Create;
msgs := getMessageDisplay;
try
@ -810,6 +810,19 @@ begin
end;
end;
function TCENativeProject.targetUpToDate: boolean;
var
dt: double;
i: integer;
begin
result := false;
if not FileExists(fOutputFilename) then exit;
dt := FileAge(fOutputFilename);
for i := 0 to fSrcs.Count-1 do
if fileAge(sourceAbsolute(i)) > dt then exit;
result := true;
end;
function TCENativeProject.outputFilename: string;
begin
exit(fOutputFilename);