diff --git a/demo/wasienv/dom/WasiDomTest1.lpr b/demo/wasienv/dom/WasiDomTest1.lpr index fd108b8..574468d 100644 --- a/demo/wasienv/dom/WasiDomTest1.lpr +++ b/demo/wasienv/dom/WasiDomTest1.lpr @@ -53,6 +53,7 @@ type TJSBird = class(TJSObject,IJSBird) private public + class function Cast(Intf: IJSObject): IJSBird; overload; // functions procedure IncSize; function CreateBird(const aName: string): IJSBird; @@ -121,22 +122,19 @@ type procedure TestFuncResultUTF8String; procedure TestFuncResultObject; procedure TestFuncResultVariant; - procedure TestFuncResultVariantNumbers; + procedure TestFuncResultVariantNumber; procedure TestFuncResultVariantStrings; + procedure TestFuncResultVariantObject; // function args - // todo procedure TestFuncArgBoolean; - // todo procedure TestFuncArgInteger; - // todo procedure TestFuncArgDouble; - // todo procedure TestFuncArgUnicodeString; - // todo procedure TestFuncArgUTF8String; - // todo procedure TestFuncArgBird; // todo procedure TestFuncArgMethod; - // todo procedure TestFuncArgVariant; // dictionaries // arrays + // todo: TestFuncResultVariantArray + // todo: TestFuncResultDoubleArray + // todo: TestFuncResultUnicodeStringArray end; @@ -160,6 +158,9 @@ var begin Bird:=TJSBird.JOBCreateGlobal('Bird') as IJSBird; + TestFuncResultVariantObject; + exit; + TestBooleanProperty; TestIntegerProperty; TestDoubleProperty; @@ -175,8 +176,9 @@ begin TestFuncResultUTF8String; TestFuncResultObject; TestFuncResultVariant; - TestFuncResultVariantNumbers; + TestFuncResultVariantNumber; TestFuncResultVariantStrings; + TestFuncResultVariantObject; exit; @@ -388,11 +390,10 @@ begin Prefix:='TWasmApp.TestFuncResultVariant'; Bird.Name:='TestFuncResultVariant'; - Value:=Bird.Echo(nil); - AssertEqual('Bird.Echo(nil) VarType',varOleStr,VarType(Value)); - //ToDo: add a simple widestringmanager - //if Value<>nil then - // Fail('Bird.Echo(nil)'); + Value:=Bird.Echo(Variants.Null); + AssertEqual('Bird.Echo(Variant.Null) VarType',varNull,VarType(Value)); + if Value<>Variants.Null then + Fail('Bird.Echo(Variant.Null)'); Value:=Bird.Echo(true); AssertEqual('Bird.Echo(true) VarType',varBoolean,VarType(Value)); @@ -403,12 +404,12 @@ begin AssertEqual('Bird.Echo(false)',false,Value); end; -procedure TWasmApp.TestFuncResultVariantNumbers; +procedure TWasmApp.TestFuncResultVariantNumber; var Value: Variant; begin - Prefix:='TWasmApp.TestFuncResultVariantNumbers'; - Bird.Name:='TestFuncResultVariantNumbers'; + Prefix:='TWasmApp.TestFuncResultVariantNumber'; + Bird.Name:='TestFuncResultVariantNumber'; Value:=Bird.Echo(0); AssertEqual('Bird.Echo(0) VarType',varDouble,VarType(Value)); @@ -458,24 +459,130 @@ begin Value:=Bird.Echo(NegInfinity); AssertEqual('Bird.Echo(NegInfinity) VarType',varDouble,VarType(Value)); AssertEqual('Bird.Echo(NegInfinity)',double(NegInfinity),Value); + + Value:=Bird.Echo(0.3); + AssertEqual('Bird.Echo(0.3) VarType',varDouble,VarType(Value)); + AssertEqual('Bird.Echo(0.3)',double(0.3),Value); + end; procedure TWasmApp.TestFuncResultVariantStrings; var Value: Variant; + us: UnicodeString; + s, h: string; begin - Prefix:='TWasmApp.TestFuncResultVariantStrings'; - Bird.Name:='TestFuncResultVariantStrings'; + Prefix:='TWasmApp.TestFuncResultVariantString'; + Bird.Name:='TestFuncResultVariantString'; // literals - //Value:=Bird.Echo(''); - //AssertEqual('Bird.Echo(0) VarType',varDouble,VarType(Value)); - //AssertEqual('Bird.Echo(0)',0,Value); + Value:=Bird.Echo(''); + AssertEqual('Bird.Echo('''') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo('''')','',Value); + + Value:=Bird.Echo('a'); + AssertEqual('Bird.Echo(''a'') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(''a'')','a',Value); + + Value:=Bird.Echo('abc'); + AssertEqual('Bird.Echo(''abc'') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(''abc'')','abc',Value); + + Value:=Bird.Echo(#13); + AssertEqual('Bird.Echo(#13) VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(#13)',#13,Value); + + Value:=Bird.Echo('ä'); + AssertEqual('Bird.Echo(''ä'') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(''ä'')','ä',Value); + + Value:=Bird.Echo('🎉'); + AssertEqual('Bird.Echo(''🎉'') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(''🎉'')','🎉',Value); // unicodestring + us:=''; + Value:=Bird.Echo(us); + AssertEqual('Bird.Echo(us:='''') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(us:='''')','',Value); + + us:='a'; + Value:=Bird.Echo(us); + AssertEqual('Bird.Echo(us:=''a'') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(us:=''a'')','a',Value); + + us:='abc'; + Value:=Bird.Echo(us); + AssertEqual('Bird.Echo(us:=''abc'') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(us:=''abc'')','abc',Value); + + us:=#13; + Value:=Bird.Echo(us); + AssertEqual('Bird.Echo(us:=#13) VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(us:=#13)',#13,Value); + + us:='ä'; + Value:=Bird.Echo(us); + AssertEqual('Bird.Echo(us:=''ä'') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(us:=''ä'')','ä',Value); + + us:='🤯'; + Value:=Bird.Echo(us); + AssertEqual('Bird.Echo(us:=''🤯'') VarType',varOleStr,VarType(Value)); + AssertEqualUS('Bird.Echo(us:=''🤯'')','🤯',Value); // ansistring + s:=''; + Value:=Bird.Echo(s); + AssertEqual('Bird.Echo(s:='''') VarType',varOleStr,VarType(Value)); + AssertEqual('Bird.Echo(s:='''')','',Value); + s:='a'; + Value:=Bird.Echo(s); + AssertEqual('Bird.Echo(s:=''a'') VarType',varOleStr,VarType(Value)); + AssertEqual('Bird.Echo(s:=''a'')','a',Value); + + s:='abc'; + Value:=Bird.Echo(s); + AssertEqual('Bird.Echo(s:=''abc'') VarType',varOleStr,VarType(Value)); + AssertEqual('Bird.Echo(s:=''abc'')','abc',Value); + + s:=#13; + Value:=Bird.Echo(s); + AssertEqual('Bird.Echo(s:=#13) VarType',varOleStr,VarType(Value)); + AssertEqual('Bird.Echo(s:=#13)',#13,Value); + + s:='ä'; + Value:=Bird.Echo(UTF8Decode(s)); + AssertEqual('Bird.Echo(s:=''ä'') VarType',varOleStr,VarType(Value)); + h:=UTF8Encode(Value); + AssertEqual('Bird.Echo(s:=''ä'')',s,h); + + s:='🤯'; + Value:=Bird.Echo(UTF8Decode(s)); + AssertEqual('Bird.Echo(s:=''🤯'') VarType',varOleStr,VarType(Value)); + h:=UTF8Encode(Value); + AssertEqual('Bird.Echo(s:=''🤯'')',s,h); +end; + +procedure TWasmApp.TestFuncResultVariantObject; +var + Value: Variant; + Lisa, Bart: IJSBird; +begin + Prefix:='TWasmApp.TestFuncResultVariantObject'; + Bird.Name:='TestFuncResultVariantObject'; + + Lisa:=nil; + Value:=Bird.Echo(Lisa); + AssertEqual('Bird.Echo(Lisa:=nil) VarType',varNull,VarType(Value)); + + Lisa:=Bird.CreateBird('Lisa'); + AssertEqual('Lisa','TestFuncResultVariantObject.Lisa',Lisa.Name); + Value:=Bird.Echo(Lisa); + AssertEqual('Bird.Echo(Lisa) VarType',varUnknown,VarType(Value)); + Bart:=TJSBird.Cast(Value); + AssertEqual('Bird.Echo(Lisa)',Lisa,Bart); end; procedure TWasmApp.Fail(const Msg: string); @@ -544,6 +651,11 @@ end; { TBird } +class function TJSBird.Cast(Intf: IJSObject): IJSBird; +begin + Result:=TJSBird.JOBCast(Intf); +end; + procedure TJSBird.IncSize; begin InvokeJSNoResult('IncSize',[]); diff --git a/demo/wasienv/dom/job_js.pas b/demo/wasienv/dom/job_js.pas index e11b0fc..702ac99 100644 --- a/demo/wasienv/dom/job_js.pas +++ b/demo/wasienv/dom/job_js.pas @@ -323,6 +323,7 @@ type function ReadJSPropertyLongInt(const aName: string): LongInt; virtual; function ReadJSPropertyInt64(const aName: string): Int64; virtual; function ReadJSPropertyValue(const aName: string): TJOB_JSValue; virtual; + function ReadJSPropertyVariant(const aName: string): Variant; virtual; // write a property procedure WriteJSPropertyBoolean(const aName: string; Value: Boolean); virtual; procedure WriteJSPropertyDouble(const aName: string; Value: Double); virtual; @@ -332,6 +333,7 @@ type procedure WriteJSPropertyLongInt(const aName: string; Value: LongInt); virtual; procedure WriteJSPropertyInt64(const aName: string; Value: Int64); virtual; procedure WriteJSPropertyValue(const aName: string; Value: TJOB_JSValue); virtual; + procedure WriteJSPropertyVariant(const aName: string; const Value: Variant); virtual; // create a new object using the new-operator function NewJSObject(Const Args: Array of const; aResultClass: TJSObjectClass): TJSObject; virtual; // JS members @@ -2592,6 +2594,8 @@ var var v: Variant; t: tvartype; + us: UnicodeString; + Intf: IJSObject; begin v:=Args[Index].VVariant^; t:=VarType(v); @@ -2606,16 +2610,25 @@ var AddDouble(v); varOleStr: begin - if tvardata(v).volestr=nil then - Prep(1,JOBArgNil) - else - raise EJSInvoke.Create('Invoke js: [20220820185118] unsupported variant: '+IntToStr(t)); + us:=v; + AddUnicodeString(us); end; varBoolean: if v then Prep(1,JOBArgTrue) else Prep(1,JOBArgFalse); + varString: + AddUTF8String(v); + varUnknown: + begin + if tvardata(v).vunknown=nil then + Prep(1,JOBArgNil) + else if VarSupports(v,IJSObject,Intf) then + AddObjectID(Intf.GetJSObjectID) + else + raise EJSInvoke.Create('Invoke js: [20220820210022] unsupported variant: '+IntToStr(t)); + end else raise EJSInvoke.Create('Invoke js: [20220820185131] unsupported variant: '+IntToStr(t)); end; @@ -2929,7 +2942,7 @@ begin JOBResult_Undefined: Result:=Variants.Unassigned; JOBResult_Null: - Result:=nil; + Result:=Variants.Null; JOBResult_Boolean: Result:=p^<>0; JOBResult_Double: @@ -3043,6 +3056,11 @@ begin Result:=InvokeJSValueResult(aName,[],jiGet); end; +function TJSObject.ReadJSPropertyVariant(const aName: string): Variant; +begin + Result:=InvokeJSVariantResult(aName,[],jiGet); +end; + procedure TJSObject.WriteJSPropertyBoolean(const aName: string; Value: Boolean); begin InvokeJSNoResult(aName,[Value],jiSet); @@ -3087,6 +3105,12 @@ begin InvokeJSNoResult(aName,[Value],jiSet); end; +procedure TJSObject.WriteJSPropertyVariant(const aName: string; + const Value: Variant); +begin + InvokeJSNoResult(aName,[Value],jiSet); +end; + function TJSObject.NewJSObject(const Args: array of const; aResultClass: TJSObjectClass): TJSObject; begin diff --git a/packages/job/job_browser.pp b/packages/job/job_browser.pp index 2e9cf59..859e283 100644 --- a/packages/job/job_browser.pp +++ b/packages/job/job_browser.pp @@ -385,18 +385,18 @@ var NewId: TJOBObjectID; begin {$IFDEF VerboseJOB} - writeln('TJOBBridge.Invoke_JSValueResult START'); + writeln('TJSObjectBridge.Invoke_JSValueResult START'); {$ENDIF} // invoke Result:=Invoke_JSResult(ObjId,NameP,NameLen,Invoke,ArgsP,JSResult); {$IFDEF VerboseJOB} - writeln('TJOBBridge.Invoke_JSValueResult JSResult=',JSResult); + writeln('TJSObjectBridge.Invoke_JSValueResult JSResult=',JSResult); {$ENDIF} if Result<>JOBResult_Success then exit; Result:=GetJOBResult(JSResult); {$IFDEF VerboseJOB} - writeln('TJOBBridge.Invoke_JSValueResult Type=',Result); + writeln('TJSObjectBridge.Invoke_JSValueResult Type=',Result); {$ENDIF} // set result case Result of