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