paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-07 09:38:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix Access Violation when starting debug server failed

Browse Source
This commit is contained in:
Michaël Van Canneyt 2023-10-11 08:47:36 +02:00
parent 94cb1c3a49
commit 26e66fda75
1 changed files with 20 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
packages/fcl-process/src/dbugintf.pp
View File

@ -118,6 +118,8 @@ var
Procedure WriteMessage(Const Msg : TDebugMessage); Procedure WriteMessage(Const Msg : TDebugMessage);
begin begin
if not Assigned(MsgBuffer) then
exit;
MsgBuffer.Seek(0,soFrombeginning); MsgBuffer.Seek(0,soFrombeginning);
WriteDebugMessageToStream(MsgBuffer,Msg); WriteDebugMessageToStream(MsgBuffer,Msg);
DebugClient.SendMessage(mtUnknown,MsgBuffer); DebugClient.SendMessage(mtUnknown,MsgBuffer);
@ -343,25 +345,25 @@ begin
AlwaysDisplayPID:= ShowPID; AlwaysDisplayPID:= ShowPID;
DebugClient:=TSimpleIPCClient.Create(Nil); DebugClient:=TSimpleIPCClient.Create(Nil);
DebugClient.ServerID:=DebugServerID; DebugClient.ServerID:=DebugServerID;
If not DebugClient.ServerRunning then
begin
ServerID:=StartDebugServer(ADebugServerExe,ARaiseExceptionOnSendError,ServerLogFileName);
if ServerID = 0 then
begin
DebugDisabled := True;
FreeAndNil(DebugClient);
Exit;
end
else
DebugDisabled := False;
I:=0;
While (I<100) and not DebugClient.ServerRunning do
begin
Inc(I);
Sleep(100);
end;
end;
try try
If not DebugClient.ServerRunning then
begin
ServerID:=StartDebugServer(ADebugServerExe,ARaiseExceptionOnSendError,ServerLogFileName);
if ServerID = 0 then
begin
DebugDisabled := True;
FreeAndNil(DebugClient);
Exit;
end
else
DebugDisabled := False;
I:=0;
While (I<100) and not DebugClient.ServerRunning do
begin
Inc(I);
Sleep(100);
end;
end;
DebugClient.Connect; DebugClient.Connect;
except except
FreeAndNil(DebugClient); FreeAndNil(DebugClient);