paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-18 18:46:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

Debugger: More TGDBInstructionQueue / automatic thread/stack switching

Browse Source 
git-svn-id: trunk@42442 -
This commit is contained in:
martin 2013-08-21 13:40:31 +00:00
parent d474dc97c9
commit cf9f00ceef
4 changed files with 818 additions and 361 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

314
debugger/gdbmidebugger.pp
View File

@ -66,6 +66,8 @@ type
cfCheckState, // Copy CmdResult to DebuggerState, EXCEPT dsError,dsNone (e.g copy dsRun, dsPause, dsStop, dsIdle)
cfCheckError, // Copy CmdResult to DebuggerState, ONLY if dsError
cfTryAsync, // try with " &"
cfNoThreadContext,
cfNoStackContext,
//used for old commands, TGDBMIDebuggerSimpleCommand.Create
cfscIgnoreState, // ignore the result state of the command
cfscIgnoreError // ignore errors
@ -245,6 +247,14 @@ type
);
TGDBMIProcessResultOpts = set of TGDBMIProcessResultOpt;
TGDBMICommandContextKind = (ccNotRequired, ccUseGlobal, ccUseLocal);
TGDBMICommandContext = record
ThreadContext: TGDBMICommandContextKind;
ThreadId: Integer;
StackContext: TGDBMICommandContextKind;
StackFrame: Integer;
end;
TGDBMIDebuggerCommand = class(TRefCountedObject)
private
FDefaultTimeOut: Integer;
@ -267,6 +277,11 @@ type
function GetTargetInfo: PGDBMITargetInfo;
protected
FTheDebugger: TGDBMIDebugger; // Set during Execute
FContext: TGDBMICommandContext;
function ContextThreadId: Integer; // does not check validy, only ccUseGlobal or ccUseLocal
function ContextStackFrame: Integer; // does not check validy, only ccUseGlobal or ccUseLocal
procedure CopyGlobalContextToLocal;
procedure SetDebuggerState(const AValue: TDBGState);
procedure SetDebuggerErrorState(const AMsg: String; const AInfo: String = '');
function ErrorStateMessage: String; virtual;
@ -595,7 +610,7 @@ type
// Internal Current values
FCurrentStackFrame, FCurrentThreadId: Integer; // User set values
FInternalStackFrame, FInternalThreadId: Integer; // Internal (update for every temporary change)
FCurrentStackFrameValid, FCurrentThreadIdValid: Boolean; // Internal (update for every temporary change)
FCurrentLocation: TDBGLocationRec;
// GDB info (move to ?)
@ -790,7 +805,7 @@ implementation
var
DBGMI_QUEUE_DEBUG, DBGMI_STRUCT_PARSER, DBG_VERBOSE, DBG_WARNINGS,
DBG_DISASSEMBLER: PLazLoggerLogGroup;
DBG_DISASSEMBLER, DBG_THREAD_AND_FRAME: PLazLoggerLogGroup;
const
@ -1199,7 +1214,6 @@ type
FTypeInfo: TGDBType;
FValidity: TDebuggerDataState;
FTypeInfoAutoDestroy: Boolean;
FThreadChanged, FStackFrameChanged: Boolean;
function GetTypeInfo: TGDBType;
procedure DoWatchFreed(Sender: TObject);
protected
@ -1252,7 +1266,6 @@ type
procedure DoCallstackFreed(Sender: TObject);
protected
FCallstack: TCurrentCallStack;
FThreadChanged: Boolean;
function SelectThread: Boolean;
procedure UnSelectThread;
public
@ -2435,8 +2448,10 @@ begin
if StoppedParams <> ''
then ProcessStopped(StoppedParams, FTheDebugger.PauseWaitState = pwsInternal);
ExecuteCommand('kill', [], 1500);
Result := ExecuteCommand('info program', [], R);
ExecuteCommand('kill', [cfNoThreadContext], 1500);
FTheDebugger.FCurrentStackFrameValid := False;
FTheDebugger.FCurrentThreadIdValid := False;
Result := ExecuteCommand('info program', [cfNoThreadContext], R);
Result := Result and (Pos('not being run', R.Values) > 0);
if Result
then SetDebuggerState(dsStop);
@ -2500,6 +2515,9 @@ var
begin
Result := True;
FSuccess := False;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
//Cleanup our own breakpoints
FTheDebugger.FExceptionBreak.Clear(Self);
FTheDebugger.FBreakErrorBreak.Clear(Self);
@ -2594,6 +2612,9 @@ var
R: TGDBMIExecResult;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
FSuccess := ExecuteCommand('-gdb-set confirm off', R);
FSuccess := FSuccess and (r.State <> dsError);
if (not FSuccess) then exit;
@ -2625,8 +2646,8 @@ end;
function TGDBMIDebuggerCommandStackSetCurrent.DoExecute: Boolean;
begin
Result := True;
ExecuteCommand('-stack-select-frame %d', [FNewCurrent], []);
FTheDebugger.FInternalStackFrame := FNewCurrent;
//ExecuteCommand('-stack-select-frame %d', [FNewCurrent], []);
DebugLn(DBG_THREAD_AND_FRAME, ['TGDBMIDebuggerCommandStackSetCurrent: STACK wanted ', FNewCurrent]);
end;
constructor TGDBMIDebuggerCommandStackSetCurrent.Create(AOwner: TGDBMIDebugger;
@ -2649,28 +2670,15 @@ begin
end;
function TGDBMIDebuggerCommandStack.SelectThread: Boolean;
var
R: TGDBMIExecResult;
t: Integer;
begin
Result := True;
FThreadChanged := False;
if (FCallstack = nil) or (dcsCanceled in SeenStates) then exit;
t := FCallstack.ThreadId;
if t = FTheDebugger.FCurrentThreadId then exit;
FThreadChanged := True;
Result := ExecuteCommand('-thread-select %d', [t], R);
FTheDebugger.FInternalThreadId := t;
Result := Result and (R.State <> dsError);
FContext.ThreadContext := ccUseLocal;
FContext.ThreadId := FCallstack.ThreadId;
end;
procedure TGDBMIDebuggerCommandStack.UnSelectThread;
var
R: TGDBMIExecResult;
begin
if not FThreadChanged then exit;
ExecuteCommand('-thread-select %d', [FTheDebugger.FCurrentThreadId], R);
FTheDebugger.FInternalThreadId := FTheDebugger.FCurrentThreadId;
FContext.ThreadContext := ccUseGlobal;
end;
constructor TGDBMIDebuggerCommandStack.Create(AOwner: TGDBMIDebugger;
@ -2711,11 +2719,16 @@ var
CmdRes: Boolean;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
// not supported yet
// ExecuteCommand('-exec-abort');
CmdRes := ExecuteCommand('kill', [], [], 1500); // Hardcoded timeout
FTheDebugger.FCurrentStackFrameValid := False;
FTheDebugger.FCurrentThreadIdValid := False;
if CmdRes
then CmdRes := ExecuteCommand('info program', R, [], 1500); // Hardcoded timeout
then CmdRes := ExecuteCommand('info program', R, [cfNoThreadContext], 1500); // Hardcoded timeout
if (not CmdRes)
or (Pos('not being run', R.Values) <= 0)
then begin
@ -2729,15 +2742,12 @@ end;
{ TGDBMIDebuggerCommandChangeThread }
function TGDBMIDebuggerCommandChangeThread.DoExecute: Boolean;
var
R: TGDBMIExecResult;
begin
Result := True;
FSuccess := ExecuteCommand('-thread-select %d', [FNewId], R);
if FSuccess then
FSuccess := R.State <> dsError;
FSuccess := True;
FTheDebugger.FCurrentThreadId := FNewId;
FTheDebugger.FInternalThreadId:= FNewId;
FTheDebugger.FCurrentThreadIdValid := True;
DebugLn(DBG_THREAD_AND_FRAME, ['TGDBMIDebuggerCommandChangeThread THREAD wanted ', FTheDebugger.FCurrentThreadId]);
end;
constructor TGDBMIDebuggerCommandChangeThread.Create(AOwner: TGDBMIDebugger; ANewId: Integer);
@ -2782,6 +2792,7 @@ begin
CurrentThreads.SetValidity(ddsValid);
CurrentThreads.CurrentThreadId := Cmd.CurrentThreadId;
Debugger.FCurrentThreadId := CurrentThreads.CurrentThreadId;
Debugger.FCurrentThreadIdValid := True;
end;
procedure TGDBMIThreads.DoChangeThreadsDestroyed(Sender: TObject);
@ -2927,6 +2938,8 @@ begin
*)
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
if not ExecuteCommand('-thread-info', R)
then exit;
@ -2936,10 +2949,14 @@ begin
ArgList := TGDBMINameValueList.Create;
try
FCurrentThreadId := StrToIntDef(List.Values['current-thread-id'], -1);
FTheDebugger.FInternalThreadId := FTheDebugger.FCurrentThreadId;
if FCurrentThreadId < 0 then exit;
FSuccess := True;
// update queue if needed // clear current stackframe
if FTheDebugger.FInstructionQueue.CurrentThreadId <> FCurrentThreadId then
FTheDebugger.FInstructionQueue.SetKnownThread(FCurrentThreadId);
List.SetPath('threads');
SetLength(FThreads, List.Count);
for i := 0 to List.Count - 1 do begin
@ -3010,6 +3027,8 @@ var
n, idx: Integer;
begin
Result := True;
FContext.StackContext := ccNotRequired;
if length(FModifiedToUpdate) = 0
then exit;
@ -4342,6 +4361,8 @@ var
RngBefore, RngAfter: TDBGDisassemblerEntryRange;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
if FEndAddr < FStartAddr
then FEndAddr := FStartAddr;
@ -5024,6 +5045,8 @@ begin
// Caller will never Release it. So TGDBMIDebuggerCommandStartDebugging must do this
FContinueCommand := AContinueCommand;
FSuccess := False;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
end;
destructor TGDBMIDebuggerCommandStartDebugging.Destroy;
@ -5193,6 +5216,8 @@ begin
inherited Create(AOwner);
FSuccess := False;
FProcessID := AProcessID;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
end;
function TGDBMIDebuggerCommandAttach.DebugText: String;
@ -5207,6 +5232,9 @@ var
R: TGDBMIExecResult;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
if not ExecuteCommand('detach', R) then
R.State := dsError;
if R.State = dsError then begin
@ -5260,9 +5288,7 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
i := FindStackFrame(Fp, 0, cnt);
if i >= 0 then begin
FTheDebugger.FCurrentStackFrame := i;
end
else begin
ExecuteCommand('-stack-select-frame %u', [FTheDebugger.FCurrentStackFrame], R);
DebugLn(DBG_THREAD_AND_FRAME, ['ProcessStopped GetLocation found fp Stack(Internal) = ', FTheDebugger.FCurrentStackFrame]);
end;
if FTheDebugger.FCurrentStackFrame <> 0
@ -5276,7 +5302,6 @@ function TGDBMIDebuggerCommandExecute.ProcessStopped(const AParams: String;
Result.FuncName := FTheDebugger.FCurrentLocation.FuncName;
Result.SrcLine := FTheDebugger.FCurrentLocation.SrcLine;
end;
FTheDebugger.FInternalStackFrame := FTheDebugger.FCurrentStackFrame;
end;
if (Result.SrcLine = -1) or (Result.SrcFile = '') then begin
@ -5610,9 +5635,11 @@ begin
List2 := nil;
FTheDebugger.FCurrentStackFrame := 0;
FTheDebugger.FInternalStackFrame := 0;
FTheDebugger.FCurrentThreadId := StrToIntDef(List.Values['thread-id'], -1);
FTheDebugger.FInternalThreadId := FTheDebugger.FCurrentThreadId;
FTheDebugger.FCurrentThreadIdValid := True;
FTheDebugger.FCurrentStackFrameValid := True;
FTheDebugger.FInstructionQueue.SetKnownThreadAndFrame(FTheDebugger.FCurrentThreadId, 0);
FTheDebugger.FCurrentLocation.Address := 0;
FTheDebugger.FCurrentLocation.SrcFile := '';
FTheDebugger.FCurrentLocation.SrcFullName := '';
@ -5747,7 +5774,7 @@ var
n, ID1, ID2: Integer;
begin
Result := False;
if not ExecuteCommand('info program', R)
if not ExecuteCommand('info program', R, [cfNoThreadContext])
then exit;
S := GetPart(['.0x'], ['.'], R.Values, True, False); // From the line "using child thread"
if PtrInt(StrToQWordDef('$'+S, 0)) <> FTheDebugger.FPauseRequestInThreadID
@ -5771,9 +5798,10 @@ begin
List.Free;
end;
Result := ExecuteCommand('-thread-select %d', [ID2], []);
Result := True; // ExecuteCommand('-thread-select %d', [ID2], []);
FTheDebugger.FCurrentThreadId := ID2;
FTheDebugger.FInternalThreadId := FTheDebugger.FCurrentThreadId;
FTheDebugger.FCurrentThreadIdValid := True;
DebugLn(DBG_THREAD_AND_FRAME, ['FixThreadForSigTrap Thread(Internal) = ', FTheDebugger.FCurrentThreadId]);
end;
{$ENDIF}
@ -5937,7 +5965,7 @@ const
List := TGDBMINameValueList.Create('');
try
repeat
if not ExecuteCommand('-stack-list-frames %d %d', [Result, Result], R)
if not ExecuteCommand('-stack-list-frames %d %d', [Result, Result], R, [cfNoStackContext])
or (R.State = dsError)
then begin
Result := -1;
@ -6024,9 +6052,9 @@ var
if i > 0
then begin
// must use none gdbmi commands
if (not ExecuteCommand('frame %d', [i], R)) or (R.State = dsError)
if (not ExecuteCommand('frame %d', [i], R, [cfNoStackContext])) or (R.State = dsError)
then i := -3; // error to user
if (i < 0) or (not ExecuteCommand('break', [i], R)) or (R.State = dsError)
if (i < 0) or (not ExecuteCommand('break', [i], R, [cfNoStackContext])) or (R.State = dsError)
then i := -3; // error to user
FStepBreakPoint := StrToIntDef(GetPart(['Breakpoint '], [' at '], R.Values), -1);
@ -6086,6 +6114,8 @@ begin
(FExecType in [ectStepOver, ectStepInto, ectStepOut, ectStepOverInstruction, ectStepIntoInstruction])
then FP := GetPtrValue('$fp', []);
FTheDebugger.FCurrentStackFrameValid := False;
FTheDebugger.FCurrentThreadIdValid := False;
FTheDebugger.FCurrentCmdIsAsync := False;
s := GDBMIExecCommandMap[FCurrentExecCmd] + FCurrentExecArg;
AFlags := [];
@ -6205,6 +6235,9 @@ var
Src: String;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
ExecuteCommand('-symbol-list-lines %s', [FSource], FResult);
if (FResult.State = dsError) and not(dcsCanceled in SeenStates)
@ -6242,6 +6275,8 @@ var
n, idx: Integer;
begin
Result := True;
FContext.StackContext := ccNotRequired;
if length(FRegistersToUpdate) = 0
then exit;
@ -6294,6 +6329,9 @@ var
n: Integer;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
ExecuteCommand('-data-list-register-names', R);
if R.State = dsError then Exit;
@ -6318,6 +6356,8 @@ var
i, cnt: longint;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
FDepth := -1;
try
if not SelectThread then exit;
@ -6495,7 +6535,7 @@ func="??"
i, lvl : Integer;
ResultList, SubList: TGDBMINameValueList;
begin
ExecuteCommand(ACmd, [AStart, AStop], R);
ExecuteCommand(ACmd, [AStart, AStop], R, [cfNoStackContext]);
if R.State = dsError
then begin
@ -6568,6 +6608,7 @@ var
StartIdx, EndIdx: Integer;
begin
Result := True;
FContext.StackContext := ccNotRequired;
if (FCallstack = nil) or (dcsCanceled in SeenStates) then exit;
It := TMapIterator.Create(FCallstack.RawEntries);
@ -6902,6 +6943,8 @@ var
Cmd: TGDBMIDebuggerCommandChangeFilename;
begin
Result := False;
FCurrentStackFrameValid := False; // not running => not valid
FCurrentThreadIdValid := False;
S := ConvertToGDBPath(UTF8ToSys(FileName), cgptExeName);
Cmd := TGDBMIDebuggerCommandChangeFilename.Create(Self, S);
@ -7055,6 +7098,8 @@ begin
FCurrentCommand.KillNow;
if (State = dsRun) then GDBPause(True);
// fire and forget. Donst wait on the queue.
FCurrentStackFrameValid := False;
FCurrentThreadIdValid := False;
SendCmdLn('kill');
SendCmdLn('-gdb-exit');
end;
@ -7109,6 +7154,8 @@ begin
else CancelAfterStop;
end;
if (State = dsError) and (DebugProcessRunning) then begin
FCurrentStackFrameValid := False;
FCurrentThreadIdValid := False;
SendCmdLn('kill'); // try to kill the debugged process. bypass all queues.
DebugProcess.Terminate(0);
end;
@ -7699,10 +7746,10 @@ begin
if ASet then
begin
S := EscapeGDBCommand(AVariable);
ExecuteCommand('-gdb-set env %s', [S], [cfscIgnoreState]);
ExecuteCommand('-gdb-set env %s', [S], [cfscIgnoreState, cfNoThreadContext]);
end else begin
S := AVariable;
ExecuteCommand('unset env %s', [GetPart([], ['='], S, False, False)], [cfscIgnoreState]);
ExecuteCommand('unset env %s', [GetPart([], ['='], S, False, False)], [cfscIgnoreState, cfNoThreadContext]);
end;
end;
@ -7863,13 +7910,13 @@ begin
Exit;
end;
Result := ExecuteCommand('-symbol-list-lines %s', [ASource], [cfscIgnoreError], R)
Result := ExecuteCommand('-symbol-list-lines %s', [ASource], [cfscIgnoreError, cfNoThreadContext], R)
and (R.State <> dsError);
// if we have an .inc file then search for filename only since there are some
// problems with locating file by full path in gdb in case only relative file
// name is stored
if not Result then
Result := ExecuteCommand('-symbol-list-lines %s', [ExtractFileName(ASource)], [cfscIgnoreError], R)
Result := ExecuteCommand('-symbol-list-lines %s', [ExtractFileName(ASource)], [cfscIgnoreError, cfNoThreadContext], R)
and (R.State <> dsError);
if not Result then Exit;
@ -8160,8 +8207,8 @@ begin
//if FAsyncModeEnabled then begin
if FCurrentCmdIsAsync and (FCurrentCommand <> nil) then begin
FCurrentCommand.ExecuteCommand('interrupt', []);
FCurrentCommand.ExecuteCommand('info program', []); // trigger "*stopped..." msg. This may be deferred to the cmd after the "interupt"
FCurrentCommand.ExecuteCommand('interrupt', [cfNoThreadContext]);
FCurrentCommand.ExecuteCommand('info program', [cfNoThreadContext]); // trigger "*stopped..." msg. This may be deferred to the cmd after the "interupt"
exit;
end;
@ -8467,6 +8514,8 @@ var
Cmd: TGDBMIDebuggerCommandStartDebugging;
begin
// We expect to be run immediately, no queue
FCurrentStackFrameValid := False;
FCurrentThreadIdValid := False;
Cmd := CreateCommandStartDebugging(AContinueCommand);
Cmd.AddReference;
QueueCommand(Cmd);
@ -8633,6 +8682,9 @@ end;
function TGDBMIDebuggerCommandBreakInsert.DoExecute: Boolean;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
FValid := False;
DefaultTimeOut := DebuggerProperties.TimeoutForEval;
try
@ -8716,6 +8768,9 @@ end;
function TGDBMIDebuggerCommandBreakRemove.DoExecute: Boolean;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
DefaultTimeOut := DebuggerProperties.TimeoutForEval;
try
ExecBreakDelete(FBreakId);
@ -8741,6 +8796,9 @@ end;
function TGDBMIDebuggerCommandBreakUpdate.DoExecute: Boolean;
begin
Result := True;
FContext.ThreadContext := ccNotRequired;
FContext.StackContext := ccNotRequired;
DefaultTimeOut := DebuggerProperties.TimeoutForEval;
try
if FUpdateExpression
@ -9247,7 +9305,7 @@ begin
FLocals.Clear;
// args
ExecuteCommand('-stack-list-arguments 1 %0:d %0:d',
[FTheDebugger.FCurrentStackFrame], R);
[FTheDebugger.FCurrentStackFrame], R, [cfNoStackContext]);
if R.State <> dsError
then begin
List := TGDBMINameValueList.Create(R, ['stack-args', 'frame']);
@ -9833,7 +9891,6 @@ begin
end;
TGDBMIDebugger(Debugger).FCurrentStackFrame := 0;
TGDBMIDebugger(Debugger).FInternalStackFrame := 0;
tid := Debugger.Threads.Monitor.CurrentThreads.CurrentThreadId;
cs := TCurrentCallStack(CurrentCallStackList.EntriesForThreads[tid]);
idx := cs.CurrentIndex; // CURRENT
@ -9958,6 +10015,43 @@ begin
Result := @FTheDebugger.FTargetInfo;
end;
function TGDBMIDebuggerCommand.ContextThreadId: Integer;
begin
if FContext.ThreadContext = ccUseGlobal then
Result := FTheDebugger.FCurrentThreadId
else
Result := FContext.ThreadId;
end;
function TGDBMIDebuggerCommand.ContextStackFrame: Integer;
begin
if FContext.StackContext = ccUseGlobal then
Result := FTheDebugger.FCurrentStackFrame
else
Result := FContext.StackFrame;
end;
procedure TGDBMIDebuggerCommand.CopyGlobalContextToLocal;
begin
if FContext.ThreadContext = ccUseGlobal then begin
if FTheDebugger.FCurrentThreadIdValid then begin
FContext.ThreadContext := ccUseLocal;
FContext.ThreadId := FTheDebugger.FCurrentThreadId
end
else
debugln(DBG_VERBOSE, ['CopyGlobalContextToLocal: FAILED thread, global data is not valid']);
end;
if FContext.StackContext = ccUseGlobal then begin
if FTheDebugger.FCurrentStackFrameValid then begin
FContext.StackContext := ccUseLocal;
FContext.StackFrame := FTheDebugger.FCurrentStackFrame;
end
else
debugln(DBG_VERBOSE, ['CopyGlobalContextToLocal: FAILED stackframe, global data is not valid']);
end;
end;
procedure TGDBMIDebuggerCommand.SetDebuggerState(const AValue: TDBGState);
begin
FTheDebugger.SetState(AValue);
@ -10075,7 +10169,19 @@ begin
then ATimeOut := DefaultTimeOut;
try
Instr := TGDBMIDebuggerInstruction.Create(ACommand, [], ATimeOut);
if (cfNoThreadContext in AFlags) or (FContext.ThreadContext = ccNotRequired) or
((FContext.ThreadContext = ccUseGlobal) and (not FTheDebugger.FCurrentThreadIdValid))
then
Instr := TGDBMIDebuggerInstruction.Create(ACommand, [], ATimeOut)
else
if (cfNoStackContext in AFlags) or (FContext.StackContext = ccNotRequired) or
((FContext.StackContext = ccUseGlobal) and (not FTheDebugger.FCurrentStackFrameValid))
then
Instr := TGDBMIDebuggerInstruction.Create(ACommand, ContextThreadId, [], ATimeOut)
else
Instr := TGDBMIDebuggerInstruction.Create(ACommand, ContextThreadId,
ContextStackFrame, [], ATimeOut);
Instr.AddReference;
Instr.Cmd := Self;
FTheDebugger.FInstructionQueue.RunInstruction(Instr);
@ -10097,7 +10203,7 @@ begin
DoTimeoutFeedback;
end;
finally
Instr.Free;
Instr.ReleaseReference;
end;
if not Result
@ -10349,9 +10455,9 @@ var
List: TGDBMINameValueList;
begin
Result := -1;
if (MaxDepth < 0) and (not ExecuteCommand('-stack-info-depth', R))
if (MaxDepth < 0) and (not ExecuteCommand('-stack-info-depth', R, [cfNoStackContext]))
then exit;
if (MaxDepth >= 0) and (not ExecuteCommand('-stack-info-depth %d', [MaxDepth], R))
if (MaxDepth >= 0) and (not ExecuteCommand('-stack-info-depth %d', [MaxDepth], R, [cfNoStackContext]))
then exit;
if R.State = dsError
then exit;
@ -10367,6 +10473,7 @@ var
R: TGDBMIExecResult;
List: TGDBMINameValueList;
Cur, Prv: QWord;
CurContext: TGDBMICommandContext;
begin
// Result;
// -1 : Not found
@ -10375,13 +10482,10 @@ begin
Cur := 0;
List := TGDBMINameValueList.Create('');
try
CurContext := FContext;
FContext.StackContext := ccUseLocal;
repeat
if not ExecuteCommand('-stack-select-frame %u', [Result], R)
or (R.State = dsError)
then begin
Result := -1;
break;
end;
FContext.StackFrame := Result;
if not ExecuteCommand('-data-evaluate-expression $fp', R)
or (R.State = dsError)
@ -10422,6 +10526,7 @@ begin
Result := -1;
finally
List.Free;
FContext := CurContext;
end;
end;
@ -10431,7 +10536,7 @@ var
List: TGDBMINameValueList;
begin
Result := '';
if ExecuteCommand('-stack-list-frames %d %d', [AIndex, AIndex], R)
if ExecuteCommand('-stack-list-frames %d %d', [AIndex, AIndex], R, [cfNoStackContext])
then begin
List := TGDBMINameValueList.Create(R, ['stack']);
Result := List.Values['frame'];
@ -10609,11 +10714,10 @@ begin
exit;
end;
i := FTheDebugger.FTypeRequestCache.IndexOf
(FTheDebugger.FInternalThreadId, FTheDebugger.FInternalStackFrame, AReq^);
i := FTheDebugger.FTypeRequestCache.IndexOf(ContextThreadId, ContextStackFrame, AReq^);
if i >= 0 then begin
debugln(DBGMI_QUEUE_DEBUG, ['DBG TypeRequest-Cache: Found entry for T=', FTheDebugger.FInternalThreadId,
' F=', FTheDebugger.FInternalStackFrame, ' R="', AReq^.Request,'"']);
debugln(DBGMI_QUEUE_DEBUG, ['DBG TypeRequest-Cache: Found entry for T=', ContextThreadId,
' F=', ContextStackFrame, ' R="', AReq^.Request,'"']);
CReq := FTheDebugger.FTypeRequestCache.Request[i];
AReq^.Result := CReq.Result;
AReq^.Error := CReq.Error;
@ -10633,8 +10737,7 @@ begin
AReq^.Error := R.Values;
end;
FTheDebugger.FTypeRequestCache.Add
(FTheDebugger.FInternalThreadId, FTheDebugger.FInternalStackFrame, AReq^);
FTheDebugger.FTypeRequestCache.Add(ContextThreadId, ContextStackFrame, AReq^);
end;
AReq := AReq^.Next;
@ -10870,6 +10973,8 @@ begin
FQueueRunLevel := -1;
FState := dcsNone;
FTheDebugger := AOwner;
FContext.StackContext := ccUseGlobal;
FContext.ThreadContext := ccUseGlobal;
FDefaultTimeOut := -1;
FPriority := 0;
FProperties := [];
@ -11223,7 +11328,7 @@ end;
function TGDBMIDebuggerSimpleCommand.DoExecute: Boolean;
begin
Result := True;
if not ExecuteCommand(FCommand, FResult)
if not ExecuteCommand(FCommand, FResult, FFlags)
then exit;
if (FResult.State <> dsNone)
@ -11691,17 +11796,14 @@ var
R: TGDBMIExecResult;
List: TGDBMINameValueList;
ParentFp, Fp, LastFp: String;
i, j, ThreadId: Integer;
i, j: Integer;
FrameCache: PGDBMIDebuggerParentFrameCache;
ParentFpNum, FpNum, FpDiff, LastFpDiff: QWord;
FpDir: Integer;
begin
Result := False;
CurPFPListChangeStamp := TGDBMIWatches(FTheDebugger.Watches).ParentFPListChangeStamp;
if FWatchValue <> nil
then ThreadId := FWatchValue.ThreadId
else ThreadId := FTheDebugger.FCurrentThreadId;
FrameCache := TGDBMIWatches(FTheDebugger.Watches).GetParentFPList(ThreadId);
FrameCache := TGDBMIWatches(FTheDebugger.Watches).GetParentFPList(ContextThreadId);
List := nil;
try
@ -11758,16 +11860,8 @@ var
end;
if (Fp = '') or (Fp = ParentFP) then begin
if not ExecuteCommand('-stack-select-frame %u', [aFrameIdx], R)
or (R.State = dsError)
then begin
FrameCache^.ParentFPList[aFrameIdx].Fp := '-'; // mark as no Fp (not accesible)
Exit(False);
end;
if not ParentSearchCanContinue then
exit;
FStackFrameChanged := True; // Force UnSelectContext() to restore current frame
FTheDebugger.FInternalStackFrame := aFrameIdx;
FContext.StackContext := ccUseLocal;
FContext.StackFrame := aFrameIdx;
if (Fp = '') then begin
if not ExecuteCommand('-data-evaluate-expression $fp', R)
@ -12407,11 +12501,7 @@ var
frameidx: Integer;
{$IFDEF DBG_WITH_GDB_WATCHES} R: TGDBMIExecResult; {$ENDIF}
begin
if not SelectContext then begin
FTextValue:='<Error>';
FValidity := ddsError;
exit;
end;
SelectContext;
try
FTextValue:='';
FTypeInfo:=nil;
@ -12448,7 +12538,7 @@ begin
ResultList := TGDBMINameValueList.Create('');
// keep the internal stackframe => same as requested by watch
frameidx := TGDBMIDebugger(FTheDebugger).FInternalStackFrame;
frameidx := ContextStackFrame;
DefaultTimeOut := DebuggerProperties.TimeoutForEval;
try
repeat
@ -12475,43 +12565,24 @@ begin
end;
function TGDBMIDebuggerCommandEvaluate.SelectContext: Boolean;
var
R: TGDBMIExecResult;
t, f: Integer;
begin
Result := True;
FThreadChanged := False;
FStackFrameChanged := False;
if FWatchValue = nil then exit;
t := FWatchValue.ThreadId;
f := FWatchValue.StackFrame;
if t <> FTheDebugger.FCurrentThreadId then begin
FThreadChanged := True;
Result := ExecuteCommand('-thread-select %d', [t], R);
FTheDebugger.FInternalThreadId := t;
Result := Result and (R.State <> dsError);
if FWatchValue = nil then begin
CopyGlobalContextToLocal;
exit;
end;
if not Result then exit;
if (f <> FTheDebugger.FCurrentStackFrame) or FThreadChanged then begin
FStackFrameChanged := True;
Result := ExecuteCommand('-stack-select-frame %d', [f], R);
FTheDebugger.FInternalStackFrame := f;
Result := Result and (R.State <> dsError);
end;
FContext.ThreadContext := ccUseLocal;
FContext.ThreadId := FWatchValue.ThreadId;
FContext.StackContext := ccUseLocal;
FContext.StackFrame := FWatchValue.StackFrame;
end;
procedure TGDBMIDebuggerCommandEvaluate.UnSelectContext;
var
R: TGDBMIExecResult;
begin
if FThreadChanged
then ExecuteCommand('-thread-select %d', [FTheDebugger.FCurrentThreadId], R);
FTheDebugger.FInternalThreadId := FTheDebugger.FCurrentThreadId;
if FStackFrameChanged
then ExecuteCommand('-stack-select-frame %d', [FTheDebugger.FCurrentStackFrame], R);
FTheDebugger.FInternalStackFrame := FTheDebugger.FCurrentStackFrame;
FContext.ThreadContext := ccUseGlobal;
FContext.StackContext := ccUseGlobal;
end;
constructor TGDBMIDebuggerCommandEvaluate.Create(AOwner: TGDBMIDebugger; AExpression: String;
@ -12560,5 +12631,6 @@ initialization
DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
DBG_WARNINGS := DebugLogger.FindOrRegisterLogGroup('DBG_WARNINGS' {$IFDEF DBG_WARNINGS} , True {$ENDIF} );
DBG_DISASSEMBLER := DebugLogger.FindOrRegisterLogGroup('DBG_DISASSEMBLER' {$IFDEF DBG_DISASSEMBLER} , True {$ENDIF} );
DBG_THREAD_AND_FRAME := DebugLogger.FindOrRegisterLogGroup('DBG_THREAD_AND_FRAME' {$IFDEF DBG_THREAD_AND_FRAME} , True {$ENDIF} );
end.

780
debugger/gdbmidebuginstructions.pp
View File

@ -5,7 +5,7 @@ unit GDBMIDebugInstructions;
interface
uses
Classes, SysUtils, math, CmdLineDebugger, GDBMIMiscClasses, LazLoggerBase;
Classes, SysUtils, math, CmdLineDebugger, GDBMIMiscClasses, LazLoggerBase, LazClasses;
type
@ -21,7 +21,6 @@ type
{ TGDBInstruction }
TGDBInstructionFlag = (
ifAutoDestroy,
ifRequiresThread,
ifRequiresStackFrame
);
@ -34,11 +33,14 @@ type
TGDBInstructionResultFlags = set of TGDBInstructionResultFlag;
TGDBInstructionErrorFlag = (
ifeContentError,
ifeWriteError,
ifeReadError,
ifeGdbNotRunning,
ifeTimedOut,
ifeRecoveredTimedOut
ifeRecoveredTimedOut,
ifeInvalidStackFrame,
ifeInvalidThreadId
);
TGDBInstructionErrorFlags = set of TGDBInstructionErrorFlag;
@ -46,7 +48,7 @@ type
{ TGDBInstruction }
TGDBInstruction = class
TGDBInstruction = class(TRefCountedObject)
private
FCommand: String;
FFlags: TGDBInstructionFlags;
@ -66,8 +68,11 @@ type
procedure HandleTimeOut; virtual;
procedure HandleRecoveredTimeOut; virtual;
procedure HandleNoGdbRunning; virtual;
procedure HandleContentError; virtual;
procedure HandleError(AnError: TGDBInstructionErrorFlag; AMarkAsFailed: Boolean = True); virtual;
function GetTimeOutVerifier: TGDBInstruction; virtual;
function DebugText: String;
procedure Init; virtual;
procedure InternalCreate(ACommand: String;
AThread, AFrame: Integer; // ifRequiresThread, ifRequiresStackFrame will always be included
@ -125,11 +130,46 @@ type
procedure HandleTimeOut; override;
procedure HandleNoGdbRunning; override;
function GetTimeOutVerifier: TGDBInstruction; override;
function DebugText: String;
public
constructor Create(ARunnigInstruction: TGDBInstruction);
destructor Destroy; override;
end;
{ TGDBInstructionChangeThread }
TGDBInstructionChangeThread = class(TGDBInstruction)
private
FSelThreadId: Integer;
FQueue: TGDBInstructionQueue;
FDone: Boolean;
protected
procedure SendCommandDataToGDB(AQueue: TGDBInstructionQueue); override;
function ProcessInputFromGdb(const AData: String): Boolean; override;
procedure HandleError(AnError: TGDBInstructionErrorFlag; AMarkAsFailed: Boolean = True);
override;
function DebugText: String;
public
constructor Create(AQueue: TGDBInstructionQueue; AThreadId: Integer);
end;
{ TGDBInstructionChangeStackFrame }
TGDBInstructionChangeStackFrame = class(TGDBInstruction)
private
FSelStackFrame: Integer;
FQueue: TGDBInstructionQueue;
FDone: Boolean;
protected
procedure SendCommandDataToGDB(AQueue: TGDBInstructionQueue); override;
function ProcessInputFromGdb(const AData: String): Boolean; override;
procedure HandleError(AnError: TGDBInstructionErrorFlag; AMarkAsFailed: Boolean = True);
override;
function DebugText: String;
public
constructor Create(AQueue: TGDBInstructionQueue; AFrame: Integer);
end;
{ TGDBInstructionQueue }
TGDBInstructionQueueFlag = (
@ -142,35 +182,49 @@ type
private
FCurrentInstruction: TGDBInstruction;
FCurrentStackFrame: Integer;
FCurrunetThreadId: Integer;
FCurrentThreadId: Integer;
FDebugger: TGDBMICmdLineDebugger;
FFlags: TGDBInstructionQueueFlags;
procedure ExecuteCurrentInstruction;
procedure FinishCurrentInstruction;
procedure SetCurrentInstruction(AnInstruction: TGDBInstruction);
function HasCorrectThreadIdFor(AnInstruction: TGDBInstruction): Boolean;
function HasCorrectFrameFor(AnInstruction: TGDBInstruction): Boolean;
protected
function SendDataToGDB(ASender: TGDBInstruction; AData: String): Boolean;
//function ReadDataFromGDB(ASender: TGDBInstruction; AData: String): Boolean;
procedure SelectThread(AThreadId: Integer);
procedure SelectFrame(AFrame: Integer);
function SendDataToGDB(ASender: TGDBInstruction; AData: String; const AValues: array of const): Boolean;
procedure HandleGdbDataBeforeInstruction(var AData: String; var SkipData: Boolean;
const TheInstruction: TGDBInstruction); virtual;
procedure HandleGdbDataAfterInstruction(var AData: String; const Handled: Boolean;
const TheInstruction: TGDBInstruction); virtual;
function GetSelectThreadInstruction(AThreadId: Integer): TGDBInstruction; virtual;
function GetSelectFrameInstruction(AFrame: Integer): TGDBInstruction; virtual;
public
constructor Create(ADebugger: TGDBMICmdLineDebugger);
procedure InvalidateThredAndFrame;
procedure InvalidateThredAndFrame(AStackFrameOnly: Boolean = False);
procedure SetKnownThread(AThread: Integer);
procedure SetKnownThreadAndFrame(AThread, AFrame: Integer);
procedure RunInstruction(AnInstruction: TGDBInstruction); // Wait for instruction to be finished, not queuing
property CurrunetThreadId: Integer read FCurrunetThreadId;
property CurrentThreadId: Integer read FCurrentThreadId;
property CurrentStackFrame: Integer read FCurrentStackFrame;
property Flags: TGDBInstructionQueueFlags read FFlags;
end;
function dbgs(AState: TGDBInstructionVerifyTimeOutState): String; overload;
function dbgs(AFlag: TGDBInstructionQueueFlag): String; overload;
function dbgs(AFlags: TGDBInstructionQueueFlags): String; overload;
function dbgs(AFlag: TGDBInstructionFlag): String; overload;
function dbgs(AFlags: TGDBInstructionFlags): String; overload;
implementation
var
DBGMI_TIMEOUT_DEBUG: PLazLoggerLogGroup;
DBGMI_TIMEOUT_DEBUG, DBG_THREAD_AND_FRAME, DBG_VERBOSE: PLazLoggerLogGroup;
const
TIMEOUT_AFTER_WRITE_ERROR = 50;
TIMEOUT_FOR_QUEUE_INSTR = 50; // select thread/frame
TIMEOUT_FOR_SYNC_AFTER_TIMEOUT = 2500; // extra timeout, while trying to recover from a suspected timeout
TIMEOUT_FOR_SYNC_AFTER_TIMEOUT_MAX = 3000; // upper limit, when using 2*original_timeout
@ -179,185 +233,44 @@ begin
writestr(Result{%H-}, AState);
end;
{ TGDBInstructionVerifyTimeOut }
procedure TGDBInstructionVerifyTimeOut.SendCommandDataToGDB(AQueue: TGDBInstructionQueue);
function dbgs(AFlag: TGDBInstructionQueueFlag): String;
begin
AQueue.SendDataToGDB(Self, '-data-evaluate-expression 7');
AQueue.SendDataToGDB(Self, '-data-evaluate-expression 1');
FState := vtSent;
writestr(Result{%H-}, AFlag);
end;
function TGDBInstructionVerifyTimeOut.ProcessInputFromGdb(const AData: String): Boolean;
type
TLineDataTipe = (ldOther, ldGdb, ldValue7, ldValue1);
function CheckData(const ALineData: String): TLineDataTipe;
begin
Result := ldOther;
if ALineData= '(gdb) ' then begin
Result := ldGdb;
exit;
end;
if copy(AData, 1, 6) = '^done,' then begin
if FList = nil then
FList := TGDBMINameValueList.Create(ALineData)
else
FList.Init(ALineData);
if FList.Values['value'] = '7' then
Result := ldValue7
else
if FList.Values['value'] = '1' then
Result := ldValue1
end;
end;
procedure SetError(APromptCount: Integer);
begin
FState := vtError;
FPromptAfterErrorCount := APromptCount; // prompt for val7 and val1 needed
FRunnigInstruction.HandleTimeOut;
if FPromptAfterErrorCount <= 0 then
FTimeOut := 50; // wait for timeout
end;
begin
if FState = vtError then begin
dec(FPromptAfterErrorCount);
if FPromptAfterErrorCount <= 0 then
FTimeOut := 50; // wait for timeout
exit;
end;
case CheckData(AData) of
ldOther: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got other data']);
FRunnigInstruction.ProcessInputFromGdb(AData);
end;
ldGdb:
case FState of
vtSent: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got prompt in order']);
FState := vtGotPrompt;
FRunnigInstruction.ProcessInputFromGdb(AData);
if not FRunnigInstruction.IsCompleted then begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Prompt was not accepted']);
SetError(2); // prompt for val=7 and val=1 needed
end;
end;
vtGotPrompt7: FState := vtGotPrompt7gdb;
vtGotPrompt7and7: FState := vtGotPrompt7and7gdb;
vtGotPrompt1: FState := vtGotPrompt1gdb;
vtGot7: FState := vtGot7gdb;
vtGot7and7: FState := vtGot7and7gdb;
vtGot1: FState := vtGot1gdb;
else begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Extra Prompt ']);
if FState = vtGotPrompt
then SetError(1) // prompt val=1 needed
else SetError(0); // no more prompt needed
end;
end;
ldValue7:
case FState of
vtSent, vtGotPrompt: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got value 7']);
FVal7Data := AData;
if FState = vtSent
then FState := vtGot7
else FState := vtGotPrompt7;
end;
vtGotPrompt7gdb, vtGot7gdb: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got value 7 twice. Original Result?']);
FRunnigInstruction.ProcessInputFromGdb(FVal7Data);
if FState = vtGotPrompt7gdb
then FState := vtGotPrompt7and7
else FState := vtGot7and7;
end;
else begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Extra VAlue 7']);
if FState in [vtGotPrompt7, vtGot7]
then SetError(1) // prompt val=1 needed
else SetError(0); // no more prompt needed
end;
end;
ldValue1:
case FState of
vtSent: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got other data']);
FRunnigInstruction.ProcessInputFromGdb(AData);
end;
vtGotPrompt7gdb: FState := vtGotPrompt1;
vtGotPrompt7and7gdb: FState := vtGotPrompt1;
vtGot7gdb: FState := vtGot1;
vtGot7and7gdb: FState := vtGot1;
else begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Wrong Value 1']);
SetError(0);
end;
end;
end;
if FState = vtGot1gdb then begin
// timeout, but recovored
FRunnigInstruction.ProcessInputFromGdb('(gdb) '); // simulate prompt
FRunnigInstruction.HandleRecoveredTimeOut;
end;
if FState in [vtGot1gdb, vtGotPrompt1gdb] then begin
Include(FResultFlags, ifrComleted);
if not FRunnigInstruction.IsCompleted then
FRunnigInstruction.HandleTimeOut;
end;
end;
procedure TGDBInstructionVerifyTimeOut.HandleWriteError(ASender: TGDBInstruction);
begin
inherited HandleWriteError(ASender);
FRunnigInstruction.HandleWriteError(ASender);
end;
procedure TGDBInstructionVerifyTimeOut.HandleReadError;
begin
inherited HandleReadError;
FRunnigInstruction.HandleReadError;
end;
procedure TGDBInstructionVerifyTimeOut.HandleTimeOut;
begin
inherited HandleTimeOut;
FRunnigInstruction.HandleTimeOut;
end;
procedure TGDBInstructionVerifyTimeOut.HandleNoGdbRunning;
begin
inherited HandleNoGdbRunning;
FRunnigInstruction.HandleNoGdbRunning;
end;
function TGDBInstructionVerifyTimeOut.GetTimeOutVerifier: TGDBInstruction;
begin
Result := nil;
end;
constructor TGDBInstructionVerifyTimeOut.Create(ARunnigInstruction: TGDBInstruction);
function dbgs(AFlags: TGDBInstructionQueueFlags): String;
var
t: Integer;
i: TGDBInstructionQueueFlag;
begin
FRunnigInstruction := ARunnigInstruction;
t := FRunnigInstruction.TimeOut;
t := max(TIMEOUT_FOR_SYNC_AFTER_TIMEOUT, Min(TIMEOUT_FOR_SYNC_AFTER_TIMEOUT_MAX, t * 2));
inherited Create('', FRunnigInstruction.ThreadId, FRunnigInstruction.StackFrame,
FRunnigInstruction.Flags * [ifRequiresThread, ifRequiresStackFrame] + [ifAutoDestroy],
t);
Result := '';
for i := low(TGDBInstructionQueueFlags) to high(TGDBInstructionQueueFlags) do
if i in AFlags then
if Result = '' then
Result := Result + dbgs(i)
else
Result := Result + ', ' +dbgs(i);
if Result <> '' then
Result := '[' + Result + ']';
end;
destructor TGDBInstructionVerifyTimeOut.Destroy;
function dbgs(AFlag: TGDBInstructionFlag): String;
begin
inherited Destroy;
FreeAndNil(FList);
if (FRunnigInstruction <> nil) and (ifAutoDestroy in FRunnigInstruction.Flags) then
FRunnigInstruction.Free;
writestr(Result{%H-}, AFlag);
end;
function dbgs(AFlags: TGDBInstructionFlags): String;
var
i: TGDBInstructionFlag;
begin
Result := '';
for i := low(TGDBInstructionFlags) to high(TGDBInstructionFlags) do
if i in AFlags then
if Result = '' then
Result := Result + dbgs(i)
else
Result := Result + ', ' +dbgs(i);
if Result <> '' then
Result := '[' + Result + ']';
end;
{ TGDBMICmdLineDebugger }
@ -395,22 +308,19 @@ end;
procedure TGDBInstruction.HandleWriteError(ASender: TGDBInstruction);
begin
//Include(FResultFlags, ifrFailed); // Do not fail yet
Include(FErrorFlags, ifeWriteError);
HandleError(ifeWriteError, False);
if (FTimeOut = 0) or (FTimeOut > TIMEOUT_AFTER_WRITE_ERROR) then
FTimeOut := TIMEOUT_AFTER_WRITE_ERROR;
end;
procedure TGDBInstruction.HandleReadError;
begin
Include(FResultFlags, ifrFailed);
Include(FErrorFlags, ifeReadError);
HandleError(ifeReadError, True);
end;
procedure TGDBInstruction.HandleTimeOut;
begin
Include(FResultFlags, ifrFailed);
Include(FErrorFlags, ifeTimedOut);
HandleError(ifeTimedOut, True);
end;
procedure TGDBInstruction.HandleRecoveredTimeOut;
@ -420,8 +330,20 @@ end;
procedure TGDBInstruction.HandleNoGdbRunning;
begin
HandleError(ifeGdbNotRunning, True);
end;
procedure TGDBInstruction.HandleContentError;
begin
HandleError(ifeContentError, True);
end;
procedure TGDBInstruction.HandleError(AnError: TGDBInstructionErrorFlag;
AMarkAsFailed: Boolean = True);
begin
if AMarkAsFailed then
Include(FResultFlags, ifrFailed);
Include(FErrorFlags, ifeGdbNotRunning);
Include(FErrorFlags, AnError);
end;
function TGDBInstruction.GetTimeOutVerifier: TGDBInstruction;
@ -432,6 +354,15 @@ begin
Result := TGDBInstructionVerifyTimeOut.Create(Self);
end;
function TGDBInstruction.DebugText: String;
begin
Result := ClassName + ': "' + FCommand + '", ' + dbgs(FFlags);
if ifRequiresThread in FFlags then
Result := Result + ' Thr=' + IntToStr(FThreadId);
if ifRequiresStackFrame in FFlags then
Result := Result + ' Frm=' + IntToStr(FStackFrame);
end;
procedure TGDBInstruction.Init;
begin
//
@ -475,13 +406,392 @@ begin
Result := ResultFlags * [ifrComleted, ifrFailed] = [ifrComleted]
end;
{ TGDBInstructionVerifyTimeOut }
procedure TGDBInstructionVerifyTimeOut.SendCommandDataToGDB(AQueue: TGDBInstructionQueue);
begin
AQueue.SendDataToGDB(Self, '-data-evaluate-expression 7');
AQueue.SendDataToGDB(Self, '-data-evaluate-expression 1');
FState := vtSent;
end;
function TGDBInstructionVerifyTimeOut.ProcessInputFromGdb(const AData: String): Boolean;
type
TLineDataTipe = (ldOther, ldGdb, ldValue7, ldValue1);
function CheckData(const ALineData: String): TLineDataTipe;
begin
Result := ldOther;
if ALineData= '(gdb) ' then begin
Result := ldGdb;
exit;
end;
if (copy(AData, 1, 6) = '^done,') or (AData = '^done') then begin
if FList = nil then
FList := TGDBMINameValueList.Create(ALineData)
else
FList.Init(ALineData);
if FList.Values['value'] = '7' then
Result := ldValue7
else
if FList.Values['value'] = '1' then
Result := ldValue1
end;
end;
procedure SetError(APromptCount: Integer);
begin
FState := vtError;
FPromptAfterErrorCount := APromptCount; // prompt for val7 and val1 needed
FRunnigInstruction.HandleTimeOut;
if FPromptAfterErrorCount <= 0 then
FTimeOut := 50; // wait for timeout
end;
begin
Result := True;
if FState = vtError then begin
dec(FPromptAfterErrorCount);
if FPromptAfterErrorCount <= 0 then
FTimeOut := 50; // wait for timeout
exit;
end;
case CheckData(AData) of
ldOther: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got other data']);
Result := FRunnigInstruction.ProcessInputFromGdb(AData);
end;
ldGdb:
case FState of
vtSent: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got prompt in order']);
FState := vtGotPrompt;
Result := FRunnigInstruction.ProcessInputFromGdb(AData);
if not FRunnigInstruction.IsCompleted then begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Prompt was not accepted']);
SetError(2); // prompt for val=7 and val=1 needed
end;
end;
vtGotPrompt7: FState := vtGotPrompt7gdb;
vtGotPrompt7and7: FState := vtGotPrompt7and7gdb;
vtGotPrompt1: FState := vtGotPrompt1gdb;
vtGot7: FState := vtGot7gdb;
vtGot7and7: FState := vtGot7and7gdb;
vtGot1: FState := vtGot1gdb;
else begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Extra Prompt ']);
if FState = vtGotPrompt
then SetError(1) // prompt val=1 needed
else SetError(0); // no more prompt needed
end;
end;
ldValue7:
case FState of
vtSent, vtGotPrompt: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got value 7']);
FVal7Data := AData;
if FState = vtSent
then FState := vtGot7
else FState := vtGotPrompt7;
end;
vtGotPrompt7gdb, vtGot7gdb: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got value 7 twice. Original Result?']);
Result := FRunnigInstruction.ProcessInputFromGdb(FVal7Data);
if FState = vtGotPrompt7gdb
then FState := vtGotPrompt7and7
else FState := vtGot7and7;
end;
else begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Extra VAlue 7']);
if FState in [vtGotPrompt7, vtGot7]
then SetError(1) // prompt val=1 needed
else SetError(0); // no more prompt needed
end;
end;
ldValue1:
case FState of
vtSent: begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Got other data']);
Result := FRunnigInstruction.ProcessInputFromGdb(AData);
end;
vtGotPrompt7gdb: FState := vtGotPrompt1;
vtGotPrompt7and7gdb: FState := vtGotPrompt1;
vtGot7gdb: FState := vtGot1;
vtGot7and7gdb: FState := vtGot1;
else begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Wrong Value 1']);
SetError(0);
end;
end;
end;
if FState = vtGot1gdb then begin
// timeout, but recovored
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): Recovered']);
FRunnigInstruction.ProcessInputFromGdb('(gdb) '); // simulate prompt
FRunnigInstruction.HandleRecoveredTimeOut;
end;
if FState in [vtGot1gdb, vtGotPrompt1gdb] then begin
debugln(DBGMI_TIMEOUT_DEBUG, ['GDBMI TimeOut(', dbgs(FState), '): All done: original Instruction completed=',dbgs(FRunnigInstruction.IsCompleted)]);
Include(FResultFlags, ifrComleted);
if not FRunnigInstruction.IsCompleted then
FRunnigInstruction.HandleTimeOut;
end;
end;
procedure TGDBInstructionVerifyTimeOut.HandleWriteError(ASender: TGDBInstruction);
begin
inherited HandleWriteError(ASender);
FRunnigInstruction.HandleWriteError(ASender);
end;
procedure TGDBInstructionVerifyTimeOut.HandleReadError;
begin
inherited HandleReadError;
FRunnigInstruction.HandleReadError;
end;
procedure TGDBInstructionVerifyTimeOut.HandleTimeOut;
begin
inherited HandleTimeOut;
FRunnigInstruction.HandleTimeOut;
end;
procedure TGDBInstructionVerifyTimeOut.HandleNoGdbRunning;
begin
inherited HandleNoGdbRunning;
FRunnigInstruction.HandleNoGdbRunning;
end;
function TGDBInstructionVerifyTimeOut.GetTimeOutVerifier: TGDBInstruction;
begin
Result := nil;
end;
function TGDBInstructionVerifyTimeOut.DebugText: String;
begin
Result := ClassName + ': for "' + FRunnigInstruction.DebugText;
end;
constructor TGDBInstructionVerifyTimeOut.Create(ARunnigInstruction: TGDBInstruction);
var
t: Integer;
begin
FRunnigInstruction := ARunnigInstruction;
FRunnigInstruction.AddReference;
t := FRunnigInstruction.TimeOut;
t := max(TIMEOUT_FOR_SYNC_AFTER_TIMEOUT, Min(TIMEOUT_FOR_SYNC_AFTER_TIMEOUT_MAX, t * 2));
inherited Create('', FRunnigInstruction.ThreadId, FRunnigInstruction.StackFrame,
FRunnigInstruction.Flags * [ifRequiresThread, ifRequiresStackFrame],
t);
end;
destructor TGDBInstructionVerifyTimeOut.Destroy;
begin
inherited Destroy;
FreeAndNil(FList);
if (FRunnigInstruction <> nil) then
FRunnigInstruction.ReleaseReference;
end;
{ TGDBInstructionChangeThread }
procedure TGDBInstructionChangeThread.SendCommandDataToGDB(AQueue: TGDBInstructionQueue);
begin
AQueue.SendDataToGDB(Self, '-thread-select %d', [FSelThreadId]);
end;
function TGDBInstructionChangeThread.ProcessInputFromGdb(const AData: String): Boolean;
begin
// "-thread-select 2"
// "^done,new-thread-id="2",frame={level="0",addr="0x7707878f",func="ntdll!DbgUiConvertStateChangeStructure",args=[],from="C:\\Windows\\system32\\ntdll.dll"}"
// "(gdb) "
Result := False;
if (copy(AData, 1, 6) = '^done,') or (AData = '^done') then begin
Result := True;
if FDone then
HandleContentError;
FDone := True;
end
else
if (AData = '(gdb) ') then begin
Result := True;
if not FDone then begin
HandleContentError;
end
else begin
MarkAsSuccess;
FQueue.FCurrentThreadId := FSelThreadId;
FQueue.FFlags := FQueue.FFlags + [ifqValidThread];
end;
end
else
begin
debugln(DBG_VERBOSE, ['GDBMI TGDBInstructionChangeThread ignoring: ', AData]);
end;
end;
procedure TGDBInstructionChangeThread.HandleError(AnError: TGDBInstructionErrorFlag;
AMarkAsFailed: Boolean);
begin
inherited HandleError(AnError, AMarkAsFailed);
FQueue.InvalidateThredAndFrame;
end;
function TGDBInstructionChangeThread.DebugText: String;
begin
Result := ClassName;
end;
constructor TGDBInstructionChangeThread.Create(AQueue: TGDBInstructionQueue;
AThreadId: Integer);
begin
inherited Create('', [], TIMEOUT_FOR_QUEUE_INSTR);
FQueue := AQueue;
FDone := False;
FSelThreadId := AThreadId;
end;
{ TGDBInstructionChangeStackFrame }
procedure TGDBInstructionChangeStackFrame.SendCommandDataToGDB(AQueue: TGDBInstructionQueue);
begin
AQueue.SendDataToGDB(Self, '-stack-select-frame %d', [FSelStackFrame]);
end;
function TGDBInstructionChangeStackFrame.ProcessInputFromGdb(const AData: String): Boolean;
begin
// "-stack-select-frame 0"
// "^done"
// "(gdb) "
//OR ^error => keep selected ?
Result := False;
if (copy(AData, 1, 6) = '^done,') or (AData = '^done') then begin
Result := True;
if FDone then
HandleContentError;
FDone := True;
end
else
if (AData = '(gdb) ') then begin
Result := True;
if not FDone then begin
HandleContentError;
end
else begin
MarkAsSuccess;
FQueue.FCurrentStackFrame := FSelStackFrame;
FQueue.FFlags := FQueue.FFlags + [ifqValidStackFrame];
end;
end
else
begin
debugln(DBG_VERBOSE, ['GDBMI TGDBInstructionChangeStackFrame ignoring: ', AData]);
end;
end;
procedure TGDBInstructionChangeStackFrame.HandleError(AnError: TGDBInstructionErrorFlag;
AMarkAsFailed: Boolean);
begin
inherited HandleError(AnError, AMarkAsFailed);
FQueue.InvalidateThredAndFrame(True);
end;
function TGDBInstructionChangeStackFrame.DebugText: String;
begin
Result := ClassName;
end;
constructor TGDBInstructionChangeStackFrame.Create(AQueue: TGDBInstructionQueue;
AFrame: Integer);
begin
inherited Create('', [], TIMEOUT_FOR_QUEUE_INSTR);
FQueue := AQueue;
FDone := False;
FSelStackFrame := AFrame;
end;
{ TGDBInstructionQueue }
procedure TGDBInstructionQueue.ExecuteCurrentInstruction;
var
ExeInstr, HelpInstr: TGDBInstruction;
begin
if FCurrentInstruction = nil then
exit;
ExeInstr := FCurrentInstruction;
ExeInstr.AddReference;
try
if not HasCorrectThreadIdFor(ExeInstr) then begin
HelpInstr := GetSelectThreadInstruction(ExeInstr.ThreadId);
DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Thread from: ', FCurrentThreadId, ' - ', dbgs(FFlags),
' to ', ExeInstr.ThreadId, ' using [', HelpInstr.DebugText, '] for [', ExeInstr.DebugText, ']']);
HelpInstr.AddReference;
try
FCurrentInstruction := HelpInstr;
FCurrentInstruction.SendCommandDataToGDB(Self);
FinishCurrentInstruction;
if not HelpInstr.IsSuccess then begin
DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Thread FAILED']);
ExeInstr.HandleError(ifeInvalidThreadId);
exit;
end;
finally
HelpInstr.ReleaseReference;
end;
end;
if not HasCorrectFrameFor(ExeInstr) then begin
HelpInstr := GetSelectFrameInstruction(ExeInstr.StackFrame);
DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Stack from: ', FCurrentStackFrame, ' - ', dbgs(FFlags),
' to ', ExeInstr.StackFrame, ' using [', HelpInstr.DebugText, '] for [', ExeInstr.DebugText, ']']);
HelpInstr.AddReference;
try
FCurrentInstruction := HelpInstr;
FCurrentInstruction.SendCommandDataToGDB(Self);
FinishCurrentInstruction;
if not HelpInstr.IsSuccess then begin
DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Changing Stackframe FAILED']);
ExeInstr.HandleError(ifeInvalidStackFrame);
exit;
end;
finally
HelpInstr.ReleaseReference;
end;
end;
finally
if ExeInstr.RefCount > 1 then
FCurrentInstruction := ExeInstr
else
FCurrentInstruction := nil;
ExeInstr.ReleaseReference;
end;
if FCurrentInstruction <> nil then
FCurrentInstruction.SendCommandDataToGDB(Self);
end;
procedure TGDBInstructionQueue.FinishCurrentInstruction;
var
S: String;
NewInstr: TGDBInstruction;
NewInstr, ExeInstr: TGDBInstruction;
Skip: Boolean;
Handled: Boolean;
begin
if FCurrentInstruction = nil then exit;
ExeInstr := FCurrentInstruction;
ExeInstr.AddReference;
try
while (FCurrentInstruction <> nil) and
(not FCurrentInstruction.IsCompleted)
do begin
@ -497,8 +807,16 @@ begin
// If a nested readline reads all data, then the outer will have nothing to return.
// TODO: need a flag, so the outer will immediately return empty.
// TODO: also need a ReadlineCallCounter, to detect inner nested calls
if (not FDebugger.ReadLineTimedOut) or (S <> '') then
FCurrentInstruction.ProcessInputFromGdb(S);
Skip := False;
HandleGdbDataBeforeInstruction(S, Skip, FCurrentInstruction);
if (not Skip) and
( (not FDebugger.ReadLineTimedOut) or (S <> '') )
then
Handled := FCurrentInstruction.ProcessInputFromGdb(S);
HandleGdbDataAfterInstruction(S, Handled, FCurrentInstruction);
if (ehfGotReadError in FDebugger.FErrorHandlingFlags) then begin
FCurrentInstruction.HandleReadError;
@ -507,9 +825,12 @@ begin
if FDebugger.ReadLineTimedOut then begin
NewInstr := FCurrentInstruction.GetTimeOutVerifier;
if NewInstr <> nil then begin
NewInstr.AddReference;
ExeInstr.ReleaseReference;
ExeInstr := NewInstr;
// TODO: Run NewInstr;
FCurrentInstruction := NewInstr;
FCurrentInstruction.SendCommandDataToGDB(Self);
FCurrentInstruction.SendCommandDataToGDB(Self); // ExecuteCurrentInstruction;
end
else begin
@ -519,9 +840,10 @@ begin
end;
end; // while
if (FCurrentInstruction <> nil) and (ifAutoDestroy in FCurrentInstruction.Flags) then
FCurrentInstruction.Free;
FCurrentInstruction := nil;
finally
ExeInstr.ReleaseReference;
end;
end;
procedure TGDBInstructionQueue.SetCurrentInstruction(AnInstruction: TGDBInstruction);
@ -530,6 +852,22 @@ begin
FCurrentInstruction := AnInstruction;
end;
function TGDBInstructionQueue.HasCorrectThreadIdFor(AnInstruction: TGDBInstruction): Boolean;
begin
Result := not(ifRequiresThread in AnInstruction.Flags);
if Result then
exit;
Result := (ifqValidThread in Flags) and (CurrentThreadId = AnInstruction.ThreadId);
end;
function TGDBInstructionQueue.HasCorrectFrameFor(AnInstruction: TGDBInstruction): Boolean;
begin
Result := not(ifRequiresStackFrame in AnInstruction.Flags);
if Result then
exit;
Result := (ifqValidStackFrame in Flags) and (CurrentStackFrame = AnInstruction.StackFrame);
end;
function TGDBInstructionQueue.SendDataToGDB(ASender: TGDBInstruction; AData: String): Boolean;
begin
Result := True;
@ -549,14 +887,32 @@ begin
end;
end;
procedure TGDBInstructionQueue.SelectThread(AThreadId: Integer);
function TGDBInstructionQueue.SendDataToGDB(ASender: TGDBInstruction; AData: String;
const AValues: array of const): Boolean;
begin
Result := SendDataToGDB(ASender, Format(AData, AValues));
end;
procedure TGDBInstructionQueue.SelectFrame(AFrame: Integer);
procedure TGDBInstructionQueue.HandleGdbDataBeforeInstruction(var AData: String;
var SkipData: Boolean; const TheInstruction: TGDBInstruction);
begin
//
end;
procedure TGDBInstructionQueue.HandleGdbDataAfterInstruction(var AData: String;
const Handled: Boolean; const TheInstruction: TGDBInstruction);
begin
//
end;
function TGDBInstructionQueue.GetSelectThreadInstruction(AThreadId: Integer): TGDBInstruction;
begin
Result := TGDBInstructionChangeThread.Create(Self, AThreadId);
end;
function TGDBInstructionQueue.GetSelectFrameInstruction(AFrame: Integer): TGDBInstruction;
begin
Result := TGDBInstructionChangeStackFrame.Create(Self, AFrame);
end;
constructor TGDBInstructionQueue.Create(ADebugger: TGDBMICmdLineDebugger);
@ -564,20 +920,44 @@ begin
FDebugger := ADebugger;
end;
procedure TGDBInstructionQueue.InvalidateThredAndFrame;
procedure TGDBInstructionQueue.InvalidateThredAndFrame(AStackFrameOnly: Boolean = False);
begin
if AStackFrameOnly then begin
DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Invalidating queue''s stack only. Was: ', dbgs(FFlags), ' Thr=', FCurrentThreadId, ' Frm=', FCurrentStackFrame]);
FFlags := FFlags - [ifqValidStackFrame];
end
else begin
DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Invalidating queue''s current thread and stack. Was: ', dbgs(FFlags), ' Thr=', FCurrentThreadId, ' Frm=', FCurrentStackFrame]);
FFlags := FFlags - [ifqValidThread, ifqValidStackFrame];
end;
end;
procedure TGDBInstructionQueue.SetKnownThread(AThread: Integer);
begin
DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Setting queue''s current thread and stack. New: Thr=', AThread, ' Was: ', dbgs(FFlags), ' Thr=', FCurrentThreadId, ' Frm=', FCurrentStackFrame]);
FCurrentThreadId := AThread;
FFlags := FFlags + [ifqValidThread] - [ifqValidStackFrame];
end;
procedure TGDBInstructionQueue.SetKnownThreadAndFrame(AThread, AFrame: Integer);
begin
DebugLn(DBG_THREAD_AND_FRAME, ['TGDB_IQ: Setting queue''s current thread and stack. New: Thr=', AThread, ' Frm=', AFrame,' Was: ', dbgs(FFlags), ' Thr=', FCurrentThreadId, ' Frm=', FCurrentStackFrame]);
FCurrentThreadId := AThread;
FCurrentStackFrame := AFrame;
FFlags := FFlags + [ifqValidThread, ifqValidStackFrame];
end;
procedure TGDBInstructionQueue.RunInstruction(AnInstruction: TGDBInstruction);
begin
SetCurrentInstruction(AnInstruction);
FCurrentInstruction.SendCommandDataToGDB(Self);
ExecuteCurrentInstruction;
FinishCurrentInstruction;
end;
initialization
DBGMI_TIMEOUT_DEBUG := DebugLogger.RegisterLogGroup('DBGMI_TIMEOUT_DEBUG' {$IFDEF DBGMI_TIMEOUT_DEBUG} , True {$ENDIF} );
DBG_THREAD_AND_FRAME := DebugLogger.FindOrRegisterLogGroup('DBG_THREAD_AND_FRAME' {$IFDEF DBG_THREAD_AND_FRAME} , True {$ENDIF} );
DBG_VERBOSE := DebugLogger.FindOrRegisterLogGroup('DBG_VERBOSE' {$IFDEF DBG_VERBOSE} , True {$ENDIF} );
end.

15
debugger/test/Gdbmi/testinstructionqueue.pas
View File

@ -204,6 +204,7 @@ begin
// No timeout
Instr := TTestGDBInstruction.Create('-test-send', [], 100);
Instr.AddReference;
Dbg.TestInit;
dbg.FTest := Self;
Dbg.FTestData := @TestControl1[0];
@ -211,10 +212,11 @@ begin
AssertTrue('ifrComleted', Instr.ResultFlags * [ifrComleted, ifrFailed] = [ifrComleted]);
AssertTrue('no error', Instr.ErrorFlags = []);
AssertEquals('data', '^done,foo'+LineEnding, Instr.FInput);
Instr.Free;
Instr.ReleaseReference;
// Recover timeout
Instr := TTestGDBInstruction.Create('-test-send', [], 100);
Instr.AddReference;
Dbg.TestInit;
dbg.FTest := Self;
Dbg.FTestData := @TestControl2[0];
@ -222,10 +224,11 @@ begin
AssertTrue('ifrComleted', Instr.ResultFlags * [ifrComleted, ifrFailed] = [ifrComleted]);
AssertTrue('no error, but warning', Instr.ErrorFlags = [ifeRecoveredTimedOut]);
AssertEquals('data', '^done,foo'+LineEnding, Instr.FInput);
Instr.Free;
Instr.ReleaseReference;
// late (gdb) / no timeout
Instr := TTestGDBInstruction.Create('-test-send', [], 100);
Instr.AddReference;
Dbg.TestInit;
dbg.FTest := Self;
Dbg.FTestData := @TestControl3[0];
@ -233,10 +236,11 @@ begin
AssertTrue('ifrComleted', Instr.ResultFlags * [ifrComleted, ifrFailed] = [ifrComleted]);
AssertTrue('no error', Instr.ErrorFlags = []);
AssertEquals('data', '^done,foo'+LineEnding, Instr.FInput);
Instr.Free;
Instr.ReleaseReference;
// late response + (gdb) / no timeout
Instr := TTestGDBInstruction.Create('-test-send', [], 100);
Instr.AddReference;
Dbg.TestInit;
dbg.FTest := Self;
Dbg.FTestData := @TestControl3A[0];
@ -244,17 +248,18 @@ begin
AssertTrue('ifrComleted', Instr.ResultFlags * [ifrComleted, ifrFailed] = [ifrComleted]);
AssertTrue('no error', Instr.ErrorFlags = []);
AssertEquals('data', '^done,foo'+LineEnding, Instr.FInput);
Instr.Free;
Instr.ReleaseReference;
// timeout
Instr := TTestGDBInstruction.Create('-test-send', [], 100);
Instr.AddReference;
Dbg.TestInit;
dbg.FTest := Self;
Dbg.FTestData := @TestControl4[0];
Queue.RunInstruction(Instr);
AssertTrue('ifrFailed', Instr.ResultFlags * [ifrComleted, ifrFailed] = [ifrFailed]);
AssertTrue('error', Instr.ErrorFlags = [ifeTimedOut]);
Instr.Free;
Instr.ReleaseReference;
Queue.Free;

2
ide/debugmanager.pas
View File

@ -2678,7 +2678,7 @@ end;
procedure TDebugManager.Inspect(const AExpression: String);
begin
if Destroying then Exit;
ViewDebugDialog(ddtInspect);
ViewDebugDialog(ddtInspect); // TODO: If not yet open, this will get Expression from SourceEdit, and trigger uneeded eval.
if FDialogs[ddtInspect] <> nil then
begin
TIDEInspectDlg(FDialogs[ddtInspect]).Execute(AExpression);