pastojs: helper: array property

git-svn-id: trunk@41251 -

packages/fcl-passrc/src/pasresolver.pp

@@ -2004,6 +2004,8 @@ type
     function IsClassField(El: TPasElement): boolean;
     function GetFunctionType(El: TPasElement): TPasFunctionType;
     function IsMethod(El: TPasProcedure): boolean;
+    function IsHelperMethod(El: TPasElement): boolean;
+    function IsHelper(El: TPasElement): boolean;
     function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
     function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
     function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
@@ -15942,7 +15944,8 @@ begin
         if ClassRecScope=nil then
           RaiseInternalError(20190123120156,GetObjName(StartScope));
         TypeEl:=ClassRecScope.Element as TPasType;
-        if (TypeEl.ClassType=TPasClassType) and (TPasClassType(TypeEl).HelperForType<>nil) then
+        if (TypeEl.ClassType=TPasClassType)
+            and (TPasClassType(TypeEl).HelperForType<>nil) then
           TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType);
         TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
         if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
@@ -22084,6 +22087,17 @@ begin
   Result:=IsMethod(ProcScope.DeclarationProc);
 end;
 
+function TPasResolver.IsHelperMethod(El: TPasElement): boolean;
+begin
+  Result:=(El is TPasProcedure) and (El.Parent is TPasClassType)
+          and (TPasClassType(El.Parent).HelperForType<>nil);
+end;
+
+function TPasResolver.IsHelper(El: TPasElement): boolean;
+begin
+  Result:=(El<>nil) and (El.ClassType=TPasClassType) and (TPasClassType(El).HelperForType<>nil);
+end;
+
 function TPasResolver.IsExternalClass_Name(aClass: TPasClassType;
   const ExtName: string): boolean;
 var

packages/pastojs/src/fppas2js.pp

@@ -1806,7 +1806,7 @@ type
     Procedure AddRTLVersionCheck(FuncContext: TFunctionContext; PosEl: TPasElement);
     // create elements for helpers
     Function CreateCallHelperMethod(Proc: TPasProcedure; Expr: TPasExpr;
-      AContext: TConvertContext): TJSElement; virtual;
+      AContext: TConvertContext): TJSCallExpression; virtual;
     // Statements
     Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
     Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
@@ -7301,8 +7301,7 @@ begin
     end;
 
   LeftJS:=nil;
-  if (RightRefDecl.Parent.ClassType=TPasClassType)
-      and (TPasClassType(RightRefDecl.Parent).HelperForType<>nil) then
+  if aResolver.IsHelper(RightRefDecl.Parent) then
     begin
     // LeftJS.HelperMember
     if RightRefDecl is TPasVariable then
@@ -7702,8 +7701,7 @@ begin
         Decl:=aResolver.GetPasPropertySetter(Prop);
         if Decl is TPasProcedure then
           begin
-          if (Decl.Parent is TPasClassType)
-              and (TPasClassType(Decl.Parent).HelperForType<>nil) then
+          if aResolver.IsHelper(Decl.Parent) then
             begin
             Result:=CreateCallHelperMethod(TPasProcedure(Decl),El,AContext);
             exit;
@@ -7772,8 +7770,7 @@ begin
     Call.AddArg(CreateLiteralString(El,TransformVariableName(Decl,AContext)));
     exit;
     end
-  else if (Decl is TPasProcedure) and (Decl.Parent is TPasClassType)
-      and (TPasClassType(Decl.Parent).HelperForType<>nil)
+  else if aResolver.IsHelperMethod(Decl)
       and not (rrfNoImplicitCallWithoutParams in Ref.Flags) then
     begin
     Result:=CreateCallHelperMethod(TPasProcedure(Decl),El,AContext);
@@ -8712,17 +8709,18 @@ var
     Result:=nil;
     AssignContext:=nil;
     aResolver:=AContext.Resolver;
-    Call:=CreateCallExpression(El);
+    Call:=nil;
     try
       case AContext.Access of
       caAssign:
         begin
         AccessEl:=aResolver.GetPasPropertySetter(Prop);
         if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
-          begin
-          FreeAndNil(Call);
           exit;
-          end;
+        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;
@@ -8731,16 +8729,17 @@ var
         begin
         AccessEl:=aResolver.GetPasPropertyGetter(Prop);
         if IsJSBracketAccessorAndConvert(Prop,AccessEl,AContext,true) then
-          begin
-          FreeAndNil(Call);
           exit;
-          end;
+        if aResolver.IsHelperMethod(AccessEl) then
+          Call:=CreateCallHelperMethod(TPasProcedure(AccessEl),El.Value,AContext)
+        else
+          Call:=CreateCallExpression(El);
         end
       else
         RaiseNotSupported(El,AContext,20170213213317);
       end;
 
-      if CheckPath then
+      if CheckPath and (Call.Expr=nil) then
         if aResolver.IsNameExpr(El.Value) then
           // no special context
         else if El.Value is TBinaryExpr then
@@ -8953,12 +8952,11 @@ begin
   writeln('TPasToJSConverter.ConvertArrayParams Value=',GetResolverResultDbg(ResolvedEl));
   {$ENDIF}
   if ResolvedEl.BaseType in btAllJSStrings then
-    // astring[]
+    // aString[]
     ConvertStringBracket(ResolvedEl)
   else if (ResolvedEl.IdentEl is TPasProperty)
-      and (aResolver.IsNameExpr(El.Value) or (El.Value is TBinaryExpr))
       and (aResolver.GetPasPropertyArgs(TPasProperty(ResolvedEl.IdentEl)).Count>0) then
-    // aproperty[]
+    // aProperty[]
     ConvertIndexedProperty(TPasProperty(ResolvedEl.IdentEl),AContext,true)
   else if ResolvedEl.BaseType=btContext then
     begin
@@ -9167,8 +9165,7 @@ begin
       end
     else if C.InheritsFrom(TPasProcedure) then
       begin
-      if (Decl.Parent is TPasClassType)
-          and (TPasClassType(Decl.Parent).HelperForType<>nil) then
+      if aResolver.IsHelper(Decl.Parent) then
         begin
         // calling a helper method
         Result:=CreateCallHelperMethod(TPasProcedure(Decl),El.Value,AContext);
@@ -14038,8 +14035,7 @@ begin
         else
           begin
           ThisPas:=ProcScope.ClassRecScope.Element;
-          if (ThisPas.ClassType=TPasClassType)
-              and (TPasClassType(ThisPas).HelperForType<>nil) then
+          if aResolver.IsHelper(ThisPas) then
             begin
             // helper method
             HelperForType:=aResolver.ResolveAliasType(TPasClassType(ThisPas).HelperForType);
@@ -15471,8 +15467,7 @@ begin
     Result:=CreateReferencePathExpr(Proc,AContext);
     exit;
     end;
-  IsHelper:=(Proc.Parent.ClassType=TPasClassType)
-            and (TPasClassType(Proc.Parent).HelperForType<>nil);
+  IsHelper:=aResolver.IsHelper(Proc.Parent);
   NeedClass:=aResolver.IsClassMethod(Proc);
 
   // an of-object method -> create "rtl.createCallback(Target,func)"
@@ -15870,8 +15865,7 @@ begin
     if (Expr<>nil) then
       begin
       // explicit property read
-      if (Decl.Parent is TPasClassType)
-        and (TPasClassType(Decl.Parent).HelperForType<>nil) then
+      if aResolver.IsHelper(Decl.Parent) then
         begin
         Result:=CreateCallHelperMethod(TPasProcedure(Decl),Expr,AContext);
         exit;
@@ -16919,7 +16913,7 @@ begin
 end;
 
 function TPasToJSConverter.CreateCallHelperMethod(Proc: TPasProcedure;
-  Expr: TPasExpr; AContext: TConvertContext): TJSElement;
+  Expr: TPasExpr; AContext: TConvertContext): TJSCallExpression;
 var
   Left: TPasExpr;
   WithExprScope: TPas2JSWithExprScope;
@@ -17202,6 +17196,13 @@ begin
 
     if Prop<>nil then
       begin
+      if aResolver.GetPasPropertyArgs(Prop).Count>0 then
+        begin
+        // arguments are passed by ConvertParamsExpr
+        Result:=Call;
+        Call:=nil;
+        exit;
+        end;
       case AContext.Access of
       caAssign:
         begin

packages/pastojs/tests/tcmodules.pas

@@ -638,11 +638,10 @@ type
     Procedure TestClassHelper_Constructor;
     Procedure TestClassHelper_InheritedObjFPC;
     Procedure TestClassHelper_Property;
-    // todo: TestClassHelper_Property_Array
-    // todo: TestClassHelper_Property_Index
-    // todo: TestClassHelper_ClassProperty
+    Procedure TestClassHelper_Property_Array;
+    //Procedure TestClassHelper_Property_Array_Default;
+    // todo: TestClassHelper_ClassProperty  static/nonstatic
     // todo: TestClassHelper_ClassProperty_Array
-    // todo: TestClassHelper_ClassProperty_Index
     // todo: TestClassHelper_Overload
     // todo: TestClassHelper_ForIn
     // todo: TestRecordHelper_ClassVar
@@ -19534,6 +19533,128 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClassHelper_Property_Array;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function GetSpeed(Index: boolean): word;',
+  '    procedure SetSpeed(Index: boolean; Value: word);',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    function GetSize(Index: boolean): word;',
+  '    procedure SetSize(Index: boolean; Value: word);',
+  '    property Size[Index: boolean]: word read GetSize write SetSize;',
+  '    property Speed[Index: boolean]: word read GetSpeed write SetSpeed;',
+  '  end;',
+  '  TBird = class',
+  '    property Items[Index: boolean]: word read GetSize write SetSize;',
+  '    procedure DoIt;',
+  '  end;',
+  'var',
+  '  b: TBird;',
+  'function Tobject.GetSpeed(Index: boolean): word;',
+  'begin',
+  '  Result:=Size[false];',
+  '  Size[true]:=Size[false]+11;',
+  '  Speed[true]:=Speed[false]+12;',
+  '  Self.Size[true]:=Self.Size[false]+21;',
+  '  Self.Speed[true]:=Self.Speed[false]+22;',
+  '  with Self do begin',
+  '    Size[true]:=Size[false]+31;',
+  '    Speed[true]:=Speed[false]+32;',
+  '  end;',
+  'end;',
+  'procedure Tobject.SetSpeed(Index: boolean; Value: word);',
+  'begin',
+  'end;',
+  'function TObjHelper.GetSize(Index: boolean): word;',
+  'begin',
+  '  Size[true]:=Size[false]+11;',
+  '  Speed[true]:=Speed[false]+12;',
+  '  Self.Size[true]:=Self.Size[false]+21;',
+  '  Self.Speed[true]:=Self.Speed[false]+22;',
+  '  with Self do begin',
+  '    Size[true]:=Size[false]+31;',
+  '    Speed[true]:=Speed[false]+32;',
+  '  end;',
+  'end;',
+  'procedure TObjHelper.SetSize(Index: boolean; Value: word);',
+  'begin',
+  'end;',
+  'procedure TBird.DoIt;',
+  'begin',
+  '  Items[true]:=Items[false]+11;',
+  '  Self.Items[true]:=Self.Items[false]+21;',
+  '  with Self do Items[true]:=Items[false]+31;',
+  'end;',
+  'begin',
+  '  b.Size[true]:=b.Size[false]+11;',
+  '  b.Speed[true]:=b.Speed[false]+12;',
+  '  b.Items[true]:=b.Items[false]+13;',
+  '  with b do begin',
+  '    Size[true]:=Size[false]+21;',
+  '    Speed[true]:=Speed[false]+22;',
+  '    Items[true]:=Items[false]+23;',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClassHelper_Property_Array',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetSpeed = function (Index) {',
+    '    var Result = 0;',
+    '    Result = $mod.TObjHelper.GetSize.apply(this, false);',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 11);',
+    '    this.SetSpeed(true, this.GetSpeed(false) + 12);',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 21);',
+    '    this.SetSpeed(true, this.GetSpeed(false) + 22);',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 31);',
+    '    this.SetSpeed(true, this.GetSpeed(false) + 32);',
+    '    return Result;',
+    '  };',
+    '  this.SetSpeed = function (Index, Value) {',
+    '  };',
+    '});',
+    'rtl.createHelper($mod, "TObjHelper", null, function () {',
+    '  this.GetSize = function (Index) {',
+    '    var Result = 0;',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 11);',
+    '    this.SetSpeed(true, this.GetSpeed(false) + 12);',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 21);',
+    '    this.SetSpeed(true, this.GetSpeed(false) + 22);',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 31);',
+    '    this.SetSpeed(true, this.GetSpeed(false) + 32);',
+    '    return Result;',
+    '  };',
+    '  this.SetSize = function (Index, Value) {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  this.DoIt = function () {',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 11);',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 21);',
+    '    $mod.TObjHelper.SetSize.apply(this, true, $mod.TObjHelper.GetSize.apply(this, false) + 31);',
+    '  };',
+    '});',
+    'this.b = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.TObjHelper.SetSize.apply($mod.b, true, $mod.TObjHelper.GetSize.apply($mod.b, false) + 11);',
+    '$mod.b.SetSpeed(true, $mod.b.GetSpeed(false) + 12);',
+    '$mod.TObjHelper.SetSize.apply($mod.b, true, $mod.TObjHelper.GetSize.apply($mod.b, false) + 13);',
+    'var $with1 = $mod.b;',
+    '$mod.TObjHelper.SetSize.apply($with1, true, $mod.TObjHelper.GetSize.apply($with1, false) + 21);',
+    '$with1.SetSpeed(true, $with1.GetSpeed(false) + 22);',
+    '$mod.TObjHelper.SetSize.apply($with1, true, $mod.TObjHelper.GetSize.apply($with1, false) + 23);',
+    '']));
+end;
+
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);