pastojs: property getter/setter in helper

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

2 files changed, 271 insertions, 59 deletions

diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index 5cb3456c2f..9560236ef9 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -1499,7 +1499,6 @@ type
     RightSide: TJSElement;
     // created by ConvertElement if assign needs a call:
     PropertyEl: TPasProperty;
-    Setter: TPasElement;
     Call: TJSCallExpression;
     constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
   end;
@@ -1766,8 +1765,12 @@ type
     Function CreateGetEnumeratorLoop(El: TPasImplForLoop;
       AContext: TConvertContext): TJSElement; virtual;
     Function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement; virtual;
-    Function CreatePropertyGet(Prop: TPasProperty; Ref: TResolvedReference;
+    Function CreatePropertyGet(Prop: TPasProperty; Expr: TPasExpr;
       AContext: TConvertContext; PosEl: TPasElement): TJSElement; virtual;
+    Function AppendPropertyAssignArgs(Call: TJSCallExpression; Prop: TPasProperty;
+      AssignContext: TAssignContext; PosEl: TPasElement): TJSCallExpression; virtual;
+    Function AppendPropertyReadArgs(Call: TJSCallExpression; Prop: TPasProperty;
+      aContext: TConvertContext; PosEl: TPasElement): TJSCallExpression; virtual;
     Function CreatePrecompiledJS(El: TJSElement): string; virtual;
     // create elements for RTTI
     Function CreateTypeInfoRef(El: TPasType; AContext: TConvertContext;
@@ -7620,7 +7623,6 @@ var
   IsImplicitCall: Boolean;
   TargetProcType: TPasProcedureType;
   ArrLit: TJSArrayLiteral;
-  IndexExpr: TPasExpr;
   FuncScope: TPas2JSProcedureScope;
   Value: TResEvalValue;
   aResolver: TPas2JSResolver;
@@ -7706,31 +7708,16 @@ begin
             Result:=CreateCallHelperMethod(TPasProcedure(Decl),El,AContext);
             exit;
             end;
-          AssignContext.PropertyEl:=Prop;
-          AssignContext.Setter:=Decl;
           // Setter
           Call:=CreateCallExpression(El);
-          AssignContext.Call:=Call;
           Call.Expr:=CreateReferencePathExpr(Decl,AContext,false,Ref);
-          IndexExpr:=aResolver.GetPasPropertyIndex(Prop);
-          if IndexExpr<>nil then
-            begin
-            Value:=aResolver.Eval(IndexExpr,[refConst]);
-            try
-              Call.AddArg(ConvertConstValue(Value,AssignContext,El));
-            finally
-              ReleaseEvalValue(Value);
-            end;
-            end;
-          Call.AddArg(AssignContext.RightSide);
-          AssignContext.RightSide:=nil;
-          Result:=Call;
+          Result:=AppendPropertyAssignArgs(Call,Prop,AssignContext,El);
           exit;
           end;
         end;
       caRead:
         begin
-        Result:=CreatePropertyGet(Prop,Ref,AContext,El);
+        Result:=CreatePropertyGet(Prop,El,AContext,El);
         if Result is TJSCallExpression then exit;
         if not IsImplicitCall then exit;
         end;
@@ -8738,7 +8725,6 @@ var
           end;
         AssignContext:=AContext.AccessContext as TAssignContext;
         AssignContext.PropertyEl:=Prop;
-        AssignContext.Setter:=AccessEl;
         AssignContext.Call:=Call;
         end;
       caRead:
@@ -15795,7 +15781,8 @@ begin
     Call.Expr:=CreateDotExpression(PosEl,CreateInName,
                                    CreateIdentifierExpr(MoveNextFunc,AContext));
 
-    // Item=$in.GetCurrent();
+    // read property "Current"
+    // Item=$in.GetCurrent();  or Item=$in.FCurrent;
     AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PosEl));
     WhileSt.Body:=AssignSt;
     AssignSt.LHS:=ConvertExpression(El.VariableName,AContext); // beware: might fail
@@ -15863,38 +15850,38 @@ begin
 end;
 
 function TPasToJSConverter.CreatePropertyGet(Prop: TPasProperty;
-  Ref: TResolvedReference; AContext: TConvertContext; PosEl: TPasElement
-  ): TJSElement;
+  Expr: TPasExpr; AContext: TConvertContext; PosEl: TPasElement): TJSElement;
 var
   aResolver: TPas2JSResolver;
   Decl: TPasElement;
-  IndexExpr: TPasExpr;
   Call: TJSCallExpression;
-  Value: TResEvalValue;
   Name: String;
-  TypeEl: TPasType;
+  Ref: TResolvedReference;
 begin
   aResolver:=AContext.Resolver;
   Decl:=aResolver.GetPasPropertyGetter(Prop);
+  if (Expr<>nil) and (Expr.CustomData is TResolvedReference) then
+    Ref:=TResolvedReference(Expr.CustomData)
+  else
+    Ref:=nil;
   if Decl is TPasFunction then
     begin
     // call function
-    Value:=nil;
+    if (Expr<>nil) then
+      begin
+      // explicit property read
+      if (Decl.Parent is TPasClassType)
+        and (TPasClassType(Decl.Parent).HelperForType<>nil) then
+        begin
+        Result:=CreateCallHelperMethod(TPasProcedure(Decl),Expr,AContext);
+        exit;
+        end;
+      end;
     Call:=CreateCallExpression(PosEl);
     try
       Call.Expr:=CreateReferencePathExpr(Decl,AContext,false,Ref);
-      IndexExpr:=aResolver.GetPasPropertyIndex(Prop);
-      if IndexExpr<>nil then
-        begin
-        Value:=aResolver.Eval(IndexExpr,[refConst]);
-        Call.AddArg(ConvertConstValue(Value,AContext.GetFunctionContext,PosEl));
-        end;
-      TypeEl:=aResolver.GetPasPropertyType(Prop);
-      if aResolver.IsInterfaceType(TypeEl,citCom) then
-        Call:=CreateIntfRef(Call,AContext,PosEl);
-      Result:=Call;
+      Result:=AppendPropertyReadArgs(Call,Prop,AContext,PosEl);
     finally
-      ReleaseEvalValue(Value);
       if Result=nil then
         Call.Free;
     end;
@@ -15907,6 +15894,58 @@ begin
     end;
 end;
 
+function TPasToJSConverter.AppendPropertyAssignArgs(Call: TJSCallExpression;
+  Prop: TPasProperty; AssignContext: TAssignContext; PosEl: TPasElement
+  ): TJSCallExpression;
+var
+  aResolver: TPas2JSResolver;
+  IndexExpr: TPasExpr;
+  Value: TResEvalValue;
+begin
+  AssignContext.Call:=Call;
+  AssignContext.PropertyEl:=Prop;
+  aResolver:=AssignContext.Resolver;
+  IndexExpr:=aResolver.GetPasPropertyIndex(Prop);
+  if IndexExpr<>nil then
+    begin
+    Value:=aResolver.Eval(IndexExpr,[refConst]);
+    try
+      Call.AddArg(ConvertConstValue(Value,AssignContext,PosEl));
+    finally
+      ReleaseEvalValue(Value);
+    end;
+    end;
+  Call.AddArg(AssignContext.RightSide);
+  AssignContext.RightSide:=nil;
+  Result:=Call;
+end;
+
+function TPasToJSConverter.AppendPropertyReadArgs(Call: TJSCallExpression;
+  Prop: TPasProperty; aContext: TConvertContext; PosEl: TPasElement
+  ): TJSCallExpression;
+var
+  aResolver: TPas2JSResolver;
+  IndexExpr: TPasExpr;
+  Value: TResEvalValue;
+  TypeEl: TPasType;
+begin
+  aResolver:=aContext.Resolver;
+  IndexExpr:=aResolver.GetPasPropertyIndex(Prop);
+  if IndexExpr<>nil then
+    begin
+    Value:=aResolver.Eval(IndexExpr,[refConst]);
+    try
+      Call.AddArg(ConvertConstValue(Value,AContext.GetFunctionContext,PosEl));
+    finally
+      ReleaseEvalValue(Value);
+    end;
+    end;
+  TypeEl:=aResolver.GetPasPropertyType(Prop);
+  if aResolver.IsInterfaceType(TypeEl,citCom) then
+    Call:=CreateIntfRef(Call,AContext,PosEl);
+  Result:=Call;
+end;
+
 function TPasToJSConverter.CreatePrecompiledJS(El: TJSElement): string;
 var
   aWriter: TBufferWriter;
@@ -16924,12 +16963,13 @@ var
   Path, ProcPath: String;
   Call: TJSCallExpression;
   IdentEl: TPasElement;
-  IsStatic, NeedIntfRef, IsConstructorNormalCall: Boolean;
+  IsStatic, IsConstructorNormalCall: Boolean;
   Ref: TResolvedReference;
   ProcType: TPasProcedureType;
   ParamsExpr: TParamsExpr;
   ArgElements : TJSArrayLiteralElements;
   ArrLit: TJSArrayLiteral;
+  Prop: TPasProperty;
 begin
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.CreateCallHelperMethod Proc=',GetObjName(Proc),' Expr=',GetObjName(Expr));
@@ -16995,8 +17035,15 @@ begin
 
     LoTypeEl:=LeftResolved.LoTypeEl;
     IdentEl:=LeftResolved.IdentEl;
-    IsConstructorNormalCall:=(Proc.ClassType=TPasConstructor)
-                           and (Ref<>nil) and not (rrfNewInstance in Ref.Flags);
+    Prop:=nil;
+    IsConstructorNormalCall:=false;
+    if Ref<>nil then
+      begin
+      IsConstructorNormalCall:=(Proc.ClassType=TPasConstructor)
+                             and not (rrfNewInstance in Ref.Flags);
+      if Ref.Declaration.ClassType=TPasProperty then
+        Prop:=TPasProperty(Ref.Declaration);
+      end;
 
     if IsStatic then
       begin
@@ -17153,22 +17200,42 @@ begin
       ArgElements:=Call.Args.Elements;
       end;
 
+    if Prop<>nil then
+      begin
+      case AContext.Access of
+      caAssign:
+        begin
+        // call property setter, e.g. left.prop:=RightSide
+        // -> HelperType.HelperSetter.apply(SelfJS,RightSide)
+        // append index and RightSide
+        Result:=AppendPropertyAssignArgs(Call,Prop,TAssignContext(AContext),PosEl);
+        Call:=nil;
+        exit;
+        end;
+      caRead:
+        begin
+        Result:=AppendPropertyReadArgs(Call,Prop,aContext,PosEl);
+        Call:=nil;
+        exit;
+        end;
+      else
+        RaiseNotSupported(PosEl,AContext,20190207122708);
+      end;
+      end;
+
     // append args
     ProcType:=Proc.ProcType;
     if Expr.Parent is TParamsExpr then
       ParamsExpr:=TParamsExpr(Expr.Parent)
     else
       ParamsExpr:=nil;
-    NeedIntfRef:=false;
+    CreateProcedureCallArgs(ArgElements,ParamsExpr,ProcType,AContext);
+
     if (ProcType is TPasFunctionType)
         and aResolver.IsInterfaceType(
           TPasFunctionType(ProcType).ResultEl.ResultType,citCom)
     then
-      NeedIntfRef:=true;
-
-    CreateProcedureCallArgs(ArgElements,ParamsExpr,ProcType,AContext);
-    if NeedIntfRef then
-      // $ir.ref(id,fnname())
+      // need interface reference: $ir.ref(id,fnname())
       Call:=CreateIntfRef(Call,AContext,PosEl);
 
     Result:=Call;
diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas
index 3f13ccd36b..cc069334c8 100644
--- a/packages/pastojs/tests/tcmodules.pas
+++ b/packages/pastojs/tests/tcmodules.pas
@@ -637,14 +637,14 @@ type
     Procedure TestClassHelper_MethodRefObjFPC;
     Procedure TestClassHelper_Constructor;
     Procedure TestClassHelper_InheritedObjFPC;
-    //Procedure TestClassHelper_InheritedDelphi;
-    // todo: TestClassHelper_Property
+    Procedure TestClassHelper_Property;
     // todo: TestClassHelper_Property_Array
     // todo: TestClassHelper_Property_Index
     // todo: TestClassHelper_ClassProperty
     // todo: TestClassHelper_ClassProperty_Array
     // todo: TestClassHelper_ClassProperty_Index
     // todo: TestClassHelper_Overload
+    // todo: TestClassHelper_ForIn
     // todo: TestRecordHelper_ClassVar
     // todo: TestRecordHelper_Method
     // todo: TestRecordHelper_ClassMethod
@@ -19303,11 +19303,11 @@ begin
   '  end;',
   '  TBirdHelper = class helper for TBird',
   '    procedure Fly;',
-  '    procedure Walk;',
+  '    procedure Walk(w: word);',
   '  end;',
   '  TEagleHelper = class helper(TBirdHelper) for TBird',
   '    procedure Fly;',
-  '    procedure Walk;',
+  '    procedure Walk(w: word);',
   '  end;',
   'procedure Tobject.fly;',
   'begin',
@@ -19328,7 +19328,7 @@ begin
   '  {@TBird_Fly}inherited;',
   '  inherited {@TBird_Fly}Fly;',
   'end;',
-  'procedure Tbirdhelper.walk;',
+  'procedure Tbirdhelper.walk(w: word);',
   'begin',
   'end;',
   'procedure teagleHelper.fly;',
@@ -19336,10 +19336,10 @@ begin
   '  {@TBird_Fly}inherited;',
   '  inherited {@TBird_Fly}Fly;',
   'end;',
-  'procedure teagleHelper.walk;',
+  'procedure teagleHelper.walk(w: word);',
   'begin',
   '  {@TBirdHelper_Walk}inherited;',
-  '  inherited {@TBirdHelper_Walk}Walk;',
+  '  inherited {@TBirdHelper_Walk}Walk(3);',
   'end;',
   'begin',
   '']);
@@ -19371,7 +19371,7 @@ begin
     '    $mod.TBird.Fly$1.call(this);',
     '    $mod.TBird.Fly$1.call(this);',
     '  };',
-    '  this.Walk = function () {',
+    '  this.Walk = function (w) {',
     '  };',
     '});',
     'rtl.createHelper($mod, "TEagleHelper", $mod.TBirdHelper, function () {',
@@ -19379,13 +19379,158 @@ begin
     '    $mod.TBird.Fly$1.call(this);',
     '    $mod.TBird.Fly$1.call(this);',
     '  };',
-    '  this.Walk$1 = function () {',
-    '    $mod.TBirdHelper.Walk.call(this);',
-    '    $mod.TBirdHelper.Walk.call(this);',
+    '  this.Walk$1 = function (w) {',
+    '    $mod.TBirdHelper.Walk.apply(this, arguments);',
+    '    $mod.TBirdHelper.Walk.call(this, 3);',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestModule.TestClassHelper_Property;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    FSize: word;',
+  '    function GetSpeed: word;',
+  '    procedure SetSpeed(Value: word);',
+  '  end;',
+  '  TObjHelper = class helper for TObject',
+  '    function GetLeft: word;',
+  '    procedure SetLeft(Value: word);',
+  '    property Size: word read FSize write FSize;',
+  '    property Speed: word read GetSpeed write SetSpeed;',
+  '    property Left: word read GetLeft write SetLeft;',
+  '  end;',
+  '  TBird = class',
+  '    property NotRight: word read GetLeft write SetLeft;',
+  '    procedure DoIt;',
+  '  end;',
+  'var',
+  '  b: TBird;',
+  'function Tobject.GetSpeed: word;',
+  'begin',
+  '  Size:=Size+11;',
+  '  Speed:=Speed+12;',
+  '  Result:=Left+13;',
+  '  Left:=13;',
+  '  Left:=Left+13;',
+  '  Self.Size:=Self.Size+21;',
+  '  Self.Speed:=Self.Speed+22;',
+  '  Self.Left:=Self.Left+23;',
+  '  with Self do begin',
+  '    Size:=Size+31;',
+  '    Speed:=Speed+32;',
+  '    Left:=Left+33;',
+  '  end;',
+  'end;',
+  'procedure Tobject.SetSpeed(Value: word);',
+  'begin',
+  'end;',
+  'function TObjHelper.GetLeft: word;',
+  'begin',
+  '  Size:=Size+11;',
+  '  Speed:=Speed+12;',
+  '  Left:=Left+13;',
+  '  Self.Size:=Self.Size+21;',
+  '  Self.Speed:=Self.Speed+22;',
+  '  Self.Left:=Self.Left+23;',
+  '  with Self do begin',
+  '    Size:=Size+31;',
+  '    Speed:=Speed+32;',
+  '    Left:=Left+33;',
+  '  end;',
+  'end;',
+  'procedure TObjHelper.SetLeft(Value: word);',
+  'begin',
+  'end;',
+  'procedure TBird.DoIt;',
+  'begin',
+  '  NotRight:=NotRight+11;',
+  '  Self.NotRight:=Self.NotRight+21;',
+  '  with Self do begin',
+  '    NotRight:=NotRight+31;',
+  '  end;',
+  'end;',
+  'begin',
+  '  b.Size:=b.Size+11;',
+  '  b.Speed:=b.Speed+12;',
+  '  b.Left:=b.Left+13;',
+  '  b.NotRight:=b.NotRight+14;',
+  '  with b do begin',
+  '    Size:=Size+31;',
+  '    Speed:=Speed+32;',
+  '    Left:=Left+33;',
+  '    NotRight:=NotRight+34;',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClassHelper_Property',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FSize = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.GetSpeed = function () {',
+    '    var Result = 0;',
+    '    this.FSize = this.FSize + 11;',
+    '    this.SetSpeed(this.GetSpeed() + 12);',
+    '    Result = $mod.TObjHelper.GetLeft.apply(this) + 13;',
+    '    $mod.TObjHelper.SetLeft.apply(this, 13);',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 13);',
+    '    this.FSize = this.FSize + 21;',
+    '    this.SetSpeed(this.GetSpeed() + 22);',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 23);',
+    '    this.FSize = this.FSize + 31;',
+    '    this.SetSpeed(this.GetSpeed() + 32);',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 33);',
+    '    return Result;',
+    '  };',
+    '  this.SetSpeed = function (Value) {',
+    '  };',
+    '});',
+    'rtl.createHelper($mod, "TObjHelper", null, function () {',
+    '  this.GetLeft = function () {',
+    '    var Result = 0;',
+    '    this.FSize = this.FSize + 11;',
+    '    this.SetSpeed(this.GetSpeed() + 12);',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 13);',
+    '    this.FSize = this.FSize + 21;',
+    '    this.SetSpeed(this.GetSpeed() + 22);',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 23);',
+    '    this.FSize = this.FSize + 31;',
+    '    this.SetSpeed(this.GetSpeed() + 32);',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 33);',
+    '    return Result;',
+    '  };',
+    '  this.SetLeft = function (Value) {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  this.DoIt = function () {',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 11);',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 21);',
+    '    $mod.TObjHelper.SetLeft.apply(this, $mod.TObjHelper.GetLeft.apply(this) + 31);',
     '  };',
     '});',
+    'this.b = null;',
     '']),
     LinesToStr([ // $mod.$main
+    '$mod.b.FSize = $mod.b.FSize + 11;',
+    '$mod.b.SetSpeed($mod.b.GetSpeed() + 12);',
+    '$mod.TObjHelper.SetLeft.apply($mod.b, $mod.TObjHelper.GetLeft.apply($mod.b) + 13);',
+    '$mod.TObjHelper.SetLeft.apply($mod.b, $mod.TObjHelper.GetLeft.apply($mod.b) + 14);',
+    'var $with1 = $mod.b;',
+    '$with1.FSize = $with1.FSize + 31;',
+    '$with1.SetSpeed($with1.GetSpeed() + 32);',
+    '$mod.TObjHelper.SetLeft.apply($with1, $mod.TObjHelper.GetLeft.apply($with1) + 33);',
+    '$mod.TObjHelper.SetLeft.apply($with1, $mod.TObjHelper.GetLeft.apply($with1) + 34);',
     '']));
 end;