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

DumpLiveObjects call

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-09-20 10:37:01 +02:00
parent 8b48127b2c
commit ae83472a06
1 changed files with 22 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
packages/wasm-job/src/job.js.pas
View File

@ -1379,6 +1379,7 @@ function VarRecToJSValue(const V: TVarRec): TJOB_JSValue;
Procedure DebugObject(const Message: String; aObject : IJSObject);
Procedure DebugObject(const Message: String; aObject : TJSObject);
Procedure DebugObject(const Message: String; aObject : TJOB_JSValue);
Procedure ShowLiveObjects(const Message: String);
Type
TJobCallbackErrorEvent = Procedure (E : Exception; M : TMethod; H : TJobCallbackHelper; Var ReRaise : Boolean) of Object;
@ -1406,7 +1407,11 @@ var
msg : Rawbytestring;
begin
{$IF SIZEOF(CHAR)=2}
msg:=UTF8Encode(Message);
{$ELSE}
msg:=Message;
{$ENDIF}
__job_debug_object(aObject.GetJSObjectID,PByte(Msg),Length(Msg),0);
end;
@ -1416,7 +1421,11 @@ var
msg : Rawbytestring;
begin
{$IF SIZEOF(CHAR)=2}
msg:=UTF8Encode(Message);
{$ELSE}
msg:=Message;
{$ENDIF}
__job_debug_object(aObject.GetJSObjectID,PByte(Msg),Length(Msg),0);
end;
@ -1435,6 +1444,19 @@ begin
Writeln(Message,': ',TJOB_Double(aObject).AsString);
end;
procedure ShowLiveObjects(const Message: String);
var
msg : Rawbytestring;
begin
{$IF SIZEOF(CHAR)=2}
msg:=UTF8Encode(Message);
{$ELSE}
msg:=Message;
{$ENDIF}
if not __job_debug_object(-1,PByte(msg),Length(msg),0)=JOBResult_Success then
Writeln('Failed to show live objects');
end;
{$IFDEF VerboseJOB}
function GetVarRecName(vt: word): string;
begin