diff --git a/.gitattributes b/.gitattributes
index 4f593c92db..cec0333c55 100644
--- a/.gitattributes
+++ b/.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
diff --git a/ide/compiler.pp b/ide/compiler.pp
index e5a235cf8a..6a5a55951c 100644
--- a/ide/compiler.pp
+++ b/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;
diff --git a/ide/exttooldialog.pas b/ide/exttooldialog.pas
index cf36ddcb97..5183d436a2 100644
--- a/ide/exttooldialog.pas
+++ b/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;
diff --git a/ide/outputfilter.pas b/ide/outputfilter.pas
index c735089ef1..443f113593 100644
--- a/ide/outputfilter.pas
+++ b/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;
diff --git a/lcl/asyncprocess.pp b/lcl/asyncprocess.pp
index c7456dafb1..d8ef25b292 100644
--- a/lcl/asyncprocess.pp
+++ b/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;
diff --git a/lcl/grids.pas b/lcl/grids.pas
index ede9eef881..75c48ecfab 100644
--- a/lcl/grids.pas
+++ b/lcl/grids.pas
@@ -2418,7 +2418,6 @@ var
RNew: TRect;
OldTopLeft:TPoint;
Xinc,YInc: Integer;
- i: Integer;
begin
OldTopLeft:=fTopLeft;
diff --git a/lcl/include/intfbaselcl.inc b/lcl/include/intfbaselcl.inc
index 876bfc911a..f95e53e86f 100644
--- a/lcl/include/intfbaselcl.inc
+++ b/lcl/include/intfbaselcl.inc
@@ -642,4 +642,4 @@ begin
Result := False;
end;
-//##apiwiz##eps## // Do not remove
\ No newline at end of file
+//##apiwiz##eps## // Do not remove
diff --git a/lcl/interfaces/gtk/gtklclintf.inc b/lcl/interfaces/gtk/gtklclintf.inc
index 563898c146..fb84757372 100644
--- a/lcl/interfaces/gtk/gtklclintf.inc
+++ b/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;
diff --git a/lcl/interfaces/gtk/gtklclintfh.inc b/lcl/interfaces/gtk/gtklclintfh.inc
index d907e55635..9ebc140637 100644
--- a/lcl/interfaces/gtk/gtklclintfh.inc
+++ b/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;
diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas
index 3afdcf82fa..126e235436 100644
--- a/lcl/lclproc.pas
+++ b/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);
diff --git a/lcl/tests/test5_1asyncprocess.lpi b/lcl/tests/test5_1asyncprocess.lpi
new file mode 100644
index 0000000000..ec2b562bdf
--- /dev/null
+++ b/lcl/tests/test5_1asyncprocess.lpi
@@ -0,0 +1,50 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lcl/tests/test5_1asyncprocess.lpr b/lcl/tests/test5_1asyncprocess.lpr
new file mode 100644
index 0000000000..cfe2406010
--- /dev/null
+++ b/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 (iBuf[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.
+
diff --git a/lcl/tests/test5_1worker.pas b/lcl/tests/test5_1worker.pas
new file mode 100644
index 0000000000..c308cf41bf
--- /dev/null
+++ b/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.
+