wasmjob: fixed callback returning object passed by arg

demo/wasienv/dom/WasiDomTest1.lpr

@@ -16,12 +16,14 @@ uses
 type
   EWasiTest = class(Exception);
 
+  IJSBird = interface;
   TJSBird = class;
 
   TBirdCallBoolean = function(const v: Boolean): Boolean of object;
   TBirdCallInteger = function(const v: integer): integer of object;
   TBirdCallDouble = function(const v: double): double of object;
   TBirdCallUnicodeString = function(const v: UnicodeString): UnicodeString of object;
+  TBirdCallBird = function(const v: IJSBird): IJSBird of object;
   TBirdCallVariant = function(const v: variant): variant of object;
 
   { IJSBird }
@@ -42,6 +44,7 @@ type
     function EchoInteger(const v: integer; const Call: TBirdCallInteger): integer;
     function EchoDouble(const v: Double; const Call: TBirdCallDouble): Double;
     function EchoUnicodeString(const v: UnicodeString; const Call: TBirdCallUnicodeString): UnicodeString;
+    function EchoBird(const v: IJSBird; const Call: TBirdCallBird): IJSBird;
     function EchoVariant(const v: Variant; const Call: TBirdCallVariant): Variant;
     // properties
     function GetCaption: UnicodeString;
@@ -84,6 +87,7 @@ type
     function EchoInteger(const v: integer; const Call: TBirdCallInteger): integer;
     function EchoDouble(const v: Double; const Call: TBirdCallDouble): Double;
     function EchoUnicodeString(const v: UnicodeString; const Call: TBirdCallUnicodeString): UnicodeString;
+    function EchoBird(const v: IJSBird; const Call: TBirdCallBird): IJSBird;
     function EchoVariant(const v: Variant; const Call: TBirdCallVariant): Variant;
     // properties
     function GetCaption: UnicodeString;
@@ -115,6 +119,7 @@ type
     function OnBirdCallInteger(const v: integer): integer;
     function OnBirdCallDouble(const v: double): double;
     function OnBirdCallUnicodeString(const v: UnicodeString): UnicodeString;
+    function OnBirdCallBird(const v: IJSBird): IJSBird;
     function OnBirdCallVariant(const v: Variant): Variant;
   public
     Prefix: string;
@@ -157,6 +162,7 @@ type
     procedure TestFuncArgMethod_Integer;
     procedure TestFuncArgMethod_Double;
     procedure TestFuncArgMethod_UnicodeString;
+    procedure TestFuncArgMethod_Object;
     procedure TestFuncArgMethod_Variant;
 
     // dictionaries
@@ -199,6 +205,17 @@ begin
   Result:=H.AllocString(TBirdCallUnicodeString(aMethod)(v));
 end;
 
+function JOBCallTBirdCallBird(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
+var
+  v: IJSBird;
+begin
+  //writeln('JOBCallTBirdCallBird START');
+  v:=H.GetObject(TJSBird) as IJSBird;
+  //writeln('JOBCallTBirdCallBird ',v<>nil);
+  Result:=H.AllocIntf(TBirdCallBird(aMethod)(v));
+  //writeln('JOBCallTBirdCallBird ',ptruint(Result));
+end;
+
 function JOBCallTBirdCallVariant(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
 var
   v: Variant;
@@ -242,6 +259,11 @@ begin
   Result:=v;
 end;
 
+function TWasmApp.OnBirdCallBird(const v: IJSBird): IJSBird;
+begin
+  Result:=v;
+end;
+
 function TWasmApp.OnBirdCallVariant(const v: Variant): Variant;
 begin
   Result:=v;
@@ -274,6 +296,7 @@ begin
   TestFuncArgMethod_Integer;
   TestFuncArgMethod_Double;
   TestFuncArgMethod_UnicodeString;
+  TestFuncArgMethod_Object;
   TestFuncArgMethod_Variant;
 end;
 
@@ -742,19 +765,15 @@ begin
   Prefix:='TWasmApp.TestFuncArgMethod_UnicodeString';
   Bird.Name:='TestFuncArgMethod_UnicodeString';
 
-  writeln('AAA1 TWasmApp.TestFuncArgMethod_UnicodeString ');
   v:=Bird.EchoUnicodeString('',@OnBirdCallUnicodeString);
   AssertEqualUS('Bird.EchoUnicodeString('''',...)','',v);
 
-  writeln('AAA2 TWasmApp.TestFuncArgMethod_UnicodeString ');
   v:=Bird.EchoUnicodeString('c',@OnBirdCallUnicodeString);
   AssertEqualUS('Bird.EchoUnicodeString(''c'',...)','c',v);
 
-  writeln('AAA3 TWasmApp.TestFuncArgMethod_UnicodeString ');
   v:=Bird.EchoUnicodeString('abc',@OnBirdCallUnicodeString);
   AssertEqualUS('Bird.EchoUnicodeString(''abc'',...)','abc',v);
 
-  writeln('AAA4 TWasmApp.TestFuncArgMethod_UnicodeString ');
   v:=Bird.EchoUnicodeString(#10,@OnBirdCallUnicodeString);
   AssertEqualUS('Bird.EchoUnicodeString(#10,...)',#10,v);
 
@@ -765,6 +784,24 @@ begin
   AssertEqualUS('Bird.EchoUnicodeString(''😄'',...)','😄',v);
 end;
 
+procedure TWasmApp.TestFuncArgMethod_Object;
+var
+  v, Lisa: IJSBird;
+begin
+  Prefix:='TWasmApp.TestFuncArgMethod_Object';
+  Bird.Name:='TestFuncArgMethod_Object';
+
+  v:=Bird.EchoBird(nil,@OnBirdCallBird);
+  AssertEqual('Bird.EchoBird(nil,...)',nil,v);
+
+  v:=Bird.EchoBird(Bird,@OnBirdCallBird);
+  AssertEqual('Bird.EchoBird(Bird,...)',Bird,v);
+
+  Lisa:=Bird.CreateBird('Lisa');
+  v:=Bird.EchoBird(Lisa,@OnBirdCallBird);
+  AssertEqual('Bird.EchoBird(Lisa,...)',Lisa,v);
+end;
+
 procedure TWasmApp.TestFuncArgMethod_Variant;
 var
   v: Variant;
@@ -772,6 +809,15 @@ begin
   Prefix:='TWasmApp.TestFuncArgMethod_Variant;';
   Bird.Name:='TestFuncArgMethod_Variant;';
 
+  v:=Bird.EchoVariant(true,@OnBirdCallVariant);
+  AssertEqual('Bird.EchoVariant(true,...)',true,v);
+
+  v:=Bird.EchoVariant(false,@OnBirdCallVariant);
+  AssertEqual('Bird.EchoVariant(false,...)',false,v);
+
+//  v:=Bird.EchoVariant(Variants.Null,@OnBirdCallVariant);
+//  AssertEqual('Bird.EchoVariant(Variants.Null,...)',Variants.Null,v);
+
   v:=Bird.EchoVariant(0.5,@OnBirdCallVariant);
   AssertEqual('Bird.EchoVariant(0.5,...)',0.5,v);
 end;
@@ -944,6 +990,18 @@ begin
   end;
 end;
 
+function TJSBird.EchoBird(const v: IJSBird; const Call: TBirdCallBird): IJSBird;
+var
+  m: TJOB_Method;
+begin
+  m:=TJOB_Method.Create(TMethod(Call),@JOBCallTBirdCallBird);
+  try
+    Result:=InvokeJSObjectResult('EchoCall',[v,m],TJSBird) as IJSBird;
+  finally
+    m.Free;
+  end;
+end;
+
 function TJSBird.EchoVariant(const v: Variant; const Call: TBirdCallVariant
   ): Variant;
 var

demo/wasienv/dom/job_js.pas

@@ -264,6 +264,7 @@ type
   private
     FJOBObjectID: TJOBObjectID;
     FJOBCastSrc: IJSObject;
+    FJOBObjectIDOwner: boolean;
   protected
     type
       TJOBInvokeNoResultFunc = function(
@@ -302,7 +303,8 @@ type
     class function Cast(Intf: IJSObject): IJSObject; overload;
     destructor Destroy; override;
     property JOBObjectID: TJOBObjectID read FJOBObjectID;
-    property JOBCastSrc: IJSObject read FJOBCastSrc; // nil means it is the owner, otherwise it is a typecast
+    property JOBObjectIDOwner: boolean read FJOBObjectIDOwner write FJOBObjectIDOwner;
+    property JOBCastSrc: IJSObject read FJOBCastSrc; // nil means it is the original, otherwise it is a typecast
     // call a function
     procedure InvokeJSNoResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeType = jiCall); virtual;
     function InvokeJSBooleanResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeType = jiCall): Boolean; virtual;
@@ -1859,6 +1861,7 @@ begin
       ObjId:=PLongWord(p)^;
       inc(p,4);
       Result:=aResultClass.JOBCreateFromID(ObjId);
+      Result.JOBObjectIDOwner:=false; // owned by caller (JS code in browser)
     end
   else
     raise EJSArgParse.Create(JOBArgNames[p^]);
@@ -1934,12 +1937,17 @@ var
   Obj: TJSObject;
   S: UnicodeString;
 begin
-  if (Index=Count) or (p^=JOBArgUndefined) then
+  if Index=Count then
   begin
     Result:=Variants.Unassigned;
     exit;
   end;
   case p^ of
+  JOBArgUndefined:
+    begin
+      Result:=Variants.Unassigned;
+      inc(p);
+    end;
   JOBArgTrue:
     begin
       Result:=true;
@@ -1981,6 +1989,7 @@ begin
       ObjId:=PLongWord(p)^;
       inc(p,4);
       Obj:=TJSObject.JOBCreateFromID(ObjId);
+      Obj.JOBObjectIDOwner:=false;
       Result:=Obj as IJSObject;
     end;
   else
@@ -2076,6 +2085,7 @@ end;
 
 function TJOBCallbackHelper.AllocObjId(ObjId: TJOBObjectID): PByte;
 begin
+  //writeln('TJOBCallbackHelper.AllocObjId ObjID=',ObjId);
   GetMem(Result,1+SizeOf(TJOBObjectID));
   Result^:=JOBArgObject;
   PJOBObjectID(Result+1)^:=ObjId;
@@ -2889,6 +2899,7 @@ end;
 constructor TJSObject.JOBCreateFromID(aID: TJOBObjectID);
 begin
   FJOBObjectID:=aID;
+  FJOBObjectIDOwner:=true;
 end;
 
 constructor TJSObject.JOBCreateGlobal(const aID: UnicodeString);
@@ -2896,6 +2907,7 @@ begin
   FJOBObjectID:=__job_get_global(PWideChar(aID),length(aID));
   if FJOBObjectID=0 then
     raise EJSObject.Create('JS object "'+String(aID)+'" is not registered');
+  FJOBObjectIDOwner:=true;
 end;
 
 class function TJSObject.Cast(Intf: IJSObject): IJSObject;
@@ -2907,7 +2919,7 @@ destructor TJSObject.Destroy;
 begin
   if FJOBCastSrc<>nil then
     FJOBCastSrc:=nil
-  else if JOBObjectID>=0 then
+  else if (JOBObjectID>=0) and JOBObjectIDOwner then
     __job_release_object(JOBObjectID);
   FJOBObjectID:=0;
   inherited Destroy;

packages/job/job_browser.pp

@@ -31,7 +31,7 @@ Type
   Protected
     function Invoke_JSResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP: NativeInt; out JSResult: JSValue): TJOBResult; virtual;
     function GetInvokeArguments(View: TJSDataView; ArgsP: NativeInt): TJSValueDynArray; virtual;
-    function CreateCallbackArgs(View: TJSDataView; const Args: TJSFunctionArguments): TWasmNativeInt; virtual;
+    function CreateCallbackArgs(View: TJSDataView; const Args: TJSFunctionArguments; TempObjIds: TJOBObjectIDArray): TWasmNativeInt; virtual;
     function EatCallbackResult(View: TJSDataView; ResultP: TWasmNativeInt): jsvalue; virtual;
     // exports
     function Get_GlobalID(NameP, NameLen: NativeInt): TJOBObjectID; virtual;
@@ -487,13 +487,14 @@ var
 
   function ReadWasmNativeInt: TWasmNativeInt;
   begin
-    Result:=View.getUint32(p,env.IsLittleEndian);
+    Result:=View.getInt32(p,env.IsLittleEndian);
     inc(p,4);
   end;
 
   function ReadArgMethod: TProxyFunc;
   var
     aCall, aData, aCode: TWasmNativeInt;
+    i: Integer;
   begin
     aCall:=ReadWasmNativeInt;
     aData:=ReadWasmNativeInt;
@@ -502,14 +503,21 @@ var
     Result:=function: jsvalue
       var
         Args, ResultP: TWasmNativeInt;
+        TempObjIds: TJOBObjectIDArray;
       begin
         //writeln('TJSObjectBridge called JS Method Call=',aCall,' Data=',aData,' Code=',aCode,' Args=',JSArguments.length);
-        Args:=CreateCallbackArgs(View,JSArguments);
-        ResultP:=CallbackHandler(aCall,aData,aCode,Args); // this frees Args, and may detach View
-        View:=getModuleMemoryDataView();
-        //writeln('TJSObjectBridge called Wasm Call=',aCall,' Data=',aData,' Code=',aCode,' ResultP=',ResultP);
-        Result:=EatCallbackResult(View,ResultP); // this frees ResultP
-        //writeln('TJSObjectBridge Result=',Result);
+        Args:=CreateCallbackArgs(View,JSArguments,TempObjIds);
+        try
+          ResultP:=CallbackHandler(aCall,aData,aCode,Args); // this frees Args, and may detach View
+          View:=getModuleMemoryDataView();
+          //writeln('TJSObjectBridge called Wasm Call=',aCall,' Data=',aData,' Code=',aCode,' ResultP=',ResultP);
+          Result:=EatCallbackResult(View,ResultP); // this frees ResultP
+          //writeln('TJSObjectBridge Result=',Result);
+        finally
+          //writeln('After CallbackHandler: TempObjIds=',length(TempObjIds),' ',TempObjIds);
+          for i:=0 to length(TempObjIds)-1 do
+            ReleaseObject(TempObjIds[i]);
+        end;
       end;
   end;
 
@@ -653,7 +661,8 @@ begin
 end;
 
 function TJSObjectBridge.CreateCallbackArgs(View: TJSDataView;
-  const Args: TJSFunctionArguments): TWasmNativeInt;
+  const Args: TJSFunctionArguments; TempObjIds: TJOBObjectIDArray
+  ): TWasmNativeInt;
 var
   i, Len, j: Integer;
   Arg: JSValue;
@@ -694,7 +703,7 @@ begin
   begin
     Arg:=Args[i];
     r:=GetJOBResult(Arg);
-    //writeln('TJSObjectBridge.CreateCallbackArgs ',i,'/',Args.Length,' r=',r);
+    writeln('TJSObjectBridge.CreateCallbackArgs ',i,'/',Args.Length,' r=',r);
     case r of
     JOBResult_Null:
       begin
@@ -735,7 +744,9 @@ begin
         View.setUint8(p,JOBArgObject);
         inc(p);
         NewId:=RegisterLocalObject(TJSObject(Arg));
-        View.setUint32(p, longword(NewId), env.IsLittleEndian);
+        TJSArray(TempObjIds).push(NewId);
+        writeln('TJSObjectBridge.CreateCallbackArgs Object ID=',NewID);
+        View.setInt32(p, NewId, env.IsLittleEndian);
         inc(p,4);
       end;
     else
@@ -788,6 +799,7 @@ begin
       begin
         ObjId:=View.getInt32(p,env.IsLittleEndian);
         Result:=FindObject(ObjId);
+        writeln('TJSObjectBridge.EatCallbackResult ObjID=',ObjId,' Result=',Result<>nil);
       end;
     else
       Result:=Undefined;

packages/job/job_shared.pp

@@ -9,6 +9,7 @@ interface
 
 type
   TJOBObjectID = NativeInt;
+  TJOBObjectIDArray = array of TJOBObjectID;
 
 // invoke results
 type