pastojs: for item in class do

git-svn-id: trunk@37781 -

packages/pastojs/src/fppas2js.pp

@@ -1285,6 +1285,11 @@ type
     Function CreateRTTIClassProperty(Prop: TPasProperty; AContext: TConvertContext): TJSElement; virtual;
     Procedure CreateRTTIAnonymous(El: TPasType; AContext: TConvertContext;
       var First, Last: TJSStatementList); virtual;
+    Function CreateGetEnumeratorLoop(El: TPasImplForLoop;
+      const ResolvedIn: TPasResolverResult; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement; virtual;
+    Function CreatePropertyGet(Prop: TPasProperty; Ref: TResolvedReference;
+      AContext: TConvertContext; PosEl: TPasElement): TJSElement; virtual;
     // Statements
     Function ConvertImplBlockElements(El: TPasImplBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
     Function ConvertBeginEndStatement(El: TPasImplBeginBlock; AContext: TConvertContext; NilIfEmpty: boolean): TJSElement; virtual;
@@ -4767,30 +4772,9 @@ begin
         end;
       caRead:
         begin
-        Decl:=AContext.Resolver.GetPasPropertyGetter(Prop);
-        if Decl is TPasFunction then
-          begin
-          IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop);
-          if IndexExpr<>nil then
-            begin
-            // call function with index specifier
-            Value:=nil;
-            Call:=CreateCallExpression(El);
-            try
-              Call.Expr:=CreateReferencePathExpr(Decl,AContext,false,Ref);
-              Value:=AContext.Resolver.Eval(IndexExpr,[refConst]);
-              Call.AddArg(ConvertConstValue(Value,AContext.GetFunctionContext,El));
-              Result:=Call;
-            finally
-              ReleaseEvalValue(Value);
-              if Result=nil then
-                Call.Free;
-            end;
-            exit;
-            end
-          else if (Prop.Args.Count=0) then
-            ImplicitCall:=true;
-          end;
+        Result:=CreatePropertyGet(Prop,Ref,AContext,El);
+        if Result is TJSCallExpression then exit;
+        if not ImplicitCall then exit;
         end;
       else
         RaiseNotSupported(El,AContext,20170213212623);
@@ -6058,21 +6042,6 @@ function TPasToJSConverter.ConvertTObjectFree(Bin: TBinaryExpr;
     Result:=Call;
   end;
 
-  function CreateCallRTLFreeLoc(Setter, Getter: TJSElement; Src: TPasElement): TJSElement;
-  // create "Setter=rtl.freeLoc(Getter)"
-  var
-    Call: TJSCallExpression;
-    AssignSt: TJSSimpleAssignStatement;
-  begin
-    Call:=CreateCallExpression(Src);
-    Call.Expr:=CreateMemberExpression([GetBuildInNames(pbivnRTL),GetBuildInNames(pbifnFreeLocalVar)]);
-    Call.Args.AddElement(Getter);
-    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,Src));
-    AssignSt.LHS:=Setter;
-    AssignSt.Expr:=Call;
-    Result:=AssignSt;
-  end;
-
 var
   LeftJS, Obj, Prop, Getter, Setter: TJSElement;
   DotExpr: TJSDotMemberExpression;
@@ -10241,6 +10210,209 @@ begin
     end;
 end;
 
+function TPasToJSConverter.CreateGetEnumeratorLoop(El: TPasImplForLoop;
+  const ResolvedIn: TPasResolverResult; AContext: TConvertContext): TJSElement;
+//  for Item in List do
+// convert to
+//  var $in=List.GetEnumerator();
+//  try{
+//    while ($in.MoveNext()){
+//      Item=$in.getCurrent;
+//      // code
+//    }
+//  } finally {
+//    $in=rtl.freeLoc($in);
+//  };
+var
+  PosEl: TPasElement;
+  CurInVarName: String;
+
+  function CreateInName: TJSElement;
+  var
+    Ident: TJSPrimaryExpressionIdent;
+  begin
+    Ident:=TJSPrimaryExpressionIdent(CreateElement(TJSPrimaryExpressionIdent,PosEl));
+    Ident.Name:=TJSString(CurInVarName); // do not lowercase
+    Result:=Ident;
+  end;
+
+var
+  Statements: TJSStatementList;
+  VarSt: TJSVariableStatement;
+  FuncContext: TConvertContext;
+  List, GetCurrent, J: TJSElement;
+  Call: TJSCallExpression;
+  TrySt: TJSTryFinallyStatement;
+  WhileSt: TJSWhileStatement;
+  AssignSt: TJSSimpleAssignStatement;
+  TypeEl: TPasType;
+  ClassScope: TPasClassScope;
+  GetEnumerator, MoveNext, Current: TPasIdentifier;
+  GetEnumeratorFunc, MoveNextFunc: TPasFunction;
+  ResolvedFunc: TPasResolverResult;
+  CurrentProp: TPasProperty;
+  DotContext: TDotContext;
+begin
+  // find class
+  TypeEl:=AContext.Resolver.ResolveAliasType(ResolvedIn.TypeEl);
+  if not (TypeEl is TPasClassType) then
+    RaiseNotSupported(El.StartExpr,AContext,20171221212820);
+  ClassScope:=TypeEl.CustomData as TPasClassScope;
+  // find function GetEnumerator
+  GetEnumerator:=ClassScope.FindIdentifier('GetEnumerator');
+  if GetEnumerator=nil then
+    RaiseNotSupported(El.StartExpr,AContext,20171221212820);
+  if GetEnumerator.Element.ClassType<>TPasFunction then
+    RaiseNotSupported(El.StartExpr,AContext,20171221212820);
+  GetEnumeratorFunc:=TPasFunction(GetEnumerator.Element);
+  // find enumerator class
+  AContext.Resolver.ComputeElement(GetEnumeratorFunc.FuncType.ResultEl,ResolvedFunc,[rcType]);
+  if ResolvedFunc.BaseType<>btContext then
+    RaiseNotSupported(El.StartExpr,AContext,20171221213612);
+  TypeEl:=AContext.Resolver.ResolveAliasType(ResolvedFunc.TypeEl);
+  if not (TypeEl is TPasClassType) then
+    RaiseNotSupported(El.StartExpr,AContext,20171221213632);
+  ClassScope:=TypeEl.CustomData as TPasClassScope;
+  // find function MoveNext
+  MoveNext:=ClassScope.FindIdentifier('MoveNext');
+  if MoveNext=nil then
+    RaiseNotSupported(El.StartExpr,AContext,20171221213747);
+  if MoveNext.Element.ClassType<>TPasFunction then
+    RaiseNotSupported(El.StartExpr,AContext,20171221213754);
+  MoveNextFunc:=TPasFunction(MoveNext.Element);
+  // find property Current
+  Current:=ClassScope.FindIdentifier('Current');
+  if Current=nil then
+    RaiseNotSupported(El.StartExpr,AContext,20171221213911);
+  if Current.Element.ClassType<>TPasProperty then
+    RaiseNotSupported(El.StartExpr,AContext,20171221213921);
+  CurrentProp:=TPasProperty(Current.Element);
+
+  // get function context
+  FuncContext:=AContext;
+  while (FuncContext.Parent<>nil) and (not (FuncContext is TFunctionContext)) do
+    FuncContext:=FuncContext.Parent;
+
+  PosEl:=El;
+  Statements:=TJSStatementList(CreateElement(TJSStatementList,PosEl));
+  DotContext:=nil;
+  try
+    // var...
+    VarSt:=TJSVariableStatement(CreateElement(TJSVariableStatement,PosEl));
+    Statements.A:=VarSt;
+    // List
+    List:=ConvertElement(El.StartExpr,AContext); // beware: might fail
+    PosEl:=El.StartExpr;
+    // List.GetEnumerator()
+    Call:=TJSCallExpression(CreateElement(TJSCallExpression,PosEl));
+    Call.Expr:=CreateDotExpression(PosEl,List,CreateIdentifierExpr(GetEnumeratorFunc,AContext));
+    // var $in=
+    CurInVarName:=FuncContext.CreateLocalIdentifier(FBuiltInNames[pbivnLoopIn]);
+    VarSt.A:=CreateVarDecl(CurInVarName,List,PosEl);
+
+    PosEl:=El.VariableName;
+    // try()
+    TrySt:=TJSTryFinallyStatement(CreateElement(TJSTryFinallyStatement,PosEl));
+    Statements.B:=TrySt;
+
+    // while ()
+    WhileSt:=TJSWhileStatement(CreateElement(TJSWhileStatement,PosEl));
+    TrySt.Block:=WhileSt;
+    // $in.MoveNext()
+    Call:=TJSCallExpression(CreateElement(TJSCallExpression,PosEl));
+    WhileSt.Cond:=Call;
+    Call.Expr:=CreateDotExpression(PosEl,CreateInName,CreateIdentifierExpr(MoveNextFunc,AContext));
+
+    // Item=$in.getCurrent;
+    AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PosEl));
+    WhileSt.Body:=AssignSt;
+    AssignSt.LHS:=ConvertElement(El.VariableName,AContext); // beware: might fail
+
+    DotContext:=TDotContext.Create(El.StartExpr,nil,AContext);
+    GetCurrent:=CreatePropertyGet(CurrentProp,nil,DotContext,PosEl); // beware: might fail
+    FreeAndNil(DotContext);
+    AssignSt.Expr:=CreateDotExpression(PosEl,CreateInName,GetCurrent);
+
+    // add body
+    if El.Body<>nil then
+      begin
+      J:=ConvertElement(El.Body,AContext); // beware: might fail
+      if J<>nil then
+        begin
+        List:=TJSStatementList(CreateElement(TJSStatementList,PosEl));
+        TJSStatementList(List).A:=WhileSt.Body;
+        TJSStatementList(List).B:=J;
+        WhileSt.Body:=List;
+        end;
+      end;
+
+    // finally{ $in=rtl.freeLoc($in) }
+    PosEl:=El.StartExpr;
+    TrySt.BFinally:=CreateCallRTLFreeLoc(CreateInName,CreateInName,PosEl);
+
+    Result:=Statements;
+  finally
+    DotContext.Free;
+    if Result=nil then
+      Statements.Free;
+  end;
+end;
+
+function TPasToJSConverter.CreateCallRTLFreeLoc(Setter, Getter: TJSElement;
+  Src: TPasElement): TJSElement;
+// create "Setter=rtl.freeLoc(Getter)"
+var
+  Call: TJSCallExpression;
+  AssignSt: TJSSimpleAssignStatement;
+begin
+  Call:=CreateCallExpression(Src);
+  Call.Expr:=CreateMemberExpression([GetBuildInNames(pbivnRTL),GetBuildInNames(pbifnFreeLocalVar)]);
+  Call.Args.AddElement(Getter);
+  AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,Src));
+  AssignSt.LHS:=Setter;
+  AssignSt.Expr:=Call;
+  Result:=AssignSt;
+end;
+
+function TPasToJSConverter.CreatePropertyGet(Prop: TPasProperty;
+  Ref: TResolvedReference; AContext: TConvertContext; PosEl: TPasElement
+  ): TJSElement;
+var
+  Decl: TPasElement;
+  IndexExpr: TPasExpr;
+  Call: TJSCallExpression;
+  Value: TResEvalValue;
+  Name: String;
+begin
+  Decl:=AContext.Resolver.GetPasPropertyGetter(Prop);
+  if Decl is TPasFunction then
+    begin
+    // call function
+    Value:=nil;
+    Call:=CreateCallExpression(PosEl);
+    try
+      Call.Expr:=CreateReferencePathExpr(Decl,AContext,false,Ref);
+      IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop);
+      if IndexExpr<>nil then
+        begin
+        Value:=AContext.Resolver.Eval(IndexExpr,[refConst]);
+        Call.AddArg(ConvertConstValue(Value,AContext.GetFunctionContext,PosEl));
+        end;
+      Result:=Call;
+    finally
+      ReleaseEvalValue(Value);
+      if Result=nil then
+        Call.Free;
+    end;
+    end
+  else
+    begin
+    // read field
+    Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,false,Ref);
+    Result:=CreatePrimitiveDotExpr(Name,PosEl);
+    end;
+end;
+
 function TPasToJSConverter.ConvertImplBlock(El: TPasImplBlock;
   AContext: TConvertContext): TJSElement;
 
@@ -10677,6 +10849,7 @@ var
   var
     EnumType: TPasEnumType;
     TypeEl: TPasType;
+    C: TClass;
   begin
     Result:=true;
     AContext.Resolver.ComputeElement(El.VariableName,ResolvedVar,[rcNoImplicitProc]);
@@ -10694,8 +10867,20 @@ var
       end;
     ltIn:
       begin
-      HasInVar:=true;
       AContext.Resolver.ComputeElement(El.StartExpr,ResolvedIn,[]);
+
+      if (ResolvedIn.BaseType=btContext) then
+        begin
+        TypeEl:=AContext.Resolver.ResolveAliasType(ResolvedIn.TypeEl);
+        C:=TypeEl.ClassType;
+        if C=TPasClassType then
+          begin
+          ConvertForStatement:=CreateGetEnumeratorLoop(El,ResolvedIn,AContext);
+          exit(false);
+          end;
+        end;
+
+      HasInVar:=true;
       InValue:=AContext.Resolver.Eval(El.StartExpr,[],false);
       if InValue=nil then
         begin

packages/pastojs/tests/tcmodules.pas

@@ -397,6 +397,7 @@ type
     Procedure TestClass_TObjectFreeLowerCase;
     Procedure TestClass_TObjectFreeFunctionFail;
     Procedure TestClass_TObjectFreePropertyFail;
+    Procedure TestClass_ForIn;
 
     // class of
     Procedure TestClassOf_Create;
@@ -9512,6 +9513,78 @@ begin
   ConvertProgram;
 end;
 
+procedure TTestModule.TestClass_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',
+  '    function GetEnumerator: TEnumerator;',
+  '  end;',
+  'function TEnumerator.MoveNext: boolean;',
+  'begin',
+  'end;',
+  'function TBird.GetEnumerator: TEnumerator;',
+  'begin',
+  'end;',
+  'var',
+  '  b: TBird;',
+  '  i, i2: TItem;',
+  'begin',
+  '  for i in b do i2:=i;']);
+  ConvertProgram;
+  CheckSource('TestClass_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 () {',
+    '  this.GetEnumerator = function () {',
+    '    var Result = null;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.b = null;',
+    'this.i = null;',
+    'this.i2 = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    'var $in1 = $mod.b;',
+    'try {',
+    '  while ($in1.MoveNext()){',
+    '    $mod.i = $in1.FCurrent;',
+    '    $mod.i2 = $mod.i;',
+    '  }',
+    '} finally {',
+    '  $in1 = rtl.freeLoc($in1)',
+    '};',
+    '']));
+end;
+
 procedure TTestModule.TestClassOf_Create;
 begin
   StartProgram(false);