paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 15:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@48316 -
This commit is contained in:
pierre 2021-01-22 08:57:56 +00:00
parent f4c74b6b09
commit f28629e8e1
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
packages/fpmkunit/src/fpmkunit.pp
View File

@ -3383,9 +3383,8 @@ begin
end;
procedure TCompileWorkerThread.execute;
begin
while not Terminated do
begin
procedure RaiseMainEvent;
begin
{ 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
it will walk over all threads and look for those that have Done=true -> it
@ -3394,6 +3393,12 @@ begin
WriteBarrier;
FDone:=true;
RTLeventSetEvent(FNotifyMainThreadEvent);
end;
begin
if not Terminated then
RaiseMainEvent;
while not Terminated do
begin
RTLeventWaitFor(FNotifyStartTask,500);
if not FDone then
begin
@ -3404,9 +3409,15 @@ begin
try
FBuildEngine.Compile(APackage);
FCompilationOK:=true;
FBuildEngine.log(vlInfo,'Done compiling: '+APackage.Name);
RaiseMainEvent;
except
on E: Exception do
FErrorMessage := E.Message;
begin
FErrorMessage := 'Failed compiling: '+APackage.Name+': '+E.Message;
FBuildEngine.log(vlInfo,FErrorMessage);
RaiseMainEvent;
end;
end;
end;
end;
@ -8621,9 +8632,7 @@ Var
WriteBarrier;
AThread.FDone:=False;
RTLeventSetEvent(AThread.NotifyStartTask);
end
else
sleep(100);
end;
if not PackageAvailable then
Finished := True;
end;