paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-07 06:27:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

wasmjob: test callback boolean and integer

Browse Source
This commit is contained in:
mattias 2022-08-24 16:32:55 +02:00
parent c1faa91dcb
commit 6e8bc2507d
2 changed files with 108 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
demo/wasienv/dom/BrowserDomTest1.lpr
View File

@ -6,6 +6,7 @@ uses
BrowserConsole, JS, Classes, SysUtils, Web, WasiEnv, WasiHostApp, JOB_Browser, JOB_Shared;
Type
TBirdCallback = function(const v: JSValue): JSValue;
{ TBird }
@ -26,6 +27,7 @@ Type
function GetString: string;
function GetBird: TBird;
function Echo(const a: JSValue): JSValue;
function EchoCall(const a: JSValue; const CB: TBirdCallback): JSValue;
function CreateBird(const aName: string): TBird;
procedure IncSize;
end;
@ -94,6 +96,11 @@ begin
Result:=a;
end;
function TBird.EchoCall(const a: JSValue; const CB: TBirdCallback): JSValue;
begin
Result:=CB(a);
end;
function TBird.GetInteger: integer;
begin
writeln('TBird.GetInteger [',Name,'] ',ArgsToStr(JSArguments));

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

@ -18,6 +18,10 @@ type
TJSBird = class;
TBirdCallBoolean = function(const v: Boolean): Boolean of object;
TBirdCallInteger = function(const v: integer): integer of object;
TBirdCallVariant = function(const v: variant): variant of object;
{ IJSBird }
IJSBird = interface(IJSObject)
@ -32,6 +36,8 @@ type
function GetUtf8String: String;
function GetBird: IJSBird;
function Echo(const v: Variant): Variant;
function EchoBoolean(const v: Boolean; const Call: TBirdCallBoolean): Boolean;
function EchoInteger(const v: integer; const Call: TBirdCallInteger): integer;
// properties
function GetCaption: UnicodeString;
function GetEnabled: boolean;
@ -69,6 +75,8 @@ type
function GetUtf8String: String;
function GetBird: IJSBird;
function Echo(const v: Variant): Variant;
function EchoBoolean(const v: Boolean; const Call: TBirdCallBoolean): Boolean;
function EchoInteger(const v: integer; const Call: TBirdCallInteger): integer;
// properties
function GetCaption: UnicodeString;
function GetEnabled: boolean;
@ -95,6 +103,8 @@ type
TWasmApp = class
private
function OnPlaygroundClick(Event: IJSEvent): boolean;
function OnBirdCallBoolean(const v: boolean): boolean;
function OnBirdCallInteger(const v: integer): integer;
public
Prefix: string;
Bird: IJSBird;
@ -128,11 +138,12 @@ type
procedure TestFuncResultObject;
procedure TestFuncResultVariant;
procedure TestFuncResultVariantNumber;
procedure TestFuncResultVariantStrings;
procedure TestFuncResultVariantString;
procedure TestFuncResultVariantObject;
// function args
// todo procedure TestFuncArgMethod;
// callbacks
procedure TestFuncArgMethod_Boolean;
procedure TestFuncArgMethod_Integer;
// dictionaries
@ -142,6 +153,21 @@ type
// todo: TestFuncResultUnicodeStringArray
end;
function JOBCallTBirdCallBoolean(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
var
v: Boolean;
begin
v:=H.GetBoolean;
Result:=H.AllocBool(TBirdCallBoolean(aMethod)(v));
end;
function JOBCallTBirdCallInteger(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
var
v: LongInt;
begin
v:=H.GetLongInt;
Result:=H.AllocLongint(TBirdCallInteger(aMethod)(v));
end;
{ TApplication }
@ -157,6 +183,16 @@ begin
Result:=true;
end;
function TWasmApp.OnBirdCallBoolean(const v: boolean): boolean;
begin
Result:=v;
end;
function TWasmApp.OnBirdCallInteger(const v: integer): integer;
begin
Result:=v;
end;
procedure TWasmApp.Run;
var
JSElem: IJSElement;
@ -179,9 +215,12 @@ begin
TestFuncResultObject;
TestFuncResultVariant;
TestFuncResultVariantNumber;
TestFuncResultVariantStrings;
TestFuncResultVariantString;
TestFuncResultVariantObject;
TestFuncArgMethod_Boolean;
TestFuncArgMethod_Integer;
exit;
JSElem:=JSDocument.getElementById('playground');
@ -473,7 +512,7 @@ begin
end;
procedure TWasmApp.TestFuncResultVariantStrings;
procedure TWasmApp.TestFuncResultVariantString;
var
Value: Variant;
us: UnicodeString;
@ -592,6 +631,37 @@ begin
AssertEqual('Bird.Echo(Lisa)',Lisa,Bart);
end;
procedure TWasmApp.TestFuncArgMethod_Boolean;
var
v: Boolean;
begin
Prefix:='TWasmApp.TestFuncArgMethod_Boolean';
Bird.Name:='TestFuncArgMethod_Boolean';
v:=Bird.EchoBoolean(true,@OnBirdCallBoolean);
AssertEqual('Bird.EchoBoolean(true,...)',true,v);
v:=Bird.EchoBoolean(false,@OnBirdCallBoolean);
AssertEqual('Bird.EchoBoolean(false,...)',false,v);
end;
procedure TWasmApp.TestFuncArgMethod_Integer;
var
v: Integer;
begin
Prefix:='TWasmApp.TestFuncArgMethod_Integer';
Bird.Name:='TestFuncArgMethod_Integer';
v:=Bird.EchoInteger(13,@OnBirdCallInteger);
AssertEqual('Bird.EchoInteger(13,...)',13,v);
v:=Bird.EchoInteger(low(longint),@OnBirdCallInteger);
AssertEqual('Bird.EchoInteger(low(longint),...)',low(longint),v);
v:=Bird.EchoInteger(high(longint),@OnBirdCallInteger);
AssertEqual('Bird.EchoInteger(high(longint),...)',high(longint),v);
end;
procedure TWasmApp.Fail(const Msg: string);
begin
writeln('TWasmApp.Fail ',Prefix+': '+Msg);
@ -708,6 +778,32 @@ begin
Result:=InvokeJSVariantResult('Echo',[v]);
end;
function TJSBird.EchoBoolean(const v: Boolean; const Call: TBirdCallBoolean
): Boolean;
var
m: TJOB_Method;
begin
m:=TJOB_Method.Create(TMethod(Call),@JOBCallTBirdCallBoolean);
try
Result:=InvokeJSBooleanResult('EchoCall',[v,m]);
finally
m.Free;
end;
end;
function TJSBird.EchoInteger(const v: integer; const Call: TBirdCallInteger
): integer;
var
m: TJOB_Method;
begin
m:=TJOB_Method.Create(TMethod(Call),@JOBCallTBirdCallInteger);
try
Result:=InvokeJSLongIntResult('EchoCall',[v,m]);
finally
m.Free;
end;
end;
function TJSBird.GetCaption: UnicodeString;
begin
Result:=ReadJSPropertyUnicodeString('Caption');