Browse Source

pastojs: fixed local record and enum types

git-svn-id: trunk@40133 -
Mattias Gaertner 6 years ago
parent
commit
72bab28659
2 changed files with 116 additions and 18 deletions
  1. 21 17
      packages/pastojs/src/fppas2js.pp
  2. 95 1
      packages/pastojs/tests/tcmodules.pas

+ 21 - 17
packages/pastojs/src/fppas2js.pp

@@ -6654,10 +6654,13 @@ var
 begin
 begin
   if PosEl=nil then PosEl:=El;
   if PosEl=nil then PosEl:=El;
   CurName:=TransformVariableName(El,Name,false,AContext);
   CurName:=TransformVariableName(El,Name,false,AContext);
-  ParentName:=AContext.GetLocalName(El.Parent);
-  if ParentName='' then
-    ParentName:='this';
-  CurName:=ParentName+'.'+CurName;
+  if not (El.Parent is TProcedureBody) then
+    begin
+    ParentName:=AContext.GetLocalName(El.Parent);
+    if ParentName='' then
+      ParentName:='this';
+    CurName:=ParentName+'.'+CurName;
+    end;
   Result:=CreatePrimitiveDotExpr(CurName,PosEl);
   Result:=CreatePrimitiveDotExpr(CurName,PosEl);
 end;
 end;
 
 
@@ -11911,16 +11914,21 @@ begin
     Obj:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
     Obj:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
     if AContext is TObjectContext then
     if AContext is TObjectContext then
       begin
       begin
-      // add 'TypeName: function(){}'
+      // add 'TypeName: {}'
       ParentObj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
       ParentObj:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
       ObjLit:=ParentObj.Elements.AddElement;
       ObjLit:=ParentObj.Elements.AddElement;
       ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
       ObjLit.Name:=TJSString(TransformVariableName(El,AContext));
       ObjLit.Expr:=Obj;
       ObjLit.Expr:=Obj;
       Result:=Obj;
       Result:=Obj;
       end
       end
+    else if El.Parent is TProcedureBody then
+      begin
+      // add 'var TypeName = {}'
+      Result:=CreateVarStatement(TransformVariableName(El,AContext),Obj,El);
+      end
     else
     else
       begin
       begin
-      // add 'this.TypeName = function(){}'
+      // add 'this.TypeName = {}'
       AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
       AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
       AssignSt.LHS:=CreateSubDeclNameExpr(El,AContext);
       AssignSt.LHS:=CreateSubDeclNameExpr(El,AContext);
       AssignSt.Expr:=Obj;
       AssignSt.Expr:=Obj;
@@ -15625,8 +15633,6 @@ function TPasToJSConverter.ConvertIfStatement(El: TPasImplIfElse;
 Var
 Var
   C,BThen,BElse : TJSElement;
   C,BThen,BElse : TJSElement;
   T : TJSIfStatement;
   T : TJSIfStatement;
-  ok: Boolean;
-
 begin
 begin
   Result:=nil;
   Result:=nil;
   if AContext=nil then ;
   if AContext=nil then ;
@@ -17788,6 +17794,7 @@ begin
           Prepend(Result,ParentEl.Name);
           Prepend(Result,ParentEl.Name);
         end;
         end;
       ParentEl:=ParentEl.Parent;
       ParentEl:=ParentEl.Parent;
+      if ParentEl is TProcedureBody then break;
       end;
       end;
     end;
     end;
 
 
@@ -18946,7 +18953,6 @@ var
   BodyFirst, BodyLast, ListFirst, ListLast: TJSStatementList;
   BodyFirst, BodyLast, ListFirst, ListLast: TJSStatementList;
   FuncContext: TFunctionContext;
   FuncContext: TFunctionContext;
   ObjLit: TJSObjectLiteral;
   ObjLit: TJSObjectLiteral;
-  ObjEl: TJSObjectLiteralElement;
   IfSt: TJSIfStatement;
   IfSt: TJSIfStatement;
   Call, Call2: TJSCallExpression;
   Call, Call2: TJSCallExpression;
   ok: Boolean;
   ok: Boolean;
@@ -18958,14 +18964,13 @@ begin
   ok:=false;
   ok:=false;
   try
   try
     FDS:=CreateFunctionSt(El);
     FDS:=CreateFunctionSt(El);
-    if AContext is TObjectContext then
+    FD:=FDS.AFunction;
+    if El.Parent is TProcedureBody then
       begin
       begin
-      // add 'TypeName: function(){}'
-      ObjLit:=TObjectContext(AContext).JSElement as TJSObjectLiteral;
-      Result:=ObjLit;
-      ObjEl:=ObjLit.Elements.AddElement;
-      ObjEl.Name:=TJSString(TransformVariableName(El,AContext));
-      ObjEl.Expr:=FDS;
+      // ToDo: elevate to non local scope
+      // add 'function TypeName(){}'
+      Result:=FDS;
+      FD.Name:=TJSString(TransformVariableName(El,AContext));
       end
       end
     else
     else
       begin
       begin
@@ -18975,7 +18980,6 @@ begin
       AssignSt.LHS:=CreateSubDeclNameExpr(El,AContext);
       AssignSt.LHS:=CreateSubDeclNameExpr(El,AContext);
       AssignSt.Expr:=FDS;
       AssignSt.Expr:=FDS;
       end;
       end;
-    FD:=FDS.AFunction;
     // add param s
     // add param s
     FD.Params.Add(SrcParamName);
     FD.Params.Add(SrcParamName);
     // create function body
     // create function body

+ 95 - 1
packages/pastojs/tests/tcmodules.pas

@@ -336,6 +336,7 @@ type
     Procedure TestEnumRange_Array;
     Procedure TestEnumRange_Array;
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ForIn;
     Procedure TestEnum_ScopedNumber;
     Procedure TestEnum_ScopedNumber;
+    Procedure TestEnum_InFunction;
     Procedure TestSet_Enum;
     Procedure TestSet_Enum;
     Procedure TestSet_Operators;
     Procedure TestSet_Operators;
     Procedure TestSet_Operator_In;
     Procedure TestSet_Operator_In;
@@ -432,6 +433,7 @@ type
     Procedure TestRecord_FieldArray;
     Procedure TestRecord_FieldArray;
     Procedure TestRecord_Const;
     Procedure TestRecord_Const;
     Procedure TestRecord_TypecastFail;
     Procedure TestRecord_TypecastFail;
+    Procedure TestRecord_InFunction;
 
 
     // classes
     // classes
     Procedure TestClass_TObjectDefaultConstructor;
     Procedure TestClass_TObjectDefaultConstructor;
@@ -4277,6 +4279,58 @@ begin
     '$mod.e = 1;']));
     '$mod.e = 1;']));
 end;
 end;
 
 
+procedure TTestModule.TestEnum_InFunction;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'type',
+  '  TEnum = (Red, Green, Blue);',
+  '  procedure Sub;',
+  '  type',
+  '    TEnumSub = (Left, Right);',
+  '  var',
+  '    es: TEnumSub;',
+  '  begin',
+  '    es:=Left;',
+  '  end;',
+  'var',
+  '  e, e2: TEnum;',
+  'begin',
+  '  if e in [red,blue] then e2:=e;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestEnum_InFunction',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  var TEnum = {',
+    '    "0":"Red",',
+    '    Red:0,',
+    '    "1":"Green",',
+    '    Green:1,',
+    '    "2":"Blue",',
+    '    Blue:2',
+    '    };',
+    '  function Sub() {',
+    '    var TEnumSub = {',
+    '      "0": "Left",',
+    '      Left: 0,',
+    '      "1": "Right",',
+    '      Right: 1',
+    '    };',
+    '    var es = 0;',
+    '    es = TEnumSub.Left;',
+    '  };',
+    '  var e = 0;',
+    '  var e2 = 0;',
+    '  if (e in rtl.createSet(TEnum.Red, TEnum.Blue)) e2 = e;',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestSet_Enum;
 procedure TTestModule.TestSet_Enum;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -9206,6 +9260,46 @@ begin
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 
+procedure TTestModule.TestRecord_InFunction;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'type',
+  '  TPoint = record x,y: longint; end;',
+  '  TPoints = array of TPoint;',
+  'var',
+  '  r: TPoint;',
+  '  p: TPoints;',
+  'begin',
+  '  SetLength(p,2);',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestRecord_InFunction',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  function TPoint(s) {',
+    '    if (s) {',
+    '      this.x = s.x;',
+    '      this.y = s.y;',
+    '    } else {',
+    '      this.x = 0;',
+    '      this.y = 0;',
+    '    };',
+    '    this.$equal = function (b) {',
+    '      return (this.x === b.x) && (this.y === b.y);',
+    '    };',
+    '  };',
+    '  var r = new TPoint();',
+    '  var p = [];',
+    '  p = rtl.arraySetLength(p, TPoint, 2);',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestClass_TObjectDefaultConstructor;
 procedure TTestModule.TestClass_TObjectDefaultConstructor;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -21160,7 +21254,7 @@ begin
   CheckSource('TestRTTI_LocalTypes',
   CheckSource('TestRTTI_LocalTypes',
     LinesToStr([ // statements
     LinesToStr([ // statements
     'this.DoIt = function () {',
     'this.DoIt = function () {',
-    '  this.TPoint = function (s) {',
+    '  function TPoint(s) {',
     '    if (s) {',
     '    if (s) {',
     '      this.x = s.x;',
     '      this.x = s.x;',
     '      this.y = s.y;',
     '      this.y = s.y;',