paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 19:10:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* wait up to 10ms extra till process really done to get rest of input, closes #39821

Browse Source 
* avoid closing a popassinput handle.

(cherry picked from commit d347487be9)
This commit is contained in:
marcoonthegit 2022-08-08 12:04:50 +02:00
parent 2c75fb13b7
commit 298f443aa5
2 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
packages/fcl-process/src/pipes.pp
View File

@ -44,10 +44,13 @@ Type
end;
TOutputPipeStream = Class(THandleStream)
private
FDontClose : boolean;
Public
destructor Destroy; override;
function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
Function Read (Var Buffer; Count : Longint) : longint; Override;
property DontClose : boolean read FDontClose write FDontClose;
end;
Function CreatePipeHandles (Var Inhandle,OutHandle : THandle; APipeBufferSize : Cardinal = 1024) : Boolean;
@ -106,7 +109,8 @@ end;
destructor TOutputPipeStream.Destroy;
begin
PipeClose (Handle);
if not fdontclose then
PipeClose (Handle);
inherited;
end;

5
packages/fcl-process/src/win/process.inc
View File

@ -39,6 +39,9 @@ end;
Function TProcessnamemacro.PeekExitStatus : Boolean;
begin
Result:=GetExitCodeProcess(ProcessHandle,FExitCode) and (FExitCode<>Still_Active);
// wait up to 10ms extra till process really done to get rest of input bug #39821
if not Result Then
WaitForSingleObject(FProcessHandle,10);
end;
Function GetStartupFlags (P : TProcessnamemacro): Cardinal;
@ -296,6 +299,8 @@ Var
if Not (poStdErrToOutPut in Options) then
FileClose(FStartupInfo.hStdError);
CreateStreams(HI,HO,HE);
if poPassInput in Options then
FInputStream.DontClose:=true;
end;
end;
FRunning:=True;