pastojs: helper: for in class helper

git-svn-id: trunk@41257 -

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): TJSCallExpression; virtual;
+      AContext: TConvertContext; Implicit: boolean = false): TJSCallExpression; virtual;
     // Statements
     Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
     Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
@@ -15684,6 +15684,7 @@ var
   end;
 
 var
+  aResolver: TPas2JSResolver;
   ForScope: TPasForLoopScope;
   Statements: TJSStatementList;
   VarSt: TJSVariableStatement;
@@ -15700,6 +15701,7 @@ var
   EnumeratorTypeEl: TPasType;
   NeedTryFinally, NeedIntfRef: Boolean;
 begin
+  aResolver:=AContext.Resolver;
   ForScope:=TPasForLoopScope(El.CustomData);
   NeedTryFinally:=true;
   NeedIntfRef:=false;
@@ -15710,7 +15712,7 @@ begin
     RaiseNotSupported(El,AContext,20171225104212);
   if GetEnumeratorFunc.ClassType<>TPasFunction then
     RaiseNotSupported(El,AContext,20171225104237);
-  AContext.Resolver.ComputeElement(GetEnumeratorFunc.FuncType.ResultEl,ResolvedEl,[rcType]);
+  aResolver.ComputeElement(GetEnumeratorFunc.FuncType.ResultEl,ResolvedEl,[rcType]);
   EnumeratorTypeEl:=ResolvedEl.LoTypeEl;
 
   if EnumeratorTypeEl is TPasClassType then
@@ -15735,12 +15737,18 @@ begin
     RaiseNotSupported(El,AContext,20171225104249);
   if MoveNextFunc.ClassType<>TPasFunction then
     RaiseNotSupported(El,AContext,20171225104256);
+  if MoveNextFunc.Parent.ClassType<>TPasClassType then
+    RaiseNotSupported(El,AContext,20190208153949);
+  if TPasClassType(MoveNextFunc.Parent).HelperForType<>nil then
+    RaiseNotSupported(El,AContext,20190208155015);
   // find property Current
   CurrentProp:=ForScope.Current;
   if (CurrentProp=nil) then
     RaiseNotSupported(El,AContext,20171225104306);
   if CurrentProp.ClassType<>TPasProperty then
     RaiseNotSupported(El,AContext,20171225104316);
+  if CurrentProp.Parent.ClassType<>TPasClassType then
+    RaiseNotSupported(El,AContext,20190208154003);
 
   // get function context
   FuncContext:=AContext;
@@ -15758,9 +15766,14 @@ begin
     List:=ConvertExpression(El.StartExpr,AContext); // beware: might fail
     PosEl:=El.StartExpr;
     // List.GetEnumerator()
-    Call:=TJSCallExpression(CreateElement(TJSCallExpression,PosEl));
-    Call.Expr:=CreateDotExpression(PosEl,List,
+    if aResolver.IsHelperMethod(GetEnumeratorFunc) then
+      Call:=CreateCallHelperMethod(GetEnumeratorFunc,El.StartExpr,AContext,true)
+    else
+      begin
+      Call:=TJSCallExpression(CreateElement(TJSCallExpression,PosEl));
+      Call.Expr:=CreateDotExpression(PosEl,List,
                          CreateIdentifierExpr(GetEnumeratorFunc,AContext),true);
+      end;
     // var $in=
     CurInVarName:=FuncContext.CreateLocalIdentifier(GetBIName(pbivnLoopIn));
     VarSt.A:=CreateVarDecl(CurInVarName,Call,PosEl);
@@ -16922,7 +16935,8 @@ begin
 end;
 
 function TPasToJSConverter.CreateCallHelperMethod(Proc: TPasProcedure;
-  Expr: TPasExpr; AContext: TConvertContext): TJSCallExpression;
+  Expr: TPasExpr; AContext: TConvertContext; Implicit: boolean
+  ): TJSCallExpression;
 var
   Left: TPasExpr;
   WithExprScope: TPas2JSWithExprScope;
@@ -16992,7 +17006,13 @@ begin
   Call:=nil;
   ArgElements:=nil;
   try
-    if Expr is TBinaryExpr then
+    if Implicit then
+      begin
+      Left:=Expr;
+      PosEl:=Expr;
+      aResolver.ComputeElement(Left,LeftResolved,[]);
+      end
+    else if Expr is TBinaryExpr then
       begin
       // e.g. "path.proc(args)" or "path.proc"
       Bin:=TBinaryExpr(Expr);

packages/pastojs/tests/tcmodules.pas

@@ -644,7 +644,7 @@ type
     Procedure TestClassHelper_ClassProperty;
     Procedure TestClassHelper_ClassPropertyStatic;
     Procedure TestClassHelper_ClassProperty_Array;
-    // todo: TestClassHelper_ForIn
+    Procedure TestClassHelper_ForIn;
     // todo: TestRecordHelper_ClassVar
     // todo: TestRecordHelper_Method
     // todo: TestRecordHelper_ClassMethod
@@ -20261,6 +20261,82 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClassHelper_ForIn;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TItem = TObject;',
+  '  TEnumerator = class',
+  '    FCurrent: TItem;',
+  '    property Current: TItem read FCurrent;',
+  '    function MoveNext: boolean;',
+  '  end;',
+  '  TBird = class',
+  '  end;',
+  '  TBirdHelper = class helper for TBird',
+  '    function GetEnumerator: TEnumerator;',
+  '  end;',
+  'function TEnumerator.MoveNext: boolean;',
+  'begin',
+  'end;',
+  'function TBirdHelper.GetEnumerator: TEnumerator;',
+  'begin',
+  'end;',
+  'var',
+  '  b: TBird;',
+  '  i, i2: TItem;',
+  'begin',
+  '  for i in b do i2:=i;']);
+  ConvertProgram;
+  CheckSource('TestClassHelper_ForIn',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TEnumerator", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.FCurrent = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FCurrent = undefined;',
+    '    $mod.TObject.$final.call(this);',
+    '  };',
+    '  this.MoveNext = function () {',
+    '    var Result = false;',
+    '    return Result;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '});',
+    'rtl.createHelper($mod, "TBirdHelper", null, function () {',
+    '  this.GetEnumerator = function () {',
+    '    var Result = null;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.b = null;',
+    'this.i = null;',
+    'this.i2 = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $in1 = $mod.TBirdHelper.GetEnumerator.apply($mod.b);',
+    'try {',
+    '  while ($in1.MoveNext()){',
+    '    $mod.i = $in1.FCurrent;',
+    '    $mod.i2 = $mod.i;',
+    '  }',
+    '} finally {',
+    '  $in1 = rtl.freeLoc($in1)',
+    '};',
+    '']));
+end;
+
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);