diff --git a/demo/wasienv/dom/BrowserDomTest1.lpr b/demo/wasienv/dom/BrowserDomTest1.lpr index ad7cf6c..4ad7c47 100644 --- a/demo/wasienv/dom/BrowserDomTest1.lpr +++ b/demo/wasienv/dom/BrowserDomTest1.lpr @@ -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; diff --git a/demo/wasienv/dom/WasiDomTest1.lpr b/demo/wasienv/dom/WasiDomTest1.lpr index 019e880..0fef242 100644 --- a/demo/wasienv/dom/WasiDomTest1.lpr +++ b/demo/wasienv/dom/WasiDomTest1.lpr @@ -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'); diff --git a/demo/wasienv/dom/job_js.pas b/demo/wasienv/dom/job_js.pas index 3bf519c..a12182b 100644 --- a/demo/wasienv/dom/job_js.pas +++ b/demo/wasienv/dom/job_js.pas @@ -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; diff --git a/packages/job/job_browser.pp b/packages/job/job_browser.pp index 859e283..fc3394e 100644 --- a/packages/job/job_browser.pp +++ b/packages/job/job_browser.pp @@ -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