Revert latest commits related to processes output, reopen #336

This commit is contained in:
Basile Burg 2018-07-02 22:36:16 +02:00
parent aec8d9bdb0
commit 1b2371a55e
7 changed files with 27 additions and 83 deletions

View File

@ -930,8 +930,6 @@ var
begin
lst := TStringList.Create;
try
if not fCompilProc.Running then
fCompilProc.appendStdErr;
fCompilProc.getFullLines(lst);
for str in lst do
fMsgs.message(str, fAsProjectItf, amcProj, amkAuto);

View File

@ -951,8 +951,6 @@ var
begin
lst := TStringList.Create;
try
if not fDubProc.Running then
fDubProc.appendStdErr;
fDubProc.getFullLines(lst);
for str in lst do
fMsgs.message(str, fAsProjectItf, amcProj, amkAuto);

View File

@ -1472,6 +1472,7 @@ object CEMainForm: TCEMainForm
OnResize = FormResize
OnWindowStateChange = FormWindowStateChange
ShowHint = True
LCLVersion = '1.8.4.0'
Visible = False
object mainMenu: TMainMenu
top = 1

View File

@ -3073,6 +3073,7 @@ begin
begin
// back compat, see https://github.com/BBasile/Coedit/issues/276
dmdproc.Parameters.Add('-version=runnable_module');
dmdproc.Parameters.Add('-version=run_single_module');
end;
@ -3095,7 +3096,8 @@ begin
end;
deleteDups(dmdproc.Parameters);
dmdproc.Execute;
dmdproc.blockingWait();
while dmdproc.Running do
application.ProcessMessages;
if not asObj then
sysutils.DeleteFile(fname + objExt);
if (dmdProc.ExitStatus = 0) then
@ -3105,8 +3107,8 @@ begin
fDoc, amcEdit, amkInf);
end
else begin
(* fMsgs.message(format('error: the process (%s) has returned the status %s',
[dmdproc.Executable, prettyReturnStatus(dmdproc)]), fDoc, amcEdit, amkErr); *)
fMsgs.message(format('error: the process (%s) has returned the status %s',
[dmdproc.Executable, prettyReturnStatus(dmdproc)]), fDoc, amcEdit, amkErr);
fMsgs.message(shortenPath(fDoc.fileName, 25) + ' has not been compiled',
fDoc, amcEdit, amkErr);
end;

View File

@ -9,9 +9,6 @@ uses
type
//TODO: follow up https://bugs.freepascal.org/view.php?id=33897
//which is the cause of the timer workaround
{
The stanndard process wrapper used in Coedit.
@ -19,7 +16,6 @@ type
- OnTerminate event is never called under Linux.
Here a timer perdiodically check the process and call the event accordingly.
(STILL DOES NOT WORK)
- TAsyncProcess.OnReadData event is not usable to read full output lines.
Here the output is accumulated in a TMemoryStream which allows to keep data
at the left of an unterminated line when a buffer is available.
@ -40,7 +36,6 @@ type
fTerminateChecker: TTimer;
fDoneTerminated: boolean;
fHasRead: boolean;
fRedirectStdErr: boolean;
procedure checkTerminated(sender: TObject);
procedure setOnTerminate(value: TNotifyEvent);
procedure setOnReadData(value: TNotifyEvent);
@ -54,12 +49,7 @@ type
constructor create(aOwner: TComponent); override;
destructor destroy; override;
procedure execute; override;
// Check if process is terminated (bug 33897).
// Not to be called in the OnTerminated handler.
procedure blockingWait;
// Add stderr to stdout, to be called when terminated
procedure appendStdErr;
// reads TProcess.Output in OutputStack
// reads TProcess.OUtput in OutputStack
procedure fillOutputStack;
// fills list with the full lines contained in OutputStack
procedure getFullLines(list: TStrings; consume: boolean = true);
@ -173,9 +163,10 @@ begin
FOutputStack := TMemoryStream.Create;
fStdError := TMemoryStream.Create;
FTerminateChecker := TTimer.Create(nil);
FTerminateChecker.Interval := 100;
FTerminateChecker.Interval := 50;
fTerminateChecker.OnTimer := @checkTerminated;
fTerminateChecker.Enabled := false;
//fTerminateChecker.AutoEnabled:= true;
TAsyncProcess(self).OnTerminate := @internalDoOnTerminate;
TAsyncProcess(self).OnReadData := @internalDoOnReadData;
end;
@ -190,8 +181,6 @@ end;
procedure TCEProcess.Execute;
begin
fRedirectStdErr := poStderrToOutPut in Options;
Options := Options - [poStderrToOutPut];
fHasRead := false;
fOutputStack.Clear;
fStdError.Clear;
@ -213,44 +202,17 @@ begin
sum := fOutputStack.Size;
while (Output <> nil) and (NumBytesAvailable > 0) do
begin
fOutputStack.SetSize(sum + NumBytesAvailable);
cnt := Output.Read((fOutputStack.Memory + sum)^, NumBytesAvailable);
fOutputStack.SetSize(sum + 1024);
cnt := Output.Read((fOutputStack.Memory + sum)^, 1024);
sum += cnt;
end;
fOutputStack.SetSize(sum);
if not fRedirectStdErr then
exit;
// error
sum := fStdError.Size;
while (Stderr <> nil) and (Stderr.NumBytesAvailable > 0) do
begin
fStdError.SetSize(sum + Stderr.NumBytesAvailable);
cnt := Stderr.Read((fStdError.Memory + sum)^, Stderr.NumBytesAvailable);
sum += cnt;
end;
fStdError.SetSize(sum);
end;
procedure TCEProcess.appendStdErr;
var
sum, cnt: Integer;
begin
if not (poUsePipes in Options) or not fRedirectStdErr then
exit;
fillOutputStack;
fStdError.Position:=0;
sum := fOutputStack.Size;
fOutputStack.SetSize(sum + fStdError.size);
fStdError.Read((fOutputStack.Memory + sum)^, fStdError.Size);
end;
procedure TCEProcess.getFullLines(list: TStrings; consume: boolean = true);
var
stored: Integer;
lastEOL: Integer;
lastTerm: Integer;
toread: Integer;
buff: Byte = 0;
str: TMemoryStream;
@ -262,17 +224,16 @@ begin
fOutputStack.Clear;
end else
begin
lastEOL := fOutputStack.Position;
lastTerm := fOutputStack.Position;
stored := fOutputStack.Position;
while fOutputStack.Read(buff, 1) = 1 do
if buff = 10 then
lastEOL := fOutputStack.Position;
if buff = 10 then lastTerm := fOutputStack.Position;
fOutputStack.Position := stored;
if lastEOL <> stored then
if lastTerm <> stored then
begin
str := TMemoryStream.Create;
try
toread := lastEOL - stored;
toread := lastTerm - stored;
str.SetSize(toRead);
fOutputStack.Read(str.Memory^, toread);
list.LoadFromStream(str);
@ -317,11 +278,6 @@ begin
//UnhookProcessHandle;
fillOutputStack;
// note: redirection is to output stream is done by hand at the end
// because of sync issue (https://github.com/BBasile/Coedit/issues/336).
if fRedirectStdErr then
appendStdErr;
if fRealOnTerminate <> nil then
fRealOnTerminate(self);
end;
@ -334,15 +290,6 @@ begin
internalDoOnTerminate(self);
end;
procedure TCEProcess.blockingWait;
begin
repeat
fillOutputStack;
until
not Running;
checkTerminated(self);
end;
constructor TCEAutoBufferedProcess.create(aOwner: TComponent);
begin
inherited;

View File

@ -20,7 +20,7 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget
ClientWidth = 328
object lstProj: TListView[0]
Left = 4
Height = 124
Height = 140
Top = 4
Width = 320
Align = alClient
@ -30,22 +30,22 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget
item
AutoSize = True
Caption = 'Name'
Width = 51
Width = 47
end
item
AutoSize = True
Caption = 'Type'
Width = 42
Width = 41
end
item
AutoSize = True
Caption = 'Async'
Width = 51
Width = 47
end
item
AutoSize = True
Caption = 'Configuration'
Width = 174
Width = 89
end>
GridLines = True
HideSelection = False
@ -59,19 +59,19 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget
end
object Panel2: TPanel[1]
Left = 4
Height = 23
Top = 132
Height = 7
Top = 148
Width = 320
Align = alBottom
AutoSize = True
BorderSpacing.Around = 4
BevelOuter = bvNone
ClientHeight = 23
ClientHeight = 7
ClientWidth = 320
TabOrder = 1
object btnFreeFocus: TSpeedButton
Left = 312
Height = 23
Height = 7
Hint = 'Put the focus on the ungrouped project'
Top = 0
Width = 4
@ -83,7 +83,7 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget
end
object StaticText1: TStaticText
Left = 2
Height = 19
Height = 3
Top = 2
Width = 308
Align = alClient
@ -94,7 +94,7 @@ inherited CEProjectGroupWidget: TCEProjectGroupWidget
end
object btnAddUnfocused: TSpeedButton
Left = 316
Height = 23
Height = 7
Hint = 'Put the ungrouped project in the group'
Top = 0
Width = 4

View File

@ -254,8 +254,6 @@ begin
begin
lst := TStringList.Create;
try
if not fProcess.Running then
fProcess.appendStdErr;
fProcess.getFullLines(lst);
for str in lst do
fMsgs.message(str, nil, amcMisc, amkAuto);