Only set FNotifyMainThreadEvent at start of Execute method and after finishing the compilation of a package

git-svn-id: trunk@48316 -
This commit is contained in:
pierre 2021-01-22 08:57:56 +00:00
parent f4c74b6b09
commit f28629e8e1

View File

@ -3383,9 +3383,8 @@ begin
end; end;
procedure TCompileWorkerThread.execute; procedure TCompileWorkerThread.execute;
begin procedure RaiseMainEvent;
while not Terminated do begin
begin
{ Make sure all of our results are committed before we set (F)Done to true. { Make sure all of our results are committed before we set (F)Done to true.
While RTLeventSetEvent implies a barrier, once the main thread is notified While RTLeventSetEvent implies a barrier, once the main thread is notified
it will walk over all threads and look for those that have Done=true -> it it will walk over all threads and look for those that have Done=true -> it
@ -3394,6 +3393,12 @@ begin
WriteBarrier; WriteBarrier;
FDone:=true; FDone:=true;
RTLeventSetEvent(FNotifyMainThreadEvent); RTLeventSetEvent(FNotifyMainThreadEvent);
end;
begin
if not Terminated then
RaiseMainEvent;
while not Terminated do
begin
RTLeventWaitFor(FNotifyStartTask,500); RTLeventWaitFor(FNotifyStartTask,500);
if not FDone then if not FDone then
begin begin
@ -3404,9 +3409,15 @@ begin
try try
FBuildEngine.Compile(APackage); FBuildEngine.Compile(APackage);
FCompilationOK:=true; FCompilationOK:=true;
FBuildEngine.log(vlInfo,'Done compiling: '+APackage.Name);
RaiseMainEvent;
except except
on E: Exception do on E: Exception do
FErrorMessage := E.Message; begin
FErrorMessage := 'Failed compiling: '+APackage.Name+': '+E.Message;
FBuildEngine.log(vlInfo,FErrorMessage);
RaiseMainEvent;
end;
end; end;
end; end;
end; end;
@ -8621,9 +8632,7 @@ Var
WriteBarrier; WriteBarrier;
AThread.FDone:=False; AThread.FDone:=False;
RTLeventSetEvent(AThread.NotifyStartTask); RTLeventSetEvent(AThread.NotifyStartTask);
end end;
else
sleep(100);
if not PackageAvailable then if not PackageAvailable then
Finished := True; Finished := True;
end; end;