pastojs: helper: default array property

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@41252 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 175 insertions, 26 deletions

diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index db4ceda242..a5fd67a876 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -8711,33 +8711,35 @@ var
     aResolver:=AContext.Resolver;
     Call:=nil;
     try
+      // find getter/setter
       case AContext.Access of
       caAssign:
-        begin
         AccessEl:=aResolver.GetPasPropertySetter(Prop);
-        if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
-          exit;
-        if aResolver.IsHelperMethod(AccessEl) then
-          Call:=CreateCallHelperMethod(TPasProcedure(AccessEl),El.Value,AContext)
-        else
-          Call:=CreateCallExpression(El);
-        AssignContext:=AContext.AccessContext as TAssignContext;
-        AssignContext.PropertyEl:=Prop;
-        AssignContext.Call:=Call;
-        end;
       caRead:
-        begin
         AccessEl:=aResolver.GetPasPropertyGetter(Prop);
-        if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
-          exit;
-        if aResolver.IsHelperMethod(AccessEl) then
+      else
+        RaiseNotSupported(El,AContext,20170213213317);
+      end;
+      if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
+        exit;
+
+      // create call
+      if aResolver.IsHelperMethod(AccessEl) then
+        begin
+        if CheckPath then
           Call:=CreateCallHelperMethod(TPasProcedure(AccessEl),El.Value,AContext)
         else
-          Call:=CreateCallExpression(El);
+          Call:=CreateCallHelperMethod(TPasProcedure(AccessEl),El,AContext)
         end
       else
-        RaiseNotSupported(El,AContext,20170213213317);
-      end;
+        Call:=CreateCallExpression(El);
+
+      if AContext.Access=caAssign then
+        begin
+        AssignContext:=AContext.AccessContext as TAssignContext;
+        AssignContext.PropertyEl:=Prop;
+        AssignContext.Call:=Call;
+        end;
 
       if CheckPath and (Call.Expr=nil) then
         if aResolver.IsNameExpr(El.Value) then
@@ -8839,27 +8841,29 @@ var
     Left, Right: TJSElement;
     OldAccess: TCtxAccess;
     AccessEl, SetAccessEl: TPasElement;
+    aResolver: TPas2JSResolver;
   begin
+    aResolver:=AContext.Resolver;
     case AContext.Access of
     caAssign:
       begin
-      AccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
+      AccessEl:=aResolver.GetPasPropertySetter(Prop);
       if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
         exit;
       end;
     caRead:
       begin
-      AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
+      AccessEl:=aResolver.GetPasPropertyGetter(Prop);
       if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
         exit;
       end;
     caByReference:
       begin
-      AccessEl:=AContext.Resolver.GetPasPropertyGetter(Prop);
-      SetAccessEl:=AContext.Resolver.GetPasPropertySetter(Prop);
-      if AContext.Resolver.IsExternalBracketAccessor(AccessEl) then
+      AccessEl:=aResolver.GetPasPropertyGetter(Prop);
+      SetAccessEl:=aResolver.GetPasPropertySetter(Prop);
+      if aResolver.IsExternalBracketAccessor(AccessEl) then
         begin
-        if AContext.Resolver.IsExternalBracketAccessor(SetAccessEl) then
+        if aResolver.IsExternalBracketAccessor(SetAccessEl) then
           begin
           // read and write are brackets -> easy
           if not IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,false) then
@@ -8873,6 +8877,12 @@ var
       RaiseNotSupported(El,AContext,20170402233834);
     end;
 
+    if aResolver.IsHelperMethod(AccessEl) then
+      begin
+      ConvertIndexedProperty(Prop,AContext,false);
+      exit;
+      end;
+
     DotContext:=nil;
     Left:=nil;
     Right:=nil;
@@ -16977,6 +16987,7 @@ begin
   SelfScope:=nil;
   PosEl:=Expr;
   Ref:=nil;
+  Prop:=nil;
   Left:=nil;
   SelfJS:=nil;
   Call:=nil;
@@ -17021,6 +17032,17 @@ begin
           end;
         end;
       end
+    else if Expr is TParamsExpr then
+      begin
+      PosEl:=Expr;
+      if not (Expr.CustomData is TResolvedReference) then
+        RaiseNotSupported(Expr,AContext,20190208105144);
+      Ref:=TResolvedReference(PosEl.CustomData);
+      if Ref.Declaration.ClassType<>TPasProperty then
+        RaiseNotSupported(Expr,AContext,20190208105222);
+      Left:=TParamsExpr(Expr).Value;
+      aResolver.ComputeElement(Left,LeftResolved,[]);
+      end
     else
       begin
       RaiseNotSupported(Expr,AContext,20190201163210);
@@ -17029,7 +17051,6 @@ begin
 
     LoTypeEl:=LeftResolved.LoTypeEl;
     IdentEl:=LeftResolved.IdentEl;
-    Prop:=nil;
     IsConstructorNormalCall:=false;
     if Ref<>nil then
       begin
diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas
index 27f7f61a2d..d641cf1027 100644
--- a/packages/pastojs/tests/tcmodules.pas
+++ b/packages/pastojs/tests/tcmodules.pas
@@ -639,7 +639,8 @@ type
     Procedure TestClassHelper_InheritedObjFPC;
     Procedure TestClassHelper_Property;
     Procedure TestClassHelper_Property_Array;
-    //Procedure TestClassHelper_Property_Array_Default;
+    Procedure TestClassHelper_Property_Array_Default;
+    Procedure TestClassHelper_Property_Array_DefaultDefault;
     // todo: TestClassHelper_ClassProperty  static/nonstatic
     // todo: TestClassHelper_ClassProperty_Array
     // todo: TestClassHelper_Overload
@@ -19655,6 +19656,133 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClassHelper_Property_Array_Default;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function GetSpeed(Index: boolean): word;',
+  '    procedure SetSpeed(Index: boolean; Value: word);',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    property Speed[Index: boolean]: word read GetSpeed write SetSpeed; default;',
+  '  end;',
+  '  TBird = class',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '    function GetSize(Index: word): boolean;',
+  '    procedure SetSize(Index: word; Value: boolean);',
+  '    property Size[Index: word]: boolean read GetSize write SetSize; default;',
+  '  end;',
+  'function Tobject.GetSpeed(Index: boolean): word;',
+  'begin',
+  '  Self[true]:=Self[false]+1;',
+  'end;',
+  'procedure Tobject.SetSpeed(Index: boolean; Value: word);',
+  'begin',
+  'end;',
+  'function TBirdHelper.GetSize(Index: word): boolean;',
+  'begin',
+  '  Self[1]:=not Self[2];',
+  'end;',
+  'procedure TBirdHelper.SetSize(Index: word; Value: boolean);',
+  'begin',
+  'end;',
+  'var',
+  '  o: TObject;',
+  '  b: TBird;',
+  'begin',
+  '  o[true]:=o[false]+1;',
+  '  b[3]:=not b[4];',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClassHelper_Property_Array_Default',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetSpeed = function (Index) {',
+    '    var Result = 0;',
+    '    this.SetSpeed(true, this.GetSpeed(false) + 1);',
+    '    return Result;',
+    '  };',
+    '  this.SetSpeed = function (Index, Value) {',
+    '  };',
+    '});',
+    'rtl.createHelper($mod, "TObjHelper", null, function () {',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '});',
+    'rtl.createHelper($mod, "TBirdHelper", null, function () {',
+    '  this.GetSize = function (Index) {',
+    '    var Result = false;',
+    '    $mod.TBirdHelper.SetSize.apply(this, 1, !$mod.TBirdHelper.GetSize.apply(this, 2));',
+    '    return Result;',
+    '  };',
+    '  this.SetSize = function (Index, Value) {',
+    '  };',
+    '});',
+    'this.o = null;',
+    'this.b = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.o.SetSpeed(true, $mod.o.GetSpeed(false) + 1);',
+    '$mod.TBirdHelper.SetSize.apply($mod.b, 3, !$mod.TBirdHelper.GetSize.apply($mod.b, 4));',
+    '']));
+end;
+
+procedure TTestModule.TestClassHelper_Property_Array_DefaultDefault;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    function GetItems(Index: word): TObject;',
+  '    procedure SetItems(Index: word; Value: TObject);',
+  '    property Items[Index: word]: TObject read GetItems write SetItems; default;',
+  '  end;',
+  'function Tobjhelper.GetItems(Index: word): TObject;',
+  'begin',
+  '  Self[1][2]:=Self[3][4];',
+  'end;',
+  'procedure Tobjhelper.SetItems(Index: word; Value: TObject);',
+  'begin',
+  'end;',
+  'var',
+  '  o: TObject;',
+  'begin',
+  '  o[1][2]:=o[3][4];',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClassHelper_Property_Array_DefaultDefault',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createHelper($mod, "TObjHelper", null, function () {',
+    '  this.GetItems = function (Index) {',
+    '    var Result = null;',
+    '    $mod.TObjHelper.SetItems.apply($mod.TObjHelper.GetItems.apply(this, 1), 2, $mod.TObjHelper.GetItems.apply($mod.TObjHelper.GetItems.apply(this, 3), 4));',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Index, Value) {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.TObjHelper.SetItems.apply($mod.TObjHelper.GetItems.apply($mod.o, 1), 2, $mod.TObjHelper.GetItems.apply($mod.TObjHelper.GetItems.apply($mod.o, 3), 4));',
+    '']));
+end;
+
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);