wasmjob: started tests

demo/wasienv/dom/BrowserDomTest1.lpr

@@ -15,14 +15,17 @@ Type
     procedure Proc;
     function ArgsToStr(Args: TJSFunctionArguments): string;
   published
+    Enabled: boolean;
+    Scale: double;
     Size: integer;
     Name: string;
     Child: TBird;
     function GetBoolean: boolean;
     function GetDouble: double;
-    function GetString: string;
     function GetInteger: integer;
-    function CreateChick(const aName: string): TBird;
+    function GetString: string;
+    function GetBird: TBird;
+    function CreateBird(const aName: string): TBird;
   end;
 
   { TMyApplication }
@@ -50,7 +53,8 @@ begin
     GetDouble;
     GetInteger;
     GetString;
-    CreateChick('');
+    GetBird;
+    CreateBird('');
   end;
 end;
 
@@ -62,32 +66,36 @@ end;
 function TBird.GetBoolean: boolean;
 begin
   writeln('TBird.GetBoolean [',Name,'] ',ArgsToStr(JSArguments));
-  Result:=JSArguments.Length mod 1 = 0;
+  Result:=Enabled;
 end;
 
 function TBird.GetDouble: double;
 begin
   writeln('TBird.GetDouble [',Name,'] ',ArgsToStr(JSArguments));
-  Result:=0.3+JSArguments.Length;
+  Result:=Scale;
 end;
 
 function TBird.GetString: string;
 begin
   writeln('TBird.GetString [',Name,'] ',ArgsToStr(JSArguments));
-  Result:='TBird.GetString:'+str(JSArguments.Length);
-  if JSArguments.Length>0 then
-    Result:=Result+String(JSArguments[0]);
+  Result:=Name;
+end;
+
+function TBird.GetBird: TBird;
+begin
+  writeln('TBird.GetBird [',Name,'] ',ArgsToStr(JSArguments));
+  Result:=Child;
 end;
 
 function TBird.GetInteger: integer;
 begin
   writeln('TBird.GetInteger [',Name,'] ',ArgsToStr(JSArguments));
-  Result:=3000+JSArguments.Length;
+  Result:=Size;
 end;
 
-function TBird.CreateChick(const aName: string): TBird;
+function TBird.CreateBird(const aName: string): TBird;
 begin
-  writeln('TBird.CreateChick [',Name,'] ',ArgsToStr(JSArguments));
+  writeln('TBird.CreateBird [',Name,'] ',ArgsToStr(JSArguments));
   Result:=TBird.Create(Name+'.'+aName);
 end;
 

demo/wasienv/dom/WasiDomTest1.lpr

@@ -3,28 +3,69 @@ library WasiDomTest1;
 {$mode objfpc}
 {$h+}
 {$codepage UTF8}
+{$WARN 5028 off : Local $1 "$2" is not used}
 
 uses
   SysUtils, JOB_Shared, JOB_Web, JOB_JS;
 
 type
+  EWasiTest = class(Exception);
 
-  { TBird }
+  TJSBird = class;
 
-  TBird = class(TJSObject)
-  private
+  { IJSBird }
+
+  IJSBird = interface(IJSObject)
+    ['{BABEA093-411B-4E30-8C56-53C11060BF5D}']
+    // functions
+    function CreateBird(const aName: string): IJSBird;
+    // properties
+    function GetCaption: UnicodeString;
+    function GetEnabled: boolean;
     function GetName: string;
-    function GetChild: TBird;
+    function GetChild: IJSBird;
+    function GetScale: double;
     function GetSize: integer;
+    procedure SetCaption(const AValue: UnicodeString);
+    procedure SetEnabled(const AValue: boolean);
     procedure SetName(const AValue: string);
-    procedure SetChild(const AValue: TBird);
+    procedure SetChild(const AValue: IJSBird);
+    procedure SetScale(const AValue: double);
     procedure SetSize(const AValue: integer);
+    property Enabled: boolean read GetEnabled write SetEnabled;
+    property Name: string read GetName write SetName;
+    property Caption: UnicodeString read GetCaption write SetCaption;
+    property Size: integer read GetSize write SetSize;
+    property Scale: double read GetScale write SetScale;
+    property Child: IJSBird read GetChild write SetChild;
+  end;
+
+  { TJSBird }
+
+  TJSBird = class(TJSObject,IJSBird)
+  private
   public
-    function GetDouble: double;
-    function GetInteger: integer;
+    // functions
+    function CreateBird(const aName: string): IJSBird;
+    // properties
+    function GetCaption: UnicodeString;
+    function GetEnabled: boolean;
+    function GetName: string;
+    function GetChild: IJSBird;
+    function GetScale: double;
+    function GetSize: integer;
+    procedure SetCaption(const AValue: UnicodeString);
+    procedure SetEnabled(const AValue: boolean);
+    procedure SetName(const AValue: string);
+    procedure SetChild(const AValue: IJSBird);
+    procedure SetScale(const AValue: double);
+    procedure SetSize(const AValue: integer);
+    property Enabled: boolean read GetEnabled write SetEnabled;
     property Name: string read GetName write SetName;
+    property Caption: UnicodeString read GetCaption write SetCaption;
     property Size: integer read GetSize write SetSize;
-    property Child: TBird read GetChild write SetChild;
+    property Scale: double read GetScale write SetScale;
+    property Child: IJSBird read GetChild write SetChild;
   end;
 
   { TWasmApp }
@@ -33,9 +74,20 @@ type
   private
     function OnPlaygroundClick(Event: IJSEvent): boolean;
   public
+    Prefix: string;
+    Bird: IJSBird;
     procedure Run;
+    procedure TestBooleanProperty;
+    procedure TestIntegerProperty;
+    procedure Fail(const Msg: string);
+    procedure AssertEqual(const Msg: string; const Expected, Actual: boolean);
+    procedure AssertEqual(const Msg: string; const Expected, Actual: integer);
+    procedure AssertEqual(const Msg: string; const Expected, Actual: double);
+    procedure AssertEqual(const Msg: string; const Expected, Actual: String);
+    procedure AssertEqual(const Msg: string; const Expected, Actual: UnicodeString);
   end;
 
+
 { TApplication }
 
 function TWasmApp.OnPlaygroundClick(Event: IJSEvent): boolean;
@@ -52,11 +104,14 @@ end;
 
 procedure TWasmApp.Run;
 var
-  obj: TJSObject;
-  Freddy, Alice, aBird: TBird;
-  JSValue: TJOB_JSValue;
   JSElem: IJSElement;
 begin
+  Bird:=TJSBird.JOBCreateGlobal('Bird') as IJSBird;
+  TestBooleanProperty;
+  TestIntegerProperty;
+
+  exit;
+
   JSElem:=JSDocument.getElementById('playground');
   writeln('TWasmApp.Run playground classname=',JSElem.className_);
 
@@ -66,7 +121,7 @@ begin
 
   exit;
 
-  obj:=TJSObject.JOBCreateGlobal('Bird');
+ { obj:=TJSObject.JOBCreateGlobal('Bird');
   obj.WriteJSPropertyUnicodeString('Caption','Root');
   writeln('AAA1 ');
   //u:='äbc';
@@ -74,11 +129,11 @@ begin
   //obj.InvokeJSNoResult('Proc',[]);
   //d:=obj.InvokeJSDoubleResult('GetDouble',[u,12345678901]);
   writeln('Create Freddy...');
-  Freddy:=obj.InvokeJSObjectResult('CreateChick',['Freddy'],TBird) as TBird;
+  Freddy:=obj.InvokeJSObjectResult('CreateChick',['Freddy'],TJSBird) as TJSBird;
   writeln('AAA5 ',Freddy.Name);
 
   writeln('Create Alice...');
-  Alice:=obj.InvokeJSObjectResult('CreateChick',['Alice'],TBird) as TBird;
+  Alice:=obj.InvokeJSObjectResult('CreateChick',['Alice'],TJSBird) as TJSBird;
   writeln('Freddy.Child:=Alice...');
   Freddy.Child:=Alice;
   aBird:=Freddy.Child;
@@ -93,49 +148,136 @@ begin
   Freddy.Free;
   writeln('Freeing Alice...');
   Alice.Free;
+}
+end;
+
+procedure TWasmApp.TestBooleanProperty;
+begin
+  Prefix:='TWasmApp.TestBoolean';
+  Bird.Enabled:=true;
+  AssertEqual('Bird.Enabled:=true',true,Bird.Enabled);
+  Bird.Enabled:=false;
+  AssertEqual('Bird.Enabled:=false',false,Bird.Enabled);
+end;
+
+procedure TWasmApp.TestIntegerProperty;
+begin
+  Prefix:='TWasmApp.TestInteger;';
+  Bird.Size:=3;
+  AssertEqual('Bird.Size:=3',3,Bird.Size);
+  Bird.Size:=-13;
+  AssertEqual('Bird.Size:=-13',-13,Bird.Size);
+  Bird.Size:=High(longint);
+  AssertEqual('Bird.Size:=High(longint)',High(longint),Bird.Size);
+  Bird.Size:=Low(longint);
+  AssertEqual('Bird.Size:=Low(longint)',Low(longint),Bird.Size);
+end;
+
+procedure TWasmApp.Fail(const Msg: string);
+begin
+  raise EWasiTest.Create(Prefix+': '+Msg);
+end;
+
+procedure TWasmApp.AssertEqual(const Msg: string; const Expected,
+  Actual: boolean);
+begin
+  if Expected=Actual then exit;
+  Fail(Msg+'. Expected '+BoolToStr(Expected,'True','False')+', but got '+BoolToStr(Actual,'True','False'));
+end;
+
+procedure TWasmApp.AssertEqual(const Msg: string; const Expected,
+  Actual: integer);
+begin
+  if Expected=Actual then exit;
+  Fail(Msg+'. Expected '+IntToStr(Expected)+', but got '+IntToStr(Actual));
+end;
+
+procedure TWasmApp.AssertEqual(const Msg: string; const Expected, Actual: double
+  );
+begin
+  if Expected=Actual then exit;
+  Fail(Msg+'. Expected '+FloatToStr(Expected)+', but got '+FloatToStr(Actual));
+end;
 
+procedure TWasmApp.AssertEqual(const Msg: string; const Expected, Actual: String
+  );
+begin
+  if Expected=Actual then exit;
+  Fail(Msg+'. Expected "'+Expected+'", but got "'+Actual+'"');
+end;
+
+procedure TWasmApp.AssertEqual(const Msg: string; const Expected,
+  Actual: UnicodeString);
+begin
+  if Expected=Actual then exit;
+  Fail(Msg+'. Expected "'+string(Expected)+'", but got "'+string(Actual)+'"');
 end;
 
 { TBird }
 
-function TBird.GetName: string;
+function TJSBird.CreateBird(const aName: string): IJSBird;
+begin
+  Result:=InvokeJSObjectResult('CreateBird',[aName],TJSBird) as IJSBird;
+end;
+
+function TJSBird.GetCaption: UnicodeString;
+begin
+  Result:=ReadJSPropertyUnicodeString('Caption');
+end;
+
+procedure TJSBird.SetCaption(const AValue: UnicodeString);
+begin
+  WriteJSPropertyUnicodeString('Caption',AValue);
+end;
+
+function TJSBird.GetEnabled: boolean;
+begin
+  Result:=ReadJSPropertyBoolean('Enabled');
+end;
+
+procedure TJSBird.SetEnabled(const AValue: boolean);
+begin
+  WriteJSPropertyBoolean('Enabled',AValue);
+end;
+
+function TJSBird.GetName: string;
 begin
   Result:=ReadJSPropertyUtf8String('Name');
 end;
 
-function TBird.GetChild: TBird;
+function TJSBird.GetChild: IJSBird;
 begin
-  Result:=ReadJSPropertyObject('Child',TBird) as TBird;
+  Result:=ReadJSPropertyObject('Child',TJSBird) as IJSBird;
 end;
 
-function TBird.GetSize: integer;
+function TJSBird.GetScale: double;
 begin
-  Result:=ReadJSPropertyLongInt('Size');
+  Result:=ReadJSPropertyDouble('Scale');
 end;
 
-procedure TBird.SetName(const AValue: string);
+function TJSBird.GetSize: integer;
 begin
-  WriteJSPropertyUtf8String('Name',AValue);
+  Result:=ReadJSPropertyLongInt('Size');
 end;
 
-procedure TBird.SetChild(const AValue: TBird);
+procedure TJSBird.SetName(const AValue: string);
 begin
-  WriteJSPropertyObject('Child',AValue);
+  WriteJSPropertyUtf8String('Name',AValue);
 end;
 
-procedure TBird.SetSize(const AValue: integer);
+procedure TJSBird.SetChild(const AValue: IJSBird);
 begin
-  WriteJSPropertyLongInt('Size',AValue);
+  WriteJSPropertyObject('Child',AValue);
 end;
 
-function TBird.GetDouble: double;
+procedure TJSBird.SetScale(const AValue: double);
 begin
-  Result:=InvokeJSDoubleResult('GetDouble',[]);
+  WriteJSPropertyDouble('Scale',AValue);
 end;
 
-function TBird.GetInteger: integer;
+procedure TJSBird.SetSize(const AValue: integer);
 begin
-  Result:=InvokeJSLongIntResult('GetInteger',[]);
+  WriteJSPropertyLongInt('Size',AValue);
 end;
 
 // workaround: fpc wasm does not yet support exporting functions from units

packages/job/job_shared.pp

@@ -56,8 +56,8 @@ const
   JOBFn_InvokeBooleanResult = 'invoke_boolresult';
   JOBFn_InvokeDoubleResult = 'invoke_doubleresult';
   JOBFn_InvokeStringResult = 'invoke_stringresult';
-  JOBFn_InvokeArrayStringResult = 'invoke_arraystringresult';
   JOBFn_GetStringResult = 'get_stringresult';
+  JOBFn_InvokeArrayStringResult = 'invoke_arraystringresult';
   JOBFn_ReleaseStringResult = 'release_stringresult';
   JOBFn_InvokeObjectResult = 'invoke_objectresult';
   JOBFn_ReleaseObject = 'release_object';
@@ -100,13 +100,14 @@ const
 
   JOBInvokeCall = 0; // call function
   JOBInvokeGet = 1; // read property
-  JOBInvokeGetTypeOf = 4; // read property and typeof
-  JOBInvokeSet = 2; // set property
-  JOBInvokeNew = 3; // new operator
+  JOBInvokeGetTypeOf = 2; // read property and typeof
+  JOBInvokeSet = 3; // set property
+  JOBInvokeNew = 4; // new operator
 
-  JOBInvokeNames: array[0..3] of string = (
+  JOBInvokeNames: array[0..4] of string = (
     'Call',
     'Get',
+    'GetTypeOf',
     'Set',
     'New'
     );