paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-06-01 23:22:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

wasmjob: fixed callback returning object passed by arg

Browse Source
This commit is contained in:
mattias 2022-08-24 23:35:03 +02:00
parent 60c1186110
commit b819dc02c7
4 changed files with 101 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
demo/wasienv/dom/WasiDomTest1.lpr
View File

@ -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

18
demo/wasienv/dom/job_js.pas
View File

@ -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;

34
packages/job/job_browser.pp
View File

@ -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;

1
packages/job/job_shared.pp
View File

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