mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-13 12:09:21 +02:00
wasmjob: fixed callback arg string
This commit is contained in:
parent
405998ab72
commit
60c1186110
@ -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;
|
||||
|
@ -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');
|
||||
|
@ -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;
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user