paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 03:50:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions r46301 from trunk:

Browse Source 
------------------------------------------------------------------------
    r46301 | michael | 2020-08-06 23:16:21 +0200 (Thu, 06 Aug 2020) | 1 line
    
    * Fix bug ID #37504: allow to send processID in messages
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46611 -
This commit is contained in:
michael 2020-08-23 09:31:25 +00:00
parent d3b8571d22
commit ed27ad4438
1 changed files with 28 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -41,13 +41,14 @@ function GetDebuggingEnabled : Boolean;
Function StartDebugServer : integer; Function StartDebugServer : integer;
Function InitDebugClient : Boolean; Function InitDebugClient : Boolean;
Function InitDebugClient(const ShowOrNotPID: Boolean) : Boolean; overload;
Const Const
SendError : String = ''; SendError : String = '';
DefaultDebugServer = 'debugserver'; DefaultDebugServer = 'debugserver';
ResourceString ResourceString
SProcessID = 'Process %s'; SProcessID = 'Process %s (PID=%d)';
SEntering = '> Entering '; SEntering = '> Entering ';
SExiting = '< Exiting '; SExiting = '< Exiting ';
SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<'; SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<';
@ -72,6 +73,7 @@ Const
var var
DebugClient : TSimpleIPCClient = nil; DebugClient : TSimpleIPCClient = nil;
MsgBuffer : TMemoryStream = Nil; MsgBuffer : TMemoryStream = Nil;
AlwaysDisplayPID : Boolean = False;
ServerID : Integer; ServerID : Integer;
DebugDisabled : Boolean = False; DebugDisabled : Boolean = False;
Indent : Integer = 0; Indent : Integer = 0;
@ -139,7 +141,10 @@ Var
begin begin
Mesg.MsgTimeStamp:=Now; Mesg.MsgTimeStamp:=Now;
Mesg.MsgType:=ErrorLevel[MTYpe]; Mesg.MsgType:=ErrorLevel[MTYpe];
Mesg.Msg:=Msg; if AlwaysDisplayPID then
Mesg.Msg:=IntToStr(GetProcessID)+' '+Msg
else
Mesg.Msg:=Msg;
SendDebugMessage(Mesg); SendDebugMessage(Mesg);
end; end;
@ -150,7 +155,10 @@ Var
begin begin
Mesg.MsgTimeStamp:=Now; Mesg.MsgTimeStamp:=Now;
Mesg.MsgType:=dmtInformation; Mesg.MsgType:=dmtInformation;
Mesg.Msg:=Msg; if AlwaysDisplayPID then
Mesg.Msg:=IntToStr(GetProcessID)+' '+Msg
else
Mesg.Msg:=Msg;
SendDebugMessage(Mesg); SendDebugMessage(Mesg);
end; end;
@ -184,7 +192,10 @@ Var
begin begin
Mesg.MsgTimeStamp:=Now; Mesg.MsgTimeStamp:=Now;
Mesg.MsgType:=dmtInformation; Mesg.MsgType:=dmtInformation;
Mesg.Msg:=Format(Msg,Args); if AlwaysDisplayPID then
Mesg.Msg:=IntToStr(GetProcessID)+' '+Format(Msg,Args)
else
Mesg.Msg:=Format(Msg,Args);
SendDebugMessage(Mesg); SendDebugMessage(Mesg);
end; end;
@ -196,7 +207,10 @@ Var
begin begin
Mesg.MsgTimeStamp:=Now; Mesg.MsgTimeStamp:=Now;
Mesg.MsgType:=ErrorLevel[mType]; Mesg.MsgType:=ErrorLevel[mType];
Mesg.Msg:=Format(Msg,Args); if AlwaysDisplayPID then
Mesg.Msg:=IntToStr(GetProcessID)+' '+Format(Msg,Args)
else
Mesg.Msg:=Format(Msg,Args);
SendDebugMessage(Mesg); SendDebugMessage(Mesg);
end; end;
@ -247,7 +261,7 @@ begin
begin begin
Msg.MsgType:=lctStop; Msg.MsgType:=lctStop;
Msg.MsgTimeStamp:=Now; Msg.MsgTimeStamp:=Now;
Msg.Msg:=Format(SProcessID,[ApplicationName]); Msg.Msg:=Format(SProcessID,[ApplicationName, GetProcessID]);
WriteMessage(Msg); WriteMessage(Msg);
end; end;
if assigned(MsgBuffer) then FreeAndNil(MsgBuffer); if assigned(MsgBuffer) then FreeAndNil(MsgBuffer);
@ -294,11 +308,17 @@ begin
MsgBuffer:=TMemoryStream.Create; MsgBuffer:=TMemoryStream.Create;
Msg.MsgType:=lctIdentify; Msg.MsgType:=lctIdentify;
Msg.MsgTimeStamp:=Now; Msg.MsgTimeStamp:=Now;
Msg.Msg:=Format(SProcessID,[ApplicationName]); Msg.Msg:=Format(SProcessID,[ApplicationName, GetProcessID]);
WriteMessage(Msg); WriteMessage(Msg);
Result := True; Result := True;
end; end;
function InitDebugClient(const ShowOrNotPID: Boolean): Boolean;
begin
AlwaysDisplayPID:= ShowOrNotPID;
Result:= InitDebugClient;
end;
Finalization Finalization
FreeDebugClient; FreeDebugClient;
end. end.