diff --git a/debugger/gdbmidebugger.pp b/debugger/gdbmidebugger.pp index 167d54fa90..adaa03093f 100644 --- a/debugger/gdbmidebugger.pp +++ b/debugger/gdbmidebugger.pp @@ -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:=''; - 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. diff --git a/debugger/gdbmidebuginstructions.pp b/debugger/gdbmidebuginstructions.pp index 6bc2104c21..4cad120a24 100644 --- a/debugger/gdbmidebuginstructions.pp +++ b/debugger/gdbmidebuginstructions.pp @@ -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 - Include(FResultFlags, ifrFailed); - Include(FErrorFlags, ifeGdbNotRunning); + 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, 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,53 +406,444 @@ 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 - while (FCurrentInstruction <> nil) and - (not FCurrentInstruction.IsCompleted) - do begin - if not FDebugger.DebugProcessRunning then begin - FCurrentInstruction.HandleNoGdbRunning; - break; - end; - - S := FDebugger.ReadLine(FCurrentInstruction.TimeOut); - // Readline, may go into Application.ProcessMessages. - // If it does, it has not (yet) read any data. - // Therefore, if it does, another nested call to readline will work, and data will be returned in the correct order. - // 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); - - if (ehfGotReadError in FDebugger.FErrorHandlingFlags) then begin - FCurrentInstruction.HandleReadError; - break; - end; - if FDebugger.ReadLineTimedOut then begin - NewInstr := FCurrentInstruction.GetTimeOutVerifier; - if NewInstr <> nil then begin - // TODO: Run NewInstr; - FCurrentInstruction := NewInstr; - FCurrentInstruction.SendCommandDataToGDB(Self); - - end - else begin - FCurrentInstruction.HandleTimeOut; + if FCurrentInstruction = nil then exit; + ExeInstr := FCurrentInstruction; + ExeInstr.AddReference; + try + while (FCurrentInstruction <> nil) and + (not FCurrentInstruction.IsCompleted) + do begin + if not FDebugger.DebugProcessRunning then begin + FCurrentInstruction.HandleNoGdbRunning; break; end; - end; - end; // while - if (FCurrentInstruction <> nil) and (ifAutoDestroy in FCurrentInstruction.Flags) then - FCurrentInstruction.Free; - FCurrentInstruction := nil; + S := FDebugger.ReadLine(FCurrentInstruction.TimeOut); + // Readline, may go into Application.ProcessMessages. + // If it does, it has not (yet) read any data. + // Therefore, if it does, another nested call to readline will work, and data will be returned in the correct order. + // 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 + + 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; + break; + end; + 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); // ExecuteCurrentInstruction; + + end + else begin + FCurrentInstruction.HandleTimeOut; + break; + end; + end; + + end; // while + 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 - FFlags := FFlags - [ifqValidThread, ifqValidStackFrame]; + 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. diff --git a/debugger/test/Gdbmi/testinstructionqueue.pas b/debugger/test/Gdbmi/testinstructionqueue.pas index 0c7ddb7c3b..e7962f967a 100644 --- a/debugger/test/Gdbmi/testinstructionqueue.pas +++ b/debugger/test/Gdbmi/testinstructionqueue.pas @@ -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; diff --git a/ide/debugmanager.pas b/ide/debugmanager.pas index 8fe6b9ec59..5a2eb00c13 100644 --- a/ide/debugmanager.pas +++ b/ide/debugmanager.pas @@ -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);