wasmjob: fixed callback arg string

This commit is contained in:
mattias 2022-08-24 17:31:51 +02:00
parent 405998ab72
commit 60c1186110
4 changed files with 188 additions and 23 deletions

View File

@ -98,7 +98,9 @@ end;
function TBird.EchoCall(const a: JSValue; const CB: TBirdCallback): JSValue;
begin
writeln('TBird.EchoCall argument=',a);
Result:=CB(a);
writeln('TBird.EchoCall Result=',Result);
end;
function TBird.GetInteger: integer;

View File

@ -20,6 +20,8 @@ type
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;
TBirdCallVariant = function(const v: variant): variant of object;
{ IJSBird }
@ -38,6 +40,9 @@ type
function Echo(const v: Variant): Variant;
function EchoBoolean(const v: Boolean; const Call: TBirdCallBoolean): Boolean;
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 EchoVariant(const v: Variant; const Call: TBirdCallVariant): Variant;
// properties
function GetCaption: UnicodeString;
function GetEnabled: boolean;
@ -77,6 +82,9 @@ type
function Echo(const v: Variant): Variant;
function EchoBoolean(const v: Boolean; const Call: TBirdCallBoolean): Boolean;
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 EchoVariant(const v: Variant; const Call: TBirdCallVariant): Variant;
// properties
function GetCaption: UnicodeString;
function GetEnabled: boolean;
@ -105,6 +113,9 @@ type
function OnPlaygroundClick(Event: IJSEvent): boolean;
function OnBirdCallBoolean(const v: boolean): boolean;
function OnBirdCallInteger(const v: integer): integer;
function OnBirdCallDouble(const v: double): double;
function OnBirdCallUnicodeString(const v: UnicodeString): UnicodeString;
function OnBirdCallVariant(const v: Variant): Variant;
public
Prefix: string;
Bird: IJSBird;
@ -144,6 +155,9 @@ type
// callbacks
procedure TestFuncArgMethod_Boolean;
procedure TestFuncArgMethod_Integer;
procedure TestFuncArgMethod_Double;
procedure TestFuncArgMethod_UnicodeString;
procedure TestFuncArgMethod_Variant;
// dictionaries
@ -169,6 +183,30 @@ begin
Result:=H.AllocLongint(TBirdCallInteger(aMethod)(v));
end;
function JOBCallTBirdCallDouble(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
var
v: Double;
begin
v:=H.GetDouble;
Result:=H.AllocDouble(TBirdCallDouble(aMethod)(v));
end;
function JOBCallTBirdCallUnicodeString(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
var
v: UnicodeString;
begin
v:=H.GetString;
Result:=H.AllocString(TBirdCallUnicodeString(aMethod)(v));
end;
function JOBCallTBirdCallVariant(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
var
v: Variant;
begin
v:=H.GetVariant;
Result:=H.AllocVariant(TBirdCallVariant(aMethod)(v));
end;
{ TApplication }
function TWasmApp.OnPlaygroundClick(Event: IJSEvent): boolean;
@ -193,9 +231,23 @@ begin
Result:=v;
end;
function TWasmApp.OnBirdCallDouble(const v: double): double;
begin
Result:=v;
end;
function TWasmApp.OnBirdCallUnicodeString(const v: UnicodeString
): UnicodeString;
begin
Result:=v;
end;
function TWasmApp.OnBirdCallVariant(const v: Variant): Variant;
begin
Result:=v;
end;
procedure TWasmApp.Run;
var
JSElem: IJSElement;
begin
Bird:=TJSBird.JOBCreateGlobal('Bird') as IJSBird;
@ -220,15 +272,9 @@ begin
TestFuncArgMethod_Boolean;
TestFuncArgMethod_Integer;
exit;
JSElem:=JSDocument.getElementById('playground');
writeln('TWasmApp.Run playground classname=',JSElem.className_);
writeln('TWasmApp.Run addEventListener click...');
JSElem.addEventListener('click',@OnPlaygroundClick);
writeln('TWasmApp.Run ');
TestFuncArgMethod_Double;
TestFuncArgMethod_UnicodeString;
TestFuncArgMethod_Variant;
end;
procedure TWasmApp.TestBooleanProperty;
@ -662,6 +708,74 @@ begin
AssertEqual('Bird.EchoInteger(high(longint),...)',high(longint),v);
end;
procedure TWasmApp.TestFuncArgMethod_Double;
var
v: Double;
begin
Prefix:='TWasmApp.TestFuncArgMethod_Double';
Bird.Name:='TestFuncArgMethod_Double';
v:=Bird.EchoDouble(0.5,@OnBirdCallDouble);
AssertEqual('Bird.EchoDouble(0.5,...)',0.5,v);
v:=Bird.EchoDouble(MaxSafeIntDouble,@OnBirdCallDouble);
AssertEqual('Bird.EchoDouble(MaxSafeIntDouble,...)',MaxSafeIntDouble,v);
v:=Bird.EchoDouble(MinSafeIntDouble,@OnBirdCallDouble);
AssertEqual('Bird.EchoDouble(MinSafeIntDouble,...)',MinSafeIntDouble,v);
v:=Bird.EchoDouble(NaN,@OnBirdCallDouble);
if not IsNan(v) then
Fail('Bird.EchoDouble(NaN,...) is not NaN');
v:=Bird.EchoDouble(Infinity,@OnBirdCallDouble);
AssertEqual('Bird.EchoDouble(Infinity,...)',Infinity,v);
v:=Bird.EchoDouble(NegInfinity,@OnBirdCallDouble);
AssertEqual('Bird.EchoDouble(NegInfinity,...)',NegInfinity,v);
end;
procedure TWasmApp.TestFuncArgMethod_UnicodeString;
var
v: UnicodeString;
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);
v:=Bird.EchoUnicodeString('ä',@OnBirdCallUnicodeString);
AssertEqualUS('Bird.EchoUnicodeString(''ä'',...)','ä',v);
v:=Bird.EchoUnicodeString('😄',@OnBirdCallUnicodeString);
AssertEqualUS('Bird.EchoUnicodeString(''😄'',...)','😄',v);
end;
procedure TWasmApp.TestFuncArgMethod_Variant;
var
v: Variant;
begin
Prefix:='TWasmApp.TestFuncArgMethod_Variant;';
Bird.Name:='TestFuncArgMethod_Variant;';
v:=Bird.EchoVariant(0.5,@OnBirdCallVariant);
AssertEqual('Bird.EchoVariant(0.5,...)',0.5,v);
end;
procedure TWasmApp.Fail(const Msg: string);
begin
writeln('TWasmApp.Fail ',Prefix+': '+Msg);
@ -804,6 +918,45 @@ begin
end;
end;
function TJSBird.EchoDouble(const v: Double; const Call: TBirdCallDouble
): Double;
var
m: TJOB_Method;
begin
m:=TJOB_Method.Create(TMethod(Call),@JOBCallTBirdCallDouble);
try
Result:=InvokeJSDoubleResult('EchoCall',[v,m]);
finally
m.Free;
end;
end;
function TJSBird.EchoUnicodeString(const v: UnicodeString;
const Call: TBirdCallUnicodeString): UnicodeString;
var
m: TJOB_Method;
begin
m:=TJOB_Method.Create(TMethod(Call),@JOBCallTBirdCallUnicodeString);
try
Result:=InvokeJSUnicodeStringResult('EchoCall',[v,m]);
finally
m.Free;
end;
end;
function TJSBird.EchoVariant(const v: Variant; const Call: TBirdCallVariant
): Variant;
var
m: TJOB_Method;
begin
m:=TJOB_Method.Create(TMethod(Call),@JOBCallTBirdCallVariant);
try
Result:=InvokeJSVariantResult('EchoCall',[v,m]);
finally
m.Free;
end;
end;
function TJSBird.GetCaption: UnicodeString;
begin
Result:=ReadJSPropertyUnicodeString('Caption');

View File

@ -2045,11 +2045,11 @@ var
l: SizeInt;
begin
l:=length(s);
GetMem(Result,5+l);
GetMem(Result,5+2*l);
Result^:=JOBArgUnicodeString;
PLongWord(Result+1)^:=l;
if l>0 then
Move(s[1],Result[5],l);
Move(s[1],Result[5],2*l);
end;
function TJOBCallbackHelper.AllocNil: PByte;

View File

@ -721,7 +721,7 @@ begin
View.setUint8(p,JOBArgUnicodeString);
inc(p);
s:=String(Arg);
View.setUint32(p,length(s));
View.setUint32(p,length(s),env.IsLittleEndian);
inc(p,4);
for j:=0 to length(s)-1 do
begin
@ -749,10 +749,26 @@ function TJSObjectBridge.EatCallbackResult(View: TJSDataView;
ResultP: TWasmNativeInt): jsvalue;
var
p: TWasmNativeInt;
function EatString: JSValue;
var
Len: LongWord;
i: Integer;
a: TWordDynArray;
begin
Len:=View.getUInt32(p,env.IsLittleEndian);
inc(p,4);
SetLength(a,Len);
for i:=0 to Len-1 do begin
a[i]:=View.getUint16(p,env.IsLittleEndian);
inc(p,2);
end;
Result:=TJSFunction(@TJSString.fromCharCode).apply(nil,a);
end;
var
aType: Byte;
ObjId: LongInt;
Len: LongWord;
aWords: TJSUint16Array;
begin
if ResultP=0 then
exit(Undefined);
@ -766,13 +782,7 @@ begin
JOBArgFalse: Result:=false;
JOBArgLongint: Result:=View.getInt32(p,env.IsLittleEndian);
JOBArgDouble: Result:=View.getFloat64(p,env.IsLittleEndian);
JOBArgUnicodeString:
begin
Len:=View.getUInt32(p,env.IsLittleEndian);
inc(p);
aWords:=TJSUint16Array.New(View.buffer, p,Len);
Result:=TypedArrayToString(aWords);
end;
JOBArgUnicodeString: Result:=EatString;
JOBArgNil: Result:=nil;
JOBArgObject:
begin