fix possible huge CPU usage when actionlist.update called "getCanBeRun".

"outputFilename" and "canBeRun" are now cached into two fields.
This commit is contained in:
Basile Burg 2014-11-18 13:51:37 +01:00
parent cddf6168db
commit ef740f540e
1 changed files with 24 additions and 25 deletions

View File

@ -36,6 +36,9 @@ type
fProjectSubject: TCECustomSubject; fProjectSubject: TCECustomSubject;
fRunner: TCheckedAsyncProcess; fRunner: TCheckedAsyncProcess;
fLogMessager: TCECustomSubject; fLogMessager: TCECustomSubject;
fOutputFilename: string;
fCanBeRun: boolean;
procedure updateOutFilename;
procedure doChanged; procedure doChanged;
procedure setLibAliases(const aValue: TStringList); procedure setLibAliases(const aValue: TStringList);
procedure subMemberChanged(sender : TObject); procedure subMemberChanged(sender : TObject);
@ -46,7 +49,6 @@ type
function getConfig(const ix: integer): TCompilerConfiguration; function getConfig(const ix: integer): TCompilerConfiguration;
function getCurrConf: TCompilerConfiguration; function getCurrConf: TCompilerConfiguration;
function runPrePostProcess(const processInfo: TCompileProcOptions): Boolean; function runPrePostProcess(const processInfo: TCompileProcOptions): Boolean;
function getCanBeRun: boolean;
// passes pre/post/executed project/ outputs as bubles. // passes pre/post/executed project/ outputs as bubles.
procedure runProcOutput(sender: TObject); procedure runProcOutput(sender: TObject);
// passes compilation message as "to be guessed" // passes compilation message as "to be guessed"
@ -75,7 +77,6 @@ type
procedure addSource(const aFilename: string); procedure addSource(const aFilename: string);
function addConfiguration: TCompilerConfiguration; function addConfiguration: TCompilerConfiguration;
procedure getOpts(const aList: TStrings); procedure getOpts(const aList: TStrings);
function outputFilename: string;
function runProject(const runArgs: string = ''): Boolean; function runProject(const runArgs: string = ''): Boolean;
function compileProject: Boolean; function compileProject: Boolean;
// //
@ -84,7 +85,8 @@ type
property currentConfiguration: TCompilerConfiguration read getCurrConf; property currentConfiguration: TCompilerConfiguration read getCurrConf;
property onChange: TNotifyEvent read fOnChange write fOnChange; property onChange: TNotifyEvent read fOnChange write fOnChange;
property modified: Boolean read fModified; property modified: Boolean read fModified;
property canBeRun: Boolean read getCanBeRun; property canBeRun: Boolean read fCanBeRun;
property outputFilename: string read fOutputFilename;
end; end;
implementation implementation
@ -243,6 +245,7 @@ var
{$ENDIF} {$ENDIF}
begin begin
fModified := true; fModified := true;
updateOutFilename;
subjProjChanged(TCEProjectSubject(fProjectSubject), self); subjProjChanged(TCEProjectSubject(fProjectSubject), self);
if assigned(fOnChange) then fOnChange(Self); if assigned(fOnChange) then fOnChange(Self);
{$IFDEF DEBUG} {$IFDEF DEBUG}
@ -307,23 +310,6 @@ begin
fModified := false; fModified := false;
end; end;
function TCEProject.outputFilename: string;
begin
result := currentConfiguration.pathsOptions.outputFilename;
result := symbolExpander.get(result);
if result <> '' then
begin
if not fileExists(result) then
result := getAbsoluteFilename(result);
exit;
end;
if Sources.Count = 0 then
exit;
result := extractFilename(Sources.Strings[0]);
result := result[1..length(result) - length(extractFileExt(result))];
result := extractFilePath(fileName) + DirectorySeparator + result + exeExt;
end;
procedure TCEProject.getOpts(const aList: TStrings); procedure TCEProject.getOpts(const aList: TStrings);
var var
rel, abs: string; rel, abs: string;
@ -359,6 +345,7 @@ end;
procedure TCEProject.afterSave; procedure TCEProject.afterSave;
begin begin
fModified := false; fModified := false;
updateOutFilename;
end; end;
procedure TCEProject.afterLoad; procedure TCEProject.afterLoad;
@ -413,6 +400,7 @@ begin
ce_common.dlgOkInfo('the main sources paths has been patched, some others invalid ' + ce_common.dlgOkInfo('the main sources paths has been patched, some others invalid ' +
'paths may still exists (-of, -od, etc.) but cannot be automatically handled'); 'paths may still exists (-of, -od, etc.) but cannot be automatically handled');
end; end;
updateOutFilename;
end; end;
procedure TCEProject.readerPropNoFound(Reader: TReader; Instance: TPersistent; procedure TCEProject.readerPropNoFound(Reader: TReader; Instance: TPersistent;
@ -448,12 +436,22 @@ begin
end; end;
end; end;
function TCEProject.getCanBeRun: boolean; procedure TCEProject.updateOutFilename;
begin begin
if currentConfiguration = nil then fOutputFilename := currentConfiguration.pathsOptions.outputFilename;
exit(false) fOutputFilename := symbolExpander.get(fOutputFilename);
else fOutputFilename := getAbsoluteFilename(fOutputFilename);
exit(fileExists(outputFilename) and (currentConfiguration.outputOptions.binaryKind = executable)); if not fileExists(fOutputFilename) then if Sources.Count > 0 then
begin
fOutputFilename := getAbsoluteFilename(fOutputFilename);
fOutputFilename := extractFilename(Sources.Strings[0]);
fOutputFilename := fOutputFilename[1..length(fOutputFilename) - length(extractFileExt(fOutputFilename))];
fOutputFilename := extractFilePath(fileName) + DirectorySeparator + fOutputFilename + exeExt;
end;
//
fCanBeRun := false;
if currentConfiguration.outputOptions.binaryKind = executable then
fCanBeRun := fileExists(fOutputFilename);
end; end;
function TCEProject.runPrePostProcess(const processInfo: TCompileProcOptions): Boolean; function TCEProject.runPrePostProcess(const processInfo: TCompileProcOptions): Boolean;
@ -546,6 +544,7 @@ begin
'project warning: the post-compilation process has not been properly executed', Self, amcProj, amkWarn); 'project warning: the post-compilation process has not been properly executed', Self, amcProj, amkWarn);
finally finally
updateOutFilename;
compilproc.Free; compilproc.Free;
chDir(olddir); chDir(olddir);
end; end;