paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 11:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG: Try to stop immediately, if requested (rather than waiting for ProcessMessages to finish. fixes issue #0013564

Browse Source 
git-svn-id: trunk@28769 -
This commit is contained in:
martin 2010-12-19 17:34:58 +00:00
parent 14326c1a1a
commit 3dffaaee76
1 changed files with 51 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
debugger/gdbmidebugger.pp
View File

@ -536,6 +536,7 @@ type
FResult: TGDBMIExecResult; FResult: TGDBMIExecResult;
FExecType: TGDBMIExecCommandType; FExecType: TGDBMIExecCommandType;
FCommand: String; FCommand: String;
FCanKillNow, FDidKillNow: Boolean;
protected protected
procedure DoLockQueueExecute; override; procedure DoLockQueueExecute; override;
procedure DoUnockQueueExecute; override; procedure DoUnockQueueExecute; override;
@ -551,6 +552,7 @@ type
function DebugText: String; override; function DebugText: String; override;
property Result: TGDBMIExecResult read FResult; property Result: TGDBMIExecResult read FResult;
property NextExecQueued: Boolean read FNextExecQueued; property NextExecQueued: Boolean read FNextExecQueued;
function KillNow: Boolean;
end; end;
{%endregion *^^^* TGDBMIDebuggerCommands *^^^* } {%endregion *^^^* TGDBMIDebuggerCommands *^^^* }
@ -3631,6 +3633,8 @@ var
NextExecCmdObj: TGDBMIDebuggerCommandExecute; NextExecCmdObj: TGDBMIDebuggerCommandExecute;
begin begin
Result := True; Result := True;
FCanKillNow := False;
FDidKillNow := False;
FNextExecQueued := False; FNextExecQueued := False;
//ContinueExecution := True; //ContinueExecution := True;
@ -3643,14 +3647,21 @@ begin
then SetDebuggerState(FResult.State); then SetDebuggerState(FResult.State);
// if ContinueExecution will be true, the we ignore dsError.. // if ContinueExecution will be true, the we ignore dsError..
// TODO: chack for cancelled
StoppedParams := ''; StoppedParams := '';
FCanKillNow := True;
if FResult.State = dsRun if FResult.State = dsRun
then Result := ProcessRunning(StoppedParams); then Result := ProcessRunning(StoppedParams);
finally finally
FCanKillNow := False;
FTheDebugger.QueueExecuteUnlock; // allow other commands from executing FTheDebugger.QueueExecuteUnlock; // allow other commands from executing
end; end;
if FDidKillNow
then exit;
ContinueExecution := False; ContinueExecution := False;
if StoppedParams <> '' if StoppedParams <> ''
then ContinueExecution := ProcessStopped(StoppedParams, FTheDebugger.PauseWaitState = pwsInternal); then ContinueExecution := ProcessStopped(StoppedParams, FTheDebugger.PauseWaitState = pwsInternal);
@ -3693,6 +3704,8 @@ constructor TGDBMIDebuggerCommandExecute.Create(AOwner: TGDBMIDebugger;
const ExecType: TGDBMIExecCommandType; Args: array of const); const ExecType: TGDBMIExecCommandType; Args: array of const);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FCanKillNow := False;
FDidKillNow := False;;
FNextExecQueued := False; FNextExecQueued := False;
FExecType := ExecType; FExecType := ExecType;
case FExecType of case FExecType of
@ -3713,6 +3726,32 @@ begin
Result := Format('%s: %s', [ClassName, FCommand]); Result := Format('%s: %s', [ClassName, FCommand]);
end; 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 } { TGDBMIDebuggerCommandLineSymbolInfo }
function TGDBMIDebuggerCommandLineSymbolInfo.DoExecute: Boolean; function TGDBMIDebuggerCommandLineSymbolInfo.DoExecute: Boolean;
@ -5318,9 +5357,21 @@ begin
Exit; Exit;
end; 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 if State = dsRun
then GDBPause(True); then GDBPause(True);
CancelAllQueued;
// not supported yet // not supported yet
// ExecuteCommand('-exec-abort'); // ExecuteCommand('-exec-abort');
Result := ExecuteCommand('kill', [cfNoMiCommand], @GDBStopCallback, 0); Result := ExecuteCommand('kill', [cfNoMiCommand], @GDBStopCallback, 0);