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

FpDebug/LazDebugger: add asserts for thread safety

Browse Source 
git-svn-id: trunk@64542 -
This commit is contained in:
martin 2021-02-11 22:40:29 +00:00
parent ccf7d87898
commit 6857851554
3 changed files with 45 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
components/fpdebug/fpdbgclasses.pp
View File

@ -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;

34
components/fpdebug/fpdbgcommon.pas
View File

@ -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.

4
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -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);