FpDebugger (pure): Re-direct console output to the terminal-output debug window on Linux

git-svn-id: trunk@46058 -

components/fpdebug/fpdbgclasses.pp

@@ -286,6 +286,9 @@ type
     function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; virtual; abstract;
     function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; virtual;
 
+    function CheckForConsoleOutput(ATimeOutMs: integer): integer; virtual;
+    function GetConsoleOutput: string; virtual;
+
     function AddThread(AThreadIdentifier: THandle): TDbgThread;
     procedure LoadInfo; override;
 
@@ -836,6 +839,16 @@ begin
   end
 end;
 
+function TDbgProcess.CheckForConsoleOutput(ATimeOutMs: integer): integer;
+begin
+  result := -1;
+end;
+
+function TDbgProcess.GetConsoleOutput: string;
+begin
+  result := '';
+end;
+
 function TDbgProcess.AddThread(AThreadIdentifier: THandle): TDbgThread;
 var
   IsMainThread: boolean;

components/fpdebug/fpdbgcontroller.pas

@@ -118,7 +118,6 @@ type
     FOnLog: TOnLog;
     FOnProcessExitEvent: TOnProcessExitEvent;
     FProcessMap: TMap;
-    FExitCode: DWord;
     FPDEvent: TFPDEvent;
     FParams: TStringList;
     FWorkingDirectory: string;
@@ -625,17 +624,8 @@ begin
     end;
     if not IsHandled then
     begin
-      case FPDEvent of
-        deExitProcess :
-          begin
-            if FCurrentProcess = FMainProcess then FMainProcess := nil;
-            FExitCode:=FCurrentProcess.ExitCode;
-
-            FProcessMap.Delete(AProcessIdentifier);
-            FCurrentProcess.Free;
-            FCurrentProcess := nil;
-          end;
-  {      deLoadLibrary :
+{      case FPDEvent of
+        deLoadLibrary :
           begin
             if FCurrentProcess.GetLib(FCurrentProcess.LastEventProcessIdentifier, ALib)
             and (GImageInfo <> iiNone)
@@ -647,8 +637,8 @@ begin
             if GBreakOnLibraryLoad
             then GState := dsPause;
 
-          end;}
-      end; {case}
+          end;
+      end; }{case}
     end;
     if IsFinished then
       FreeAndNil(FCommand);
@@ -676,9 +666,15 @@ begin
       end;
     deExitProcess:
       begin
-        continue := false;
+        if FCurrentProcess = FMainProcess then FMainProcess := nil;
+
         if assigned(OnProcessExitEvent) then
-          OnProcessExitEvent(FExitCode);
+          OnProcessExitEvent(FCurrentProcess.ExitCode);
+
+        FProcessMap.Delete(FCurrentProcess.ProcessID);
+        FCurrentProcess.Free;
+        FCurrentProcess := nil;
+        continue := false;
       end;
     deException:
       begin

components/fpdebug/fpdbglinuxclasses.pas

@@ -260,6 +260,9 @@ type
     function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override;
     function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; override;
 
+    function CheckForConsoleOutput(ATimeOutMs: integer): integer; override;
+    function GetConsoleOutput: string; override;
+
     function GetInstructionPointerRegisterValue: TDbgPtr; override;
     function GetStackPointerRegisterValue: TDbgPtr; override;
     function GetStackBasePointerRegisterValue: TDbgPtr; override;
@@ -576,6 +579,7 @@ begin
     AProcess.Parameters:=AParams;
     AProcess.Environment:=AnEnvironment;
     AProcess.CurrentDirectory:=AWorkingDirectory;
+    AProcess.Options := AProcess.Options + [poUsePipes];
     AProcess.Execute;
     PID:=AProcess.ProcessID;
 
@@ -702,6 +706,32 @@ begin
   result := true;
 end;
 
+function TDbgLinuxProcess.CheckForConsoleOutput(ATimeOutMs: integer): integer;
+Var
+  f: TfdSet;
+  sleepytime: ttimeval;
+begin
+  sleepytime.tv_sec := ATimeOutMs div 1000;
+  sleepytime.tv_usec := (ATimeOutMs mod 1000)*1000;
+  FpFD_ZERO(f);
+  fpFD_SET(FProcProcess.Output.Handle,f);
+  result := fpselect(FProcProcess.Output.Handle+1,@f,nil,nil,@sleepytime);
+end;
+
+function TDbgLinuxProcess.GetConsoleOutput: string;
+var
+  ABytesAvailable: DWord;
+begin
+  ABytesAvailable := FProcProcess.Output.NumBytesAvailable;
+  if ABytesAvailable>0 then
+  begin
+    setlength(result, ABytesAvailable);
+    FProcProcess.Output.Read(result[1], ABytesAvailable);
+  end
+  else
+    result := '';
+end;
+
 function TDbgLinuxProcess.GetInstructionPointerRegisterValue: TDbgPtr;
 begin
   if Mode=dm32 then

components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas

@@ -69,6 +69,7 @@ type
     FLogCritSection: TRTLCriticalSection;
     FMemReader: TDbgMemReader;
     FMemManager: TFpDbgMemManager;
+    FConsoleOutputThread: TThread;
     {$ifdef linux}
     FCacheLine: cardinal;
     FCacheFileName: string;
@@ -269,11 +270,70 @@ type
     function ReadMemoryEx(AnAddress, AnAddressSpace: TDbgPtr; ASize: Cardinal; ADest: Pointer): Boolean; override;
   end;
 
+  { TFpWaitForConsoleOutputThread }
+
+  TFpWaitForConsoleOutputThread = class(TThread)
+  private
+    FFpDebugDebugger: TFpDebugDebugger;
+    FHasConsoleOutputQueued: PRTLEvent;
+    procedure DoHasConsoleOutput(Data: PtrInt);
+  public
+    constructor Create(AFpDebugDebugger: TFpDebugDebugger);
+    destructor Destroy; override;
+    procedure Execute; override;
+  end;
+
+
 procedure Register;
 begin
   RegisterDebugger(TFpDebugDebugger);
 end;
 
+{ TFpWaitForConsoleOutputThread }
+
+procedure TFpWaitForConsoleOutputThread.DoHasConsoleOutput(Data: PtrInt);
+var
+  s: string;
+begin
+  if (Data=0) or assigned(TFpDebugDebugger(Data).FConsoleOutputThread) then
+  begin
+    RTLeventSetEvent(FHasConsoleOutputQueued);
+    s := FFpDebugDebugger.FDbgController.CurrentProcess.GetConsoleOutput;
+    FFpDebugDebugger.OnConsoleOutput(self, s);
+  end;
+end;
+
+constructor TFpWaitForConsoleOutputThread.Create(AFpDebugDebugger: TFpDebugDebugger);
+begin
+  Inherited create(false);
+  FHasConsoleOutputQueued := RTLEventCreate;
+  FFpDebugDebugger := AFpDebugDebugger;
+end;
+
+destructor TFpWaitForConsoleOutputThread.Destroy;
+begin
+  RTLeventdestroy(FHasConsoleOutputQueued);
+  inherited Destroy;
+end;
+
+procedure TFpWaitForConsoleOutputThread.Execute;
+var
+  res: integer;
+begin
+  while not terminated do
+  begin
+    res := FFpDebugDebugger.FDbgController.CurrentProcess.CheckForConsoleOutput(100);
+    if res<0 then
+      Terminate
+    else if res>0 then
+    begin
+      RTLeventResetEvent(FHasConsoleOutputQueued);
+      Application.QueueAsyncCall(@DoHasConsoleOutput, PtrInt(FFpDebugDebugger));
+      RTLeventWaitFor(FHasConsoleOutputQueued);
+    end;
+  end;
+end;
+
 { TFpDbgMemReader }
 
 function TFpDbgMemReader.GetDbgProcess: TDbgProcess;
@@ -922,7 +982,19 @@ end;
 { TFpDebugDebugger }
 
 procedure TFpDebugDebugger.FDbgControllerProcessExitEvent(AExitCode: DWord);
+var
+  AThread: TFpWaitForConsoleOutputThread;
 begin
+  if assigned(FConsoleOutputThread) then
+    begin
+    AThread := TFpWaitForConsoleOutputThread(FConsoleOutputThread);
+    FConsoleOutputThread := nil;
+    AThread.Terminate;
+    AThread.DoHasConsoleOutput(0);
+    AThread.WaitFor;
+    AThread.Free;
+    end;
+
   SetExitCode(Integer(AExitCode));
   {$PUSH}{$R-}
   DoDbgEvent(ecProcess, etProcessExit, Format('Process exited with exit-code %d',[AExitCode]));
@@ -1292,6 +1364,9 @@ begin
 
   if not SetSoftwareExceptionBreakpoint then
     debugln('Failed to set software-debug breakpoint');
+
+  if assigned(OnConsoleOutput) then
+    FConsoleOutputThread := TFpWaitForConsoleOutputThread.Create(self);
 end;
 
 function TFpDebugDebugger.RequestCommand(const ACommand: TDBGCommand;