From 3dffaaee76d7b856c4939bdc352745443528f7cd Mon Sep 17 00:00:00 2001
From: martin <laz.git@mfriebe.de>
Date: Sun, 19 Dec 2010 17:34:58 +0000
Subject: [PATCH] DBG: Try to stop immediately, if requested (rather than
 waiting for ProcessMessages to finish. fixes issue #0013564

git-svn-id: trunk@28769 -
---
 debugger/gdbmidebugger.pp | 51 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)

diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp
index f9575287d6..8742a58461 100644
--- a/debugger/gdbmidebugger.pp
+++ b/debugger/gdbmidebugger.pp
@@ -536,6 +536,7 @@ type
     FResult: TGDBMIExecResult;
     FExecType: TGDBMIExecCommandType;
     FCommand: String;
+    FCanKillNow, FDidKillNow: Boolean;
   protected
     procedure DoLockQueueExecute; override;
     procedure DoUnockQueueExecute; override;
@@ -551,6 +552,7 @@ type
     function  DebugText: String; override;
     property  Result: TGDBMIExecResult read FResult;
     property  NextExecQueued: Boolean read FNextExecQueued;
+    function  KillNow: Boolean;
   end;
 
   {%endregion    *^^^*  TGDBMIDebuggerCommands  *^^^*   }
@@ -3631,6 +3633,8 @@ var
   NextExecCmdObj: TGDBMIDebuggerCommandExecute;
 begin
   Result := True;
+  FCanKillNow := False;
+  FDidKillNow := False;
   FNextExecQueued := False;
   //ContinueExecution := True;
 
@@ -3643,14 +3647,21 @@ begin
     then SetDebuggerState(FResult.State);
     // if ContinueExecution will be true, the we ignore dsError..
 
+    // TODO: chack for cancelled
+
     StoppedParams := '';
+    FCanKillNow := True;
     if FResult.State = dsRun
     then Result := ProcessRunning(StoppedParams);
 
   finally
+    FCanKillNow := False;
     FTheDebugger.QueueExecuteUnlock; // allow other commands from executing
   end;
 
+  if FDidKillNow
+  then exit;
+
   ContinueExecution := False;
   if StoppedParams <> ''
   then ContinueExecution := ProcessStopped(StoppedParams, FTheDebugger.PauseWaitState = pwsInternal);
@@ -3693,6 +3704,8 @@ constructor TGDBMIDebuggerCommandExecute.Create(AOwner: TGDBMIDebugger;
   const ExecType: TGDBMIExecCommandType; Args: array of const);
 begin
   inherited Create(AOwner);
+  FCanKillNow := False;
+  FDidKillNow := False;;
   FNextExecQueued := False;
   FExecType := ExecType;
   case FExecType of
@@ -3713,6 +3726,32 @@ begin
   Result := Format('%s: %s', [ClassName, FCommand]);
 end;
 
+function TGDBMIDebuggerCommandExecute.KillNow: Boolean;
+var
+  StoppedParams: String;
+  R: TGDBMIExecResult;
+begin
+  Result := False;
+  if not FCanKillNow then exit;
+  // only here, if we are in ProcessRunning
+  FDidKillNow := True;
+
+  FTheDebugger.GDBPause(True);
+  FTheDebugger.CancelAllQueued; // before ProcessStopped
+  Result := ProcessRunning(StoppedParams);
+  if StoppedParams <> ''
+  then ProcessStopped(StoppedParams, FTheDebugger.PauseWaitState = pwsInternal);
+
+  ExecuteCommand('kill');
+  Result := ExecuteCommand('info program', [], R);
+  Result := Result and (Pos('not being run', R.Values) > 0);
+  if Result
+  then SetDebuggerState(dsStop);
+
+  // Now give the ProcessRunning in the current DoExecute something
+  FTheDebugger.SendCmdLn('print 1');
+end;
+
 { TGDBMIDebuggerCommandLineSymbolInfo }
 
 function TGDBMIDebuggerCommandLineSymbolInfo.DoExecute: Boolean;
@@ -5318,9 +5357,21 @@ begin
     Exit;
   end;
 
+  if (FCurrentCommand is TGDBMIDebuggerCommandExecute)
+  and TGDBMIDebuggerCommandExecute(FCurrentCommand).KillNow
+  then begin
+    {$IFDEF DBG_VERBOSE}
+    debugln(['KillNow did stop']);
+    {$ENDIF}
+    Result := True;
+    exit;
+  end;
+
   if State = dsRun
   then GDBPause(True);
 
+  CancelAllQueued;
+
   // not supported yet
   // ExecuteCommand('-exec-abort');
   Result := ExecuteCommand('kill', [cfNoMiCommand], @GDBStopCallback, 0);