From 7f0dc5b5475ed81f81bf5145e05d669dfb1f2290 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 17 Dec 2020 21:47:31 +0000 Subject: [PATCH] IDE: external tools: free threads via main thread git-svn-id: trunk@64223 - --- components/buildintf/ideexterntoolintf.pas | 6 +- ide/exttools.pas | 103 ++++++++++++++------- ide/exttoolsconsole.pas | 33 +------ ide/exttoolside.pas | 4 +- 4 files changed, 77 insertions(+), 69 deletions(-) diff --git a/components/buildintf/ideexterntoolintf.pas b/components/buildintf/ideexterntoolintf.pas index f7f41347f9..099c3fc0ae 100644 --- a/components/buildintf/ideexterntoolintf.pas +++ b/components/buildintf/ideexterntoolintf.pas @@ -512,7 +512,7 @@ type function CanFree: boolean; virtual; public constructor Create(AOwner: TComponent); override; - destructor Destroy; override; + destructor Destroy; override; // (main thread) // always use before access, when using Tool and View: always lock Tool before View procedure EnterCriticalSection; virtual; procedure LeaveCriticalSection; virtual; @@ -650,7 +650,7 @@ type procedure EnterCriticalSection; virtual; abstract; procedure LeaveCriticalSection; virtual; abstract; function GetIDEObject(ToolData: TIDEExternalToolData): TObject; virtual; abstract; - procedure HandleMesages; virtual; abstract; + procedure HandleMessages; virtual; abstract; // parsers procedure RegisterParser(Parser: TExtToolParserClass); virtual; abstract; // (main thread) procedure UnregisterParser(Parser: TExtToolParserClass); virtual; abstract; // (main thread) @@ -942,7 +942,7 @@ end; procedure TExternalToolGroup.WaitForExit; begin repeat - ExternalToolList.HandleMesages; + ExternalToolList.HandleMessages; if AllStopped then exit; Sleep(50); //debugln(['TExternalToolGroup.WaitForExit ',Now,'==========================']); diff --git a/ide/exttools.pas b/ide/exttools.pas index 13d64889ca..c3f793214b 100644 --- a/ide/exttools.pas +++ b/ide/exttools.pas @@ -76,7 +76,7 @@ type property Tool: TExternalTool read FTool write SetTool; procedure Execute; override; procedure DebuglnThreadLog(const Args: array of const); - destructor Destroy; override; + destructor Destroy; override; // (main thread) end; { TExternalTool } @@ -131,14 +131,18 @@ type private FCritSec: TRTLCriticalSection; fRunning: TFPList; // list of TExternalTool, needs Enter/LeaveCriticalSection + fOldThreads: TFPList; // list of TExternalToolThread, needs Enter/LeaveCriticalSection FMaxProcessCount: integer; fParsers: TFPList; // list of TExtToolParserClass + procedure AddOldThread(aThread: TExternalToolThread); // (main thread) function GetRunningTools(Index: integer): TExternalTool; procedure AddRunningTool(Tool: TExternalTool); // (worker thread) procedure RemoveRunningTool(Tool: TExternalTool); // (worker thread) - function RunExtToolHandler(ToolOptions: TIDEExternalToolOptions): boolean; - function RunToolAndDetach(ToolOptions: TIDEExternalToolOptions): boolean; - function RunToolWithParsers(ToolOptions: TIDEExternalToolOptions): boolean; + function RunExtToolHandler(ToolOptions: TIDEExternalToolOptions): boolean; // (main thread) + function RunToolAndDetach(ToolOptions: TIDEExternalToolOptions): boolean; // (main thread) + function RunToolWithParsers(ToolOptions: TIDEExternalToolOptions): boolean; // (main thread) + procedure FreeFinishedThreads; // (main thread) + procedure OnThreadTerminate(Sender: TObject); // (main thread) protected FToolClass: TExternalToolClass; function GetParsers(Index: integer): TExtToolParserClass; override; @@ -268,6 +272,8 @@ begin if ErrorMessage<>'' then DebuglnThreadLog(['TExternalTool.ThreadStopped ',Title,' ErrorMessage=',ErrorMessage]); {$ENDIF} + if Thread<>nil then + Thread.Tool:=nil; EnterCriticalSection; try if (not Terminated) and (ErrorMessage='') then @@ -293,13 +299,9 @@ begin end; end; end; - try - if Tools<>nil then - TExternalTools(Tools).RemoveRunningTool(Self); - TThread.Synchronize(nil,@NotifyHandlerStopped); - finally - fThread:=nil; - end; + if Tools<>nil then + TExternalTools(Tools).RemoveRunningTool(Self); + TThread.Synchronize(nil,@NotifyHandlerStopped); end; procedure TExternalTool.AddOutputLines(Lines: TStringList); @@ -444,6 +446,9 @@ begin // process stopped => start next if Tools<>nil then TExternalTools(Tools).Work; + + // free tool if not used + AutoFree; end; procedure TExternalTool.NotifyHandlerNewOutput; @@ -462,24 +467,15 @@ end; procedure TExternalTool.SetThread(AValue: TExternalToolThread); var - CallAutoFree: Boolean; + OldThread: TExternalToolThread; begin - // Note: in lazbuild ProcessStopped sets FThread:=nil, so SetThread is not called. - CallAutoFree:=false; - EnterCriticalSection; - try - if FThread=AValue then Exit; - FThread:=AValue; - CallAutoFree:=CanFree; - finally - LeaveCriticalSection; - end; - if CallAutoFree then begin - if MainThreadID=GetCurrentThreadId then - AutoFree - else - QueueAsyncAutoFree; - end; + if FThread=AValue then Exit; + OldThread:=FThread; + FThread:=AValue; + if OldThread<>nil then + OldThread.Tool:=nil; + if FThread<>nil then + FThread.Tool:=Self; end; procedure TExternalTool.SynchronizedImproveMessages; @@ -688,7 +684,8 @@ begin if Thread=nil then begin FThread:=TExternalToolThread.Create(true); Thread.Tool:=Self; - FThread.FreeOnTerminate:=true; + FThread.FreeOnTerminate:=false; + FThread.OnTerminate:=@TExternalTools(Tools).OnThreadTerminate; end; if ConsoleVerbosity>=0 then begin debugln(['Info: (lazarus) Execute Title="',Title,'"']); @@ -913,7 +910,7 @@ begin if MainThreadID=ThreadID then begin Assert(Owner is TExternalToolsBase, 'TExternalTool.WaitForExit: Owner is not TExternalToolsBase.'); - TExternalToolsBase(Owner).HandleMesages; + TExternalToolsBase(Owner).HandleMessages; end; Assert(Assigned(ExternalToolList), 'TExternalTool.WaitForExit: ExternalToolList=Nil.'); // check if this tool still exists @@ -1163,6 +1160,40 @@ begin end; end; +procedure TExternalTools.FreeFinishedThreads; +var + i: Integer; + aThread: TExternalToolThread; +begin + for i:=fOldThreads.Count-1 downto 0 do + begin + aThread:=TExternalToolThread(fOldThreads[i]); + if aThread.Finished then + begin + fOldThreads.Delete(i); + aThread.Free; + end; + end; +end; + +procedure TExternalTools.OnThreadTerminate(Sender: TObject); +begin + AddOldThread(TExternalToolThread(Sender)); +end; + +procedure TExternalTools.AddOldThread(aThread: TExternalToolThread); +var + OldTool: TExternalTool; +begin + OldTool:=aThread.Tool; + aThread.Tool:=nil; + if fOldThreads.IndexOf(aThread)<0 then + fOldThreads.Add(aThread); + + if OldTool<>nil then + OldTool.AutoFree; +end; + function TExternalTools.GetRunningTools(Index: integer): TExternalTool; begin EnterCriticalSection; @@ -1221,6 +1252,7 @@ begin InitCriticalSection(FCritSec); fRunning:=TFPList.Create; fParsers:=TFPList.Create; + fOldThreads:=TFPList.Create; MaxProcessCount:=DefaultMaxProcessCount; RunExternalTool := @RunExtToolHandler; end; @@ -1236,6 +1268,7 @@ begin inherited Destroy; FreeAndNil(fRunning); FreeAndNil(fParsers); + FreeAndNil(fOldThreads); finally LeaveCriticalSection; end; @@ -1265,9 +1298,11 @@ var begin while RunningCountSelf then + raise Exception.Create(''); SetLength(Buf{%H-},4096); ErrorFrameCount:=0; fLines:=TStringList.Create; @@ -1680,8 +1718,7 @@ begin {$IFDEF VerboseExtToolThread} DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ProcessStopped ...']); {$ENDIF} - if Tool<>nil then - Tool.ProcessStopped; + Tool.ProcessStopped; {$IFDEF VerboseExtToolThread} DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' Thread END']); {$ENDIF} diff --git a/ide/exttoolsconsole.pas b/ide/exttoolsconsole.pas index 6638db51a7..754418eef6 100644 --- a/ide/exttoolsconsole.pas +++ b/ide/exttoolsconsole.pas @@ -46,17 +46,11 @@ type { TExternalToolConsole } - // ToDo: Replace TLazExtToolConsole with this TExternalToolConsole somehow. TExternalToolConsole = class(TExternalTool) - private protected procedure CreateView; override; procedure QueueAsyncAutoFree; override; public - constructor Create(aOwner: TComponent); override; - destructor Destroy; override; - procedure EnterCriticalSection; override; - procedure LeaveCriticalSection; override; end; { TExternalToolsConsole } @@ -66,7 +60,7 @@ type constructor Create(aOwner: TComponent); override; destructor Destroy; override; function GetIDEObject({%H-}ToolData: TIDEExternalToolData): TObject; override; - procedure HandleMesages; override; + procedure HandleMessages; override; end; var @@ -185,29 +179,6 @@ end; { TExternalToolConsole } -constructor TExternalToolConsole.Create(aOwner: TComponent); -begin - inherited Create(aOwner); -end; - -destructor TExternalToolConsole.Destroy; -begin - inherited Destroy; -end; - -procedure TExternalToolConsole.EnterCriticalSection; -begin - // A hack to prevent occational crash in LazBuild. Issue #36318, #37883 etc. - Sleep(1); // ToDo: Find the real bug and fix it. - inherited EnterCriticalSection; -end; - -procedure TExternalToolConsole.LeaveCriticalSection; -begin - Sleep(1); - inherited LeaveCriticalSection; -end; - procedure TExternalToolConsole.CreateView; // in console mode all output goes unparsed to console var @@ -247,7 +218,7 @@ begin Result:=nil; end; -procedure TExternalToolsConsole.HandleMesages; +procedure TExternalToolsConsole.HandleMessages; begin if IsMultiThread then begin if ConsoleVerbosity>0 then diff --git a/ide/exttoolside.pas b/ide/exttoolside.pas index 0ee9788642..ad98e8356e 100644 --- a/ide/exttoolside.pas +++ b/ide/exttoolside.pas @@ -36,7 +36,7 @@ type constructor Create(aOwner: TComponent); override; destructor Destroy; override; function GetIDEObject(ToolData: TIDEExternalToolData): TObject; override; - procedure HandleMesages; override; + procedure HandleMessages; override; end; @@ -105,7 +105,7 @@ begin end; end; -procedure TExternalToolsIDE.HandleMesages; +procedure TExternalToolsIDE.HandleMessages; begin Application.ProcessMessages; end;