paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 11:32:46 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Allow message in ShowAsDebug

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-09-18 17:32:37 +02:00
parent 1f0c72b6c1
commit 5ac4fd0b13
1 changed files with 36 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -302,7 +302,7 @@ type
procedure WriteJSPropertyMethod(const aName: UTF8String; const Value: TMethod); virtual;
// create a new object using the new-operator
function NewJSObject(Const Args: Array of const; aResultClass: TJSObjectClass): TJSObject; virtual;
procedure ShowAsDebug;
procedure ShowAsDebug(Const aMessage : string);
// JS members
function getOwnPropertyNames(const Obj: IJSObject): TUnicodeStringDynArray;
function getPrototypeOf(const Obj: IJSObject): IJSObject;
@ -362,7 +362,7 @@ type
constructor JOBCreate(aOwnsObjectID : Boolean; const Args : Array of const);
class function JSClassName : UnicodeString; virtual;
class function Cast(const Intf: IJSObject): IJSObject; overload;
procedure ShowAsDebug;
procedure ShowAsDebug(Const aMessage : string);
constructor Create; virtual;
destructor Destroy; override;
property JOBObjectID: TJOBObjectID read FJOBObjectID;
@ -1369,14 +1369,16 @@ procedure __job_set_array_from_mem (
function __job_debug_object (
aObjectID : integer;
aMessage : PByte;
aMessageLen : Longint;
aFlags : Longint) : longint; external JOBExportName name JOBFn_DebugObject;
function JOBCallback(const Func: TJOBCallback; Data, Code: Pointer; Args: PByte): PByte;
function VarRecToJSValue(const V: TVarRec): TJOB_JSValue;
Procedure DebugObject(aObject : IJSObject);
Procedure DebugObject(aObject : TJSObject);
Procedure DebugObject(aObject : TJOB_JSValue);
Procedure DebugObject(const Message: String; aObject : IJSObject);
Procedure DebugObject(const Message: String; aObject : TJSObject);
Procedure DebugObject(const Message: String; aObject : TJOB_JSValue);
Type
TJobCallbackErrorEvent = Procedure (E : Exception; M : TMethod; H : TJobCallbackHelper; Var ReRaise : Boolean) of Object;
@ -1398,30 +1400,39 @@ const
JOBInvokeNew
);
Procedure DebugObject(aObject : IJSObject);
begin
__job_debug_object(aObject.GetJSObjectID,0);
end;
Procedure DebugObject(const Message : String; aObject : IJSObject);
Procedure DebugObject(aObject : TJSObject);
var
msg : Rawbytestring;
begin
__job_debug_object(aObject.GetJSObjectID,0);
msg:=UTF8Encode(Message);
__job_debug_object(aObject.GetJSObjectID,PByte(Msg),Length(Msg),0);
end;
Procedure DebugObject(aObject : TJOB_JSValue);
Procedure DebugObject(const Message : String; aObject : TJSObject);
var
msg : Rawbytestring;
begin
msg:=UTF8Encode(Message);
__job_debug_object(aObject.GetJSObjectID,PByte(Msg),Length(Msg),0);
end;
Procedure DebugObject(const Message : String; aObject : TJOB_JSValue);
begin
if (aObject is TJOB_Object) then
DebugObject(TJOB_Object(aObject).Value)
DebugObject(Message,TJOB_Object(aObject).Value)
else if aObject is TJOB_String then
Writeln(UTF8Encode(TJOB_String(aObject).Value))
Writeln(Message,': ',UTF8Encode(TJOB_String(aObject).Value))
else if aObject is TJOB_Boolean then
Writeln(TJOB_Boolean(aObject).Value)
Writeln(Message,': ',TJOB_Boolean(aObject).Value)
else if aObject is TJOB_Double then
Writeln(TJOB_Double(aObject).Value)
Writeln(Message,': ',TJOB_Double(aObject).Value)
else
Writeln(TJOB_Double(aObject).AsString);
Writeln(Message,': ',TJOB_Double(aObject).AsString);
end;
{$IFDEF VerboseJOB}
@ -1581,6 +1592,7 @@ begin
end;
end;
function JOBCallTJSPromiseResolver(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
var
aValue: Variant;
@ -4375,9 +4387,14 @@ begin
Result:=JOBCast(Intf);
end;
procedure TJSObject.ShowAsDebug;
procedure TJSObject.ShowAsDebug(const aMessage : string);
var
Msg : String;
begin
DebugObject(Self);
Msg:=aMessage;
if Msg='' then
Msg:='Object '+ClassName;
DebugObject(Msg,Self);
end;
class function TJSObject.JSClassName : UnicodeString;