TOutputfilter now uses TDynamicDataQueue to read data from TAsyncProcess immediately. TAsyncProcess enabled for linux

git-svn-id: trunk@9452 -

.gitattributes

@@ -2408,6 +2408,9 @@ lcl/tests/test2_2labelattributes.lpi svneol=native#text/plain
 lcl/tests/test2_2labelattributes.lpr svneol=native#text/pascal
 lcl/tests/test4_1synedit.lpi svneol=native#text/plain
 lcl/tests/test4_1synedit.lpr svneol=native#text/plain
+lcl/tests/test5_1asyncprocess.lpi svneol=native#text/plain
+lcl/tests/test5_1asyncprocess.lpr svneol=native#text/plain
+lcl/tests/test5_1worker.pas svneol=native#text/plain
 lcl/textstrings.pas svneol=native#text/pascal
 lcl/toolwin.pp svneol=native#text/pascal
 lcl/translations.pas svneol=native#text/pascal

ide/compiler.pp

@@ -45,7 +45,7 @@ uses
 type
   TOnCmdLineCreate = procedure(var CmdLine: string; var Abort:boolean)
       of object;
-  
+
   { TCompiler }
 
   TCompiler = class(TObject)
@@ -145,13 +145,8 @@ begin
     DebugLn('[TCompiler.Compile] CmdLine="',CmdLine,'"');
 
     try
-      if TheProcess=nil then begin
-        {$IFDEF UseAsyncProcess}
-        FTheProcess := TAsyncProcess.Create(nil);
-        {$ELSE}
-        FTheProcess := TProcess.Create(nil);
-        {$ENDIF}
-      end;
+      if TheProcess=nil then
+        FTheProcess := TOutputFilterProcess.Create(nil);
       TheProcess.CommandLine := CmdLine;
       TheProcess.Options:= [poUsePipes, poStdErrToOutput];
       TheProcess.ShowWindow := swoHide;

ide/exttooldialog.pas

@@ -311,11 +311,7 @@ begin
   try
     try
       CheckIfFileIsExecutable(Filename);
-      {$IFDEF UseAsyncProcess}
-      TheProcess := TAsyncProcess.Create(nil);
-      {$ELSE}
-      TheProcess := TProcess.Create(nil);
-      {$ENDIF}
+      TheProcess := TOutputFilterProcess.Create(nil);
       TheProcess.CommandLine := Filename+' '+Params;
       TheProcess.Options:= [poUsePipes,poStdErrToOutPut];
       TheProcess.ShowWindow := swoHide;

ide/outputfilter.pas

@@ -26,9 +26,14 @@ unit OutputFilter;
 
 interface
 
+// TODO: Test on all platforms
+{$IFDEF Linux}
+{$DEFINE UseAsyncProcess}
+{$ENDIF}
+
 uses
   Classes, Math, SysUtils, Forms, Controls, CompilerOptions, Project, Process,
-  IDEProcs, FileUtil, LclProc, LazConf, AsyncProcess, IDEMsgIntf;
+  IDEProcs, DynQueue, FileUtil, LclProc, LazConf, AsyncProcess, IDEMsgIntf;
 
 type
   TOnOutputString = procedure(const Msg, Directory: String;
@@ -37,7 +42,13 @@ type
                                  OriginalIndex: integer) of object;
   TOnGetIncludePath = function(const Directory: string;
                                UseCache: boolean): string of object;
-  
+
+  {$IFDEF UseAsyncProcess}
+  TOutputFilterProcess = TAsyncProcess;
+  {$ELSE}
+  TOutputFilterProcess = TProcess;
+  {$ENDIF}
+
   TOuputFilterOption = (
     ofoShowAll,              // don't filter
     ofoSearchForFPCMessages, // scan for freepascal compiler messages
@@ -99,6 +110,8 @@ type
     fLastOutputTime: TDateTime;
     fLastSearchedShortIncFilename: string;
     fLastSearchedIncFilename: string;
+    fProcess: TProcess;
+    FAsyncOutput: TDynamicDataQueue;
     procedure DoAddFilteredLine(const s: string; OriginalIndex: integer = -1);
     procedure DoAddLastLinkerMessages(SkipLastLine: boolean);
     procedure DoAddLastAssemblerMessages;
@@ -205,8 +218,9 @@ var
 begin
   Result:=true;
   Clear;
+  fProcess:=TheProcess;
   //debugln('TOutputFilter.Execute A CurrentDirectory="',TheProcess.CurrentDirectory,'"');
-  fCurrentDirectory:=TrimFilename(TheProcess.CurrentDirectory);
+  fCurrentDirectory:=TrimFilename(fProcess.CurrentDirectory);
   if fCurrentDirectory='' then fCurrentDirectory:=GetCurrentDir;
   fCurrentDirectory:=AppendPathDelim(fCurrentDirectory);
   SetLength(Buf,BufSize);
@@ -217,18 +231,19 @@ begin
   try
     BeginBufferingOutput;
     
-    if TheProcess is TAsyncProcess then begin
-      TheAsyncProcess:=TAsyncProcess(TheProcess);
+    if fProcess is TAsyncProcess then begin
+      TheAsyncProcess:=TAsyncProcess(fProcess);
       TheAsyncProcess.OnReadData:=@OnAsyncReadData;
       TheAsyncProcess.OnTerminate:=@OnAsyncTerminate;
+      FAsyncOutput:=TDynamicDataQueue.Create;
     end else
       TheAsyncProcess:=nil;
 
-    TheProcess.Execute;
+    fProcess.Execute;
     repeat
       Application.ProcessMessages;
       if StopExecute then begin
-        TheProcess.Terminate(0);
+        fProcess.Terminate(0);
         Aborted:=true;
         Result:=false;
         ReadLine('aborted',true);
@@ -238,17 +253,16 @@ begin
       Count:=0;
       if (TheAsyncProcess<>nil) then begin
         // using non blocking TAsyncProcess
-        Count:=TheAsyncProcess.NumBytesAvailable;
-        DebugLn(['TOutputFilter.Execute Count=',Count]);
+        Count:=FAsyncOutput.Size;
         if (Count=0) and AsyncProcessTerminated then break;
         if Count>0 then
-          Count:=TheProcess.Output.Read(Buf[1],Min(Count,length(Buf)))
+          Count:=FAsyncOutput.Pop(Buf[1],Min(Count,length(Buf)))
         else
-          Sleep(100);
+          Sleep(30);
       end;
-      if (TheAsyncProcess=nil) and (TheProcess.Output<>nil) then begin
+      if (TheAsyncProcess=nil) and (fProcess.Output<>nil) then begin
         // using a blocking TProcess
-        Count:=TheProcess.Output.Read(Buf[1],length(Buf));
+        Count:=fProcess.Output.Read(Buf[1],length(Buf));
         if Count=0 then begin
           // no output on blocking means, process has ended
           break;
@@ -276,14 +290,16 @@ begin
       OutputLine:=OutputLine+copy(Buf,LineStart,Count-LineStart+1);
     until false;
     //DebugLn('TOutputFilter.Execute After Loop');
-    TheProcess.WaitOnExit;
-    //DebugLn('TOutputFilter.Execute TheProcess.ExitStatus=',dbgs(TheProcess.ExitStatus));
-    if TheProcess.ExitStatus=0 then
+    fProcess.WaitOnExit;
+    //DebugLn('TOutputFilter.Execute fProcess.ExitStatus=',dbgs(fProcess.ExitStatus));
+    if fProcess.ExitStatus=0 then
       ErrorExists:=false;
     if ErrorExists and (ofoExceptionOnError in Options) then
       raise EOutputFilterError.Create('there was an error');
   finally
     EndBufferingOutput;
+    fProcess:=nil;
+    FreeAndNil(FAsyncOutput);
     if Assigned(OnEndReading) then OnEndReading(Self,fOutput);
   end;
 end;
@@ -990,8 +1006,12 @@ begin
 end;
 
 procedure TOutputFilter.OnAsyncReadData(Sender: TObject);
+var
+  Count: LongWord;
 begin
-  FAsyncDataAvailable:=true;
+  Count:=TAsyncProcess(fProcess).NumBytesAvailable;
+  if Count>0 then
+    FAsyncOutput.Push(TStream(TAsyncProcess(fProcess).Output),Count);
 end;
 
 destructor TOutputFilter.Destroy;

lcl/asyncprocess.pp

@@ -34,9 +34,12 @@ unit AsyncProcess;
 interface
 
 uses
-  Classes, Process, InterfaceBase, LCLIntf;
+  Classes, Process, LCLProc, InterfaceBase, LCLIntf;
 
 type
+
+  { TAsyncProcess }
+
   TAsyncProcess = class(TProcess)
   private
     FPipeHandler: PPipeEventHandler;
@@ -54,7 +57,7 @@ type
     destructor Destroy; override;
   published
     property NumBytesAvailable: dword read GetNumBytesAvailable;
-    property OnReadData: TNotifyEvent read FOnReadData write FOnReadData;
+    property OnReadData: TNotifyEvent read FOnReadData write FOnReadData;// You must read all the data in this event. Otherwise it is called again.
     property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
   end;
 
@@ -78,7 +81,7 @@ begin
 {$endif}
 end;
 
-{$else}
+{$else below for not Windows}
 
 uses BaseUnix, TermIO;
 
@@ -95,7 +98,7 @@ begin
     // FIONREAD -> bytes available for reading without blocking
     // FIONSPACE -> bytes available for writing without blocking
     //   does not work on all platforms (not defined on linux e.g.)
-    if fpioctl(Output.Handle, FIONREAD, @Result) = -1 then
+    if fpioctl(Output.Handle, FIONREAD, @Result)<0 then
       Result := 0;
   end;
 end;

lcl/grids.pas

@@ -2418,7 +2418,6 @@ var
   RNew: TRect;
   OldTopLeft:TPoint;
   Xinc,YInc: Integer;
-  i: Integer;
 begin
   OldTopLeft:=fTopLeft;
 

lcl/include/intfbaselcl.inc

@@ -642,4 +642,4 @@ begin
   Result := False;
 end;
 
-//##apiwiz##eps##   // Do not remove
+//##apiwiz##eps##   // Do not remove

lcl/interfaces/gtk/gtklclintf.inc

@@ -36,7 +36,7 @@ var
 begin
   //debugln('waithandle_iocallback lEventHandler=',HexStr(Cardinal(lEventHandler),8));
   lEventHandler^.OnEvent(lEventHandler^.UserData, condition);
-  result := true;
+  Result := true;
 end;
 
 function TGtkWidgetSet.AddEventHandler(AHandle: THandle; AFlags: dword; 

lcl/interfaces/gtk/gtklclintfh.inc

@@ -35,10 +35,11 @@ function AddPipeEventHandler(AHandle: THandle;
   AEventHandler: TPipeEvent; AData: PtrInt): PPipeEventHandler; override;
 function AddProcessEventHandler(AHandle: THandle;
   AEventHandler: TChildExitEvent; AData: PtrInt): PProcessEventHandler; override;
+
 function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; override;
 
 function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
-  Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
+                    Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;
 function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; override;
 
 function FontCanUTF8(Font: HFont): boolean; override;

lcl/lclproc.pas

@@ -1153,11 +1153,11 @@ begin
   for i:=Low(Args) to High(Args) do begin
     case Args[i].VType of
     vtInteger: DbgOut(dbgs(Args[i].vinteger));
-    vtInt64: DbgOut(dbgs(Args[i].VInt64));
-    vtQWord: DbgOut(dbgs(Args[i].VQWord));
+    vtInt64: DbgOut(dbgs(Args[i].VInt64^));
+    vtQWord: DbgOut(dbgs(Args[i].VQWord^));
     vtBoolean: DbgOut(dbgs(Args[i].vboolean));
     vtExtended: DbgOut(dbgs(Args[i].VExtended^));
-    vtCurrency: DbgOut(dbgs(Args[i].vCurrency));
+    vtCurrency: DbgOut(dbgs(Args[i].vCurrency^));
     vtString: DbgOut(Args[i].VString^);
     vtAnsiString: DbgOut(AnsiString(Args[i].VAnsiString));
     vtChar: DbgOut(Args[i].VChar);

lcl/tests/test5_1asyncprocess.lpi

@@ -0,0 +1,50 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="test5_1asyncprocess.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test5_1asyncprocess"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="test5_1worker.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test5_1worker"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

lcl/tests/test5_1asyncprocess.lpr

@@ -0,0 +1,190 @@
+{
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+
+  LCL Test 5_1 for TAsyncProcess
+
+  Showing a form and starting via TAsyncProcess test5_1worker.
+  
+  Requirements:
+    1. Compile LCL with TAsyncProcess support: -dUseAsyncProcess
+    2. Compile test5_1worker.pas.
+}
+program test5_1asyncprocess;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, Math, Classes, SysUtils, Process, LCLProc, DynQueue, FileUtil,
+  Forms, Controls, AsyncProcess;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    procedure Form1Idle(Sender: TObject; var Done: Boolean);
+    procedure OnAsyncReadData(Sender: TObject);
+    procedure OnAsyncTerminate(Sender: TObject);
+  private
+    FAsyncProcessTerminated: Boolean;
+    FStopExecute: Boolean;
+    FTheProcess: TProcess;
+    FAsyncOutput: TDynamicDataQueue;
+    FUseAsyncProcess: Boolean;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    property AsyncProcessTerminated: boolean read FAsyncProcessTerminated;
+    property StopExecute: Boolean read FStopExecute write FStopExecute;
+    property TheProcess: TProcess read FTheProcess;
+    property UseAsyncProcess: Boolean read FUseAsyncProcess write FUseAsyncProcess;
+  end;
+
+var
+  Form1: TForm1;
+
+{ TForm1 }
+
+procedure TForm1.Form1Idle(Sender: TObject; var Done: Boolean);
+const
+  BufSize = 1024;
+var
+  i, Count, LineStart : longint;
+  OutputLine, Buf : String;
+  TheAsyncProcess: TAsyncProcess;
+begin
+  DebugLn(['TForm1.Form1Idle START']);
+  if UseAsyncProcess then
+    FTheProcess:=TAsyncProcess.Create(nil)
+  else
+    FTheProcess:=TProcess.Create(nil);
+  TheProcess.CommandLine:=AppendPathDelim(GetCurrentDir)+'test5_1worker';
+  if not FileExists(TheProcess.CommandLine) then begin
+    DebugLn(['TForm1.Form1Idle File not found: ',TheProcess.CommandLine]);
+    exit;
+  end;
+  TheProcess.Options:= [poUsePipes,poStdErrToOutPut];
+  TheProcess.ShowWindow := swoHide;
+
+  SetLength(Buf,BufSize);
+
+  OutputLine:='';
+
+  if TheProcess is TAsyncProcess then begin
+    TheAsyncProcess:=TAsyncProcess(TheProcess);
+    TheAsyncProcess.OnReadData:=@OnAsyncReadData;
+    TheAsyncProcess.OnTerminate:=@OnAsyncTerminate;
+    FAsyncOutput:=TDynamicDataQueue.Create;
+  end else
+    TheAsyncProcess:=nil;
+
+  TheProcess.Execute;
+  DebugLn(['TForm1.Form1Idle start looping ...']);
+  repeat
+    Application.ProcessMessages;
+    DebugLn(['TForm1.Form1Idle looping ...']);
+    if StopExecute then begin
+      DebugLn(['TForm1.Form1Idle Aborting...']);
+      TheProcess.Terminate(0);
+      DebugLn(['TForm1.Form1Idle Aborted']);
+      break;
+    end;
+
+    Count:=0;
+    if (TheAsyncProcess<>nil) then begin
+      // using non blocking TAsyncProcess
+      Count:=FAsyncOutput.Size;
+      DebugLn(['TForm1.Form1Idle Count=',Count]);
+      if (Count=0) and AsyncProcessTerminated then break;
+      if Count>0 then
+        Count:=FAsyncOutput.Pop(Buf[1],Min(Count,length(Buf)))
+      else
+        Sleep(100);
+    end;
+    if (TheAsyncProcess=nil) and (TheProcess.Output<>nil) then begin
+      // using a blocking TProcess
+      DebugLn(['TForm1.Form1Idle reading ...']);
+      Count:=TheProcess.Output.Read(Buf[1],length(Buf));
+      DebugLn(['TForm1.Form1Idle read ',Count]);
+      if Count=0 then begin
+        // no output on blocking means, process has ended
+        break;
+      end;
+    end;
+
+    LineStart:=1;
+    i:=1;
+    while i<=Count do begin
+      if Buf[i] in [#10,#13] then begin
+        OutputLine:=OutputLine+copy(Buf,LineStart,i-LineStart);
+        DebugLn(['TForm1.Form1Idle OutputLine="',OutputLine,'"']);
+        OutputLine:='';
+        if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
+        then
+          inc(i);
+        LineStart:=i+1;
+      end;
+      inc(i);
+    end;
+    OutputLine:=OutputLine+copy(Buf,LineStart,Count-LineStart+1);
+  until false;
+  DebugLn('TForm1.Form1Idle After Loop');
+  TheProcess.WaitOnExit;
+  DebugLn('TForm1.Form1Idle TheProcess.ExitStatus=',dbgs(TheProcess.ExitStatus));
+
+  TheProcess.Free;
+  fTheProcess:=nil;
+  FAsyncOutput.Free;
+  FAsyncOutput:=nil;
+end;
+
+procedure TForm1.OnAsyncReadData(Sender: TObject);
+var
+  Count: LongWord;
+  s: string;
+begin
+  Count:=TAsyncProcess(TheProcess).NumBytesAvailable;
+  s:='';
+  if Count>0 then begin
+    FAsyncOutput.Push(TStream(TAsyncProcess(TheProcess).Output),Count);
+    DebugLn(['TForm1.OnAsyncReadData Size=',FAsyncOutput.Size,' ',DbgSName(TAsyncProcess(TheProcess).Output)]);
+    SetLength(s,Count);
+    FAsyncOutput.Top(s[1],Count);
+  end;
+  DebugLn(['TForm1.OnAsyncReadData ',Count,' ',TAsyncProcess(TheProcess).NumBytesAvailable]);
+  DebugLn(DbgStr(s));
+  DumpStack;
+end;
+
+procedure TForm1.OnAsyncTerminate(Sender: TObject);
+begin
+  DebugLn(['TForm1.OnAsyncTerminate ']);
+  FAsyncProcessTerminated:=true;
+end;
+
+constructor TForm1.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  Application.OnIdle:=@Form1Idle;
+end;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TForm1,Form1);
+  Form1.UseAsyncProcess:=ParamStr(1)<>'process';
+  Application.Run;
+end.
+

lcl/tests/test5_1worker.pas

@@ -0,0 +1,45 @@
+{
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+
+  This program is used by the TAsyncProcess test.
+  It runs endless and writes lines.
+}
+program test5_1worker;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils; 
+
+var
+  j: Integer;
+  i: Integer;
+  fs: TFileStream;
+  s: String;
+begin
+  j:=0;
+  while true do begin
+    s:=FormatDateTime('NN:SS.ZZZZ',Now);
+    writeln(s,' .............................................................');
+    s:=s+LineEnding;
+    fs:=TFileStream.Create('worker.log',fmCreate);
+    fs.Position:=fs.Size;
+    fs.Write(s[1],length(s));
+    fs.Free;
+    for i:=0 to 10000000 do begin
+      if (i mod 15000)=0 then inc(j);
+    end;
+  end;
+end.
+