瀏覽代碼

* Allow message in ShowAsDebug

Michaël Van Canneyt 10 月之前
父節點
當前提交
5ac4fd0b13
共有 1 個文件被更改,包括 34 次插入17 次删除
  1. 34 17
      packages/wasm-job/src/job.js.pas

+ 34 - 17
packages/wasm-job/src/job.js.pas

@@ -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);
+Procedure DebugObject(const Message : String; aObject : IJSObject);
+
+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 : TJSObject);
+Procedure DebugObject(const Message : String; 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 : 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;