possible workaround for linux OnTerminate TAsyncProcess bug

This commit is contained in:
Basile Burg 2014-11-16 01:04:05 +01:00
parent d0d230cc2d
commit 6ef73e5b0b
7 changed files with 77 additions and 17 deletions

View File

@ -5,7 +5,7 @@ unit ce_common;
interface
uses
Classes, SysUtils,
Classes, SysUtils, ExtCtrls,
{$IFDEF WINDOWS}
Windows,
{$ENDIF}
@ -23,6 +23,21 @@ var
type
(**
* Workaround for a TAsyncProcess Linux issue: OnTerminate event not called.
* An idle timer is started when executing and trigs the event if necessary.
*)
TCheckedAsyncProcess = class(TAsyncProcess)
{$IFDEF LINUX}
private
fTimer: TIdleTimer;
procedure checkTerminated(sender: TObject);
public
constructor Create(aOwner: TComponent); override;
procedure Execute; override;
{$ENDIF}
end;
(**
* MRU list for strings
*)
@ -189,6 +204,8 @@ type
*)
procedure killProcess(var aProcess: TAsyncProcess);
procedure killProcess(var aProcess: TCheckedAsyncProcess);
(**
* Ensures that the in/out process pipes are not redirected, that it has a console, if it waits on exit.
*)
@ -196,6 +213,32 @@ type
implementation
{$IFDEF LINUX}
constructor TCheckedAsyncProcess.Create(aOwner: TComponent);
begin
inherited;
fTimer := TIdleTimer.Create(self);
fTimer.Interval:=50;
fTimer.Enabled:=false;
fTimer.OnTimer:=@checkTerminated;
end;
procedure TCheckedAsyncProcess.Execute;
begin
inherited;
if OnTerminate <> nil then
fTimer.Enabled:=true;
end;
procedure TCheckedAsyncProcess.checkTerminated(sender: TObject);
begin
if OnTerminate = nil then exit;
fTimer.Enabled:=false;
OnTerminate(Self);
end;
{$ENDIF}
// https://stackoverflow.com/questions/25438091/objectbinarytotext-error-with-a-treader-twriter-helper-class
// http://forum.lazarus.freepascal.org/index.php/topic,25557.0.html
procedure TProcessEx.Assign(aValue: TPersistent);
@ -739,6 +782,16 @@ begin
aProcess := nil;
end;
procedure killProcess(var aProcess: TCheckedAsyncProcess);
begin
if aProcess = nil then
exit;
if aProcess.Running then
aProcess.Terminate(0);
aProcess.Free;
aProcess := nil;
end;
procedure ensureNoPipeIfWait(aProcess: TProcess);
begin
if not (poWaitonExit in aProcess.Options) then

View File

@ -12,7 +12,7 @@ type
TCEToolItem = class(TCollectionItem)
private
fProcess: TAsyncProcess;
fProcess: TCheckedAsyncProcess;
fExecutable: string;
fWorkingDir: string;
fShowWin: TShowWindowOptions;
@ -85,7 +85,7 @@ var
begin
killProcess(fProcess);
//
fProcess := TAsyncProcess.Create(nil);
fProcess := TCheckedAsyncProcess.Create(nil);
fProcess.OnReadData:= @processOutput;
fProcess.OnTerminate:= @processOutput;
fProcess.Options := fOpts;

View File

@ -5,7 +5,7 @@ unit ce_dmdwrap;
interface
uses
classes, sysutils, process, asyncprocess;
classes, sysutils, process, asyncprocess, ce_common;
(*
@ -276,6 +276,7 @@ type
without the overload aProcess does not get the Parameters if aProcess is TAsynProcess...}
procedure setProcess(var aProcess: TProcess);
procedure setProcess(var aProcess: TAsyncProcess);
procedure setProcess(var aProcess: TCheckedAsyncProcess);
end;
(*****************************************************************************
@ -354,7 +355,7 @@ type
implementation
uses
ce_common, ce_main;
ce_main;
procedure TOptsGroup.doChanged;
begin
@ -1022,6 +1023,16 @@ begin
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
end;
procedure TCustomProcOptions.setProcess(var aProcess: TCheckedAsyncProcess);
begin
aProcess.Parameters.Assign(Parameters);
aProcess.Executable := fExecutable;
aProcess.ShowWindow := fShowWin;
aProcess.Options := fOptions;
aProcess.CurrentDirectory := fWorkDir;
aProcess.StartupOptions := aProcess.StartupOptions + [suoUseShowWindow];
end;
procedure TCustomProcOptions.setExecutable(const aValue: string);
begin
if fExecutable = aValue then exit;

View File

@ -196,7 +196,7 @@ type
{$ENDIF}
fTools: TCETools;
fRunProc: TAsyncProcess;
fRunProc: TCheckedAsyncProcess;
fLogMessager: TCELogMessageSubject;
@ -1251,8 +1251,6 @@ begin
begin
for str in lst do
subjLmFromString(fLogMessager, str, fDoc, amcEdit, amkBub);
FreeRunnableProc;
// runnable compiler
end;
finally
lst.Free;
@ -1269,7 +1267,7 @@ var
begin
FreeRunnableProc;
fRunProc := TAsyncProcess.Create(nil);
fRunProc := TCheckedAsyncProcess.Create(nil);
fRunProc.Options := [poStderrToOutPut, poUsePipes];
fRunProc.ShowWindow := swoHIDE;
fRunProc.OnReadData := @asyncprocOutput;

View File

@ -24,12 +24,11 @@ inherited CEMessagesWidget: TCEMessagesWidget
Width = 735
Align = alClient
BorderSpacing.Around = 2
DefaultItemHeight = 16
Font.CharSet = ANSI_CHARSET
DefaultItemHeight = 18
Font.Height = -12
Font.Name = 'Lucida Console'
Font.Pitch = fpFixed
Font.Quality = fqDraft
Font.Name = 'Courier New'
Font.Quality = fqProof
Font.Style = [fsBold]
HideSelection = False
Images = imgList
MultiSelect = True

View File

@ -34,7 +34,7 @@ type
fLibMan: TLibraryManager;
fChangedCount: NativeInt;
fProjectSubject: TCECustomSubject;
fRunner: TAsyncProcess;
fRunner: TCheckedAsyncProcess;
fLogMessager: TCECustomSubject;
procedure doChanged;
procedure setLibAliases(const aValue: TStringList);
@ -559,7 +559,7 @@ begin
result := false;
killProcess(fRunner);
//
fRunner := TAsyncProcess.Create(nil); // fRunner can use the input process widget.
fRunner := TCheckedAsyncProcess.Create(nil); // fRunner can use the input process widget.
currentConfiguration.runOptions.setProcess(fRunner);
if runArgs <> '' then
begin

View File

@ -434,7 +434,6 @@ var
end;
begin
killProcess(fDmdProc);
if ndAlias = nil then exit;
// clear the tree