diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index 7f226025ef..2e3a4ceeb4 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -1000,6 +1000,7 @@ var Len, i: Integer; BList: TFpInternalBreakpointArray; begin + {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TBreakLocationMap.AddLocotion');{$ENDIF} LocData := GetDataPtr(ALocation); if LocData <> nil then begin @@ -1046,6 +1047,7 @@ var LocData: PInternalBreakLocationEntry; Len, i: Integer; begin + {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadIdNotMain('TBreakLocationMap.RemoveLocotion');{$ENDIF} LocData := GetDataPtr(ALocation); if LocData = nil then begin DebugLn(DBG_WARNINGS or DBG_BREAKPOINTS, ['Missing breakpoint for loc ', FormatAddress(ALocation)]); @@ -1126,6 +1128,7 @@ end; function TBreakLocationMap.GetEnumerator: TBreakLocationMapEnumerator; begin + {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TBreakLocationMap.GetEnumerator');{$ENDIF} Result := TBreakLocationMapEnumerator.Create(Self); end; @@ -3123,6 +3126,7 @@ procedure TFpInternalBreakpoint.ResetBreak; var i: Integer; begin + {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.ResetBreak');{$ENDIF} if FProcess = nil then exit; for i := 0 to High(FLocation) do @@ -3133,6 +3137,7 @@ procedure TFpInternalBreakpoint.SetBreak; var i: Integer; begin + {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalBreakpoint.SetBreak');{$ENDIF} if FProcess = nil then exit; for i := 0 to High(FLocation) do @@ -3228,6 +3233,7 @@ var R: Boolean; i: Integer; begin + {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalWatchpoint.SetBreak');{$ENDIF} if FProcess = nil then exit; //TODO: read current mem content. So in case of overlap it can be checked @@ -3259,6 +3265,7 @@ end; procedure TFpInternalWatchpoint.ResetBreak; begin + {$IFDEF FPDEBUG_THREAD_CHECK}AssertFpDebugThreadId('TFpInternalWatchpoint.ResetBreak');{$ENDIF} if FProcess = nil then exit; diff --git a/components/fpdebug/fpdbgcommon.pas b/components/fpdebug/fpdbgcommon.pas index 8f022d00d8..e507c3d190 100644 --- a/components/fpdebug/fpdbgcommon.pas +++ b/components/fpdebug/fpdbgcommon.pas @@ -4,6 +4,8 @@ unit FpDbgCommon; interface +uses Classes; + type // Target information, could be different from host debugger TMachineType = (mtNone, mtSPARC, mt386, mt68K, mtPPC, mtPPC64, mtARM, mtARM64, @@ -23,6 +25,13 @@ type // Use when target information not yet loaded - assumes that debug target is the same as host function hostDescriptor: TTargetDescriptor; +{$IFDEF FPDEBUG_THREAD_CHECK} +procedure AssertFpDebugThreadId(const AName: String); +procedure AssertFpDebugThreadIdNotMain(const AName: String); +procedure SetCurrentFpDebugThreadIdForAssert(AnId: TThreadID); +property CurrentFpDebugThreadIdForAssert: TThreadID write SetCurrentFpDebugThreadIdForAssert; +{$ENDIF} + implementation function hostDescriptor: TTargetDescriptor; @@ -49,5 +58,30 @@ begin end; end; +{$IFDEF FPDEBUG_THREAD_CHECK} +var + FCurrentFpDebugThreadIdForAssert: TThreadID; + FCurrentFpDebugThreadIdValidForAssert: Boolean; + +procedure AssertFpDebugThreadId(const AName: String); +begin + if FCurrentFpDebugThreadIdValidForAssert then + assert(GetCurrentThreadId = FCurrentFpDebugThreadIdForAssert, AName); +end; + +procedure AssertFpDebugThreadIdNotMain(const AName: String); +begin + AssertFpDebugThreadId(AName); + assert(GetCurrentThreadId<>MainThreadID, AName + ' runnig outside main thread'); +end; + +procedure SetCurrentFpDebugThreadIdForAssert(AnId: TThreadID); +begin + FCurrentFpDebugThreadIdForAssert := AnId; + FCurrentFpDebugThreadIdValidForAssert := True; +end; + +{$ENDIF} + end. diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index dd6d9e692e..b825ee9376 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -38,6 +38,7 @@ uses DbgIntfBaseTypes, DbgIntfDebuggerBase, FpDebugDebuggerUtils, FpDebugDebuggerWorkThreads, // FpDebug + {$IFDEF FPDEBUG_THREAD_CHECK} FpDbgCommon, {$ENDIF} FpDbgClasses, FpDbgInfo, FpErrorMessages, FpPascalBuilder, FpdMemoryTools, FpPascalParser, FPDbgController, FpDbgDwarfDataClasses, FpDbgDwarfFreePascal, FpDbgDwarf, FpDbgUtil; @@ -2923,6 +2924,7 @@ end; procedure TFpDebugDebugger.FreeDebugThread; begin FWorkQueue.TerminateAllThreads(True); + {$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF} Application.ProcessMessages; // run the AsyncMethods end; @@ -3111,6 +3113,7 @@ begin end; FWorkQueue.Clear; FWorkQueue.ThreadCount := 1; + {$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := FWorkQueue.Threads[0].ThreadID;{$ENDIF} WorkItem := TFpThreadWorkerControllerRun.Create(Self); FWorkQueue.PushItem(WorkItem); FWorkQueue.WaitForItem(WorkItem, True); @@ -3659,6 +3662,7 @@ begin end; FWorkQueue.TerminateAllThreads(True); Application.ProcessMessages; // run the AsyncMethods + {$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF} Application.RemoveAsyncCalls(Self); FreeAndNil(FDbgController);