pastojs: type helper array, constructor

git-svn-id: trunk@41279 -

packages/pastojs/src/fppas2js.pp

@@ -7853,9 +7853,8 @@ begin
       Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,true);
       end;
     end
-  else if (Decl.ClassType=TPasArgument) and (Decl.Parent is TPasProcedure)
-      and (CompareText(aName,'Self')=0) then
-    Name:=AContext.GetLocalName(Decl)
+  else if Decl.ClassType=TPasArgument then
+    Name:=TransformArgName(TPasArgument(Decl),AContext)
   else
     Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,false,Ref);
   if Name='' then
@@ -17054,8 +17053,21 @@ var
     FuncSt: TJSFunctionDeclarationStatement;
     RetSt: TJSReturnStatement;
     ObjLit: TJSObjectLiteralElement;
+    Arg: TPasArgument;
   begin
     // implicit Left (e.g. with Left do proc, or Self.proc)
+
+    if (LeftResolved.IdentEl is TPasArgument) then
+      begin
+      Arg:=TPasArgument(LeftResolved.IdentEl);
+      if Arg.Access in [argVar,argOut] then
+        begin
+        // implicit Left is already a reference
+        Result:=CreatePrimitiveDotExpr(TransformArgName(Arg,AContext),PosEl);
+        exit;
+        end;
+      end;
+
     // ->  {get: function(){return GetExpr},set:function(v){SetExpr}}
 
     // GetExpr  "ImplicitLeft"
@@ -17190,7 +17202,9 @@ begin
       else
         begin
         // inside helper method, no explicit left expression
-        if not IsStatic then
+        if IsStatic then
+          LeftResolved:=default(TPasResolverResult)
+        else
           begin
           SelfScope:=aResolver.GetSelfScope(Expr);
           if SelfScope=nil then
@@ -17229,6 +17243,9 @@ begin
       if Ref.Declaration.ClassType=TPasProperty then
         Prop:=TPasProperty(Ref.Declaration);
       end;
+    {$IFDEF VerbosePas2JS}
+    writeln('TPasToJSConverter.CreateCallHelperMethod IsConstructorNormalCall=',IsConstructorNormalCall,' Ref=',GetObjName(Ref),' Left=',GetObjName(Left),' ',GetResolverResultDbg(LeftResolved));
+    {$ENDIF}
 
     if IsStatic then
       begin
@@ -17292,7 +17309,8 @@ begin
         if (C=TPasArgument)
             or (C=TPasVariable)
             or (C=TPasConst)
-            or (C=TPasResultElement) then
+            or (C=TPasResultElement)
+            or (C=TPasEnumValue) then
           begin
           // Left.HelperCall -> HelperType.HelperCall.apply({get,set},args?)
           SelfJS:=CreateReference(PosEl,LeftResolved);
@@ -17426,18 +17444,22 @@ procedure TPasToJSConverter.AddHelperConstructor(El: TPasClassType;
 const
   FunName = 'fn';
   ArgsName = 'args';
+  ValueName = 'p';
 var
   aResolver: TPas2JSResolver;
   HelperForType: TPasType;
   AssignSt: TJSSimpleAssignStatement;
-  Func: TJSFunctionDeclarationStatement;
+  Func, FuncSt: TJSFunctionDeclarationStatement;
   New_Src: TJSSourceElements;
   Call: TJSCallExpression;
   DotExpr: TJSDotMemberExpression;
   BracketExpr: TJSBracketMemberExpression;
   New_FuncContext: TFunctionContext;
-  Init: TJSElement;
-  ReturnSt: TJSReturnStatement;
+  SelfJS: TJSElement;
+  ReturnSt, RetSt: TJSReturnStatement;
+  Obj: TJSObjectLiteral;
+  ObjLit: TJSObjectLiteralElement;
+  SetterArgName: Char;
 begin
   if El.HelperForType=nil then exit;
   aResolver:=AContext.Resolver;
@@ -17451,31 +17473,63 @@ begin
     New_FuncContext.ThisPas:=El;
     New_FuncContext.IsGlobal:=true;
 
+    // Note: a newinstance call looks like this: THelper.$new("NewHlp", [3]);
+    // The $new function:
+    // this.$new = function(fnname,args){
+    // record:
+    //   return this[fnname].call(TRecType.$new(),args);
+    // other:
+    //   return this[fnname].call({p:SelfJS,get,set},args);
+    // }
+    ReturnSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
+    AddToSourceElements(New_Src,ReturnSt);
+    Call:=CreateCallExpression(El);
+    ReturnSt.Expr:=Call;
+    DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
+    Call.Expr:=DotExpr;
+    BracketExpr:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
+    DotExpr.MExpr:=BracketExpr;
+    DotExpr.Name:='call';
+    BracketExpr.MExpr:=CreatePrimitiveDotExpr('this',El);
+    BracketExpr.Name:=CreatePrimitiveDotExpr(FunName,El);
+    SelfJS:=CreateValInit(HelperForType,nil,El,New_FuncContext);
     if HelperForType.ClassType=TPasRecordType then
-      begin
-      // record helper
-      // Note: a newinstance call looks like this: THelper.$new("NewHlp", [3]);
-      // The $new function:
-      // this.$new = function(fnname,args){
-      //   return this[fnname].call(TRecType.$new(),args);
-      // }
-      ReturnSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
-      AddToSourceElements(New_Src,ReturnSt);
-      Call:=CreateCallExpression(El);
-      ReturnSt.Expr:=Call;
-      DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,El));
-      Call.Expr:=DotExpr;
-      BracketExpr:=TJSBracketMemberExpression(CreateElement(TJSBracketMemberExpression,El));
-      DotExpr.MExpr:=BracketExpr;
-      DotExpr.Name:='call';
-      BracketExpr.MExpr:=CreatePrimitiveDotExpr('this',El);
-      BracketExpr.Name:=CreatePrimitiveDotExpr(FunName,El);
-      Init:=CreateValInit(HelperForType,nil,El,New_FuncContext);
-      Call.AddArg(Init);
-      Call.AddArg(CreatePrimitiveDotExpr(ArgsName,El));
-      end
+      // pass new record directly
     else
-      RaiseNotSupported(El,AContext,20190208181800);
+      begin
+      // pass new value as reference
+      Obj:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,El));
+
+      // add "p: SelfJS"
+      ObjLit:=Obj.Elements.AddElement;
+      ObjLit.Name:=TJSString(ValueName);
+      ObjLit.Expr:=SelfJS;
+      SelfJS:=Obj;
+
+      // add "get: function(){return this.p}"
+      ObjLit:=Obj.Elements.AddElement;
+      ObjLit.Name:=TempRefObjGetterName;
+      FuncSt:=CreateFunctionSt(El);
+      ObjLit.Expr:=FuncSt;
+      RetSt:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
+      FuncSt.AFunction.Body.A:=RetSt;
+      RetSt.Expr:=CreateMemberExpression(['this',ValueName]);
+
+      // add "set: function(v){this.p=v}"
+      ObjLit:=Obj.Elements.AddElement;
+      ObjLit.Name:=TempRefObjSetterName;
+      FuncSt:=CreateFunctionSt(El);
+      ObjLit.Expr:=FuncSt;
+      SetterArgName:=TempRefObjSetterArgName;
+      FuncSt.AFunction.Params.Add(SetterArgName);
+      AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+      FuncSt.AFunction.Body.A:=AssignSt;
+      AssignSt.LHS:=CreateMemberExpression(['this',ValueName]);
+      AssignSt.Expr:=CreatePrimitiveDotExpr(SetterArgName,El);
+      end;
+
+    Call.AddArg(SelfJS);
+    Call.AddArg(CreatePrimitiveDotExpr(ArgsName,El));
     // this.$new = function(fnname,args){
     AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
     AddToSourceElements(Src,AssignSt);
@@ -20722,7 +20776,10 @@ begin
       DotExpr.MExpr:=CreatePrimitiveDotExpr('this.'+GetPathName,El);
       GetExpr:=DotExpr;
       FullGetter:=nil;
-      SetExpr:=CreatePrimitiveDotExpr('this.'+GetPathName+'.'+String(DotExpr.Name),El);
+      if (rrfWritable in ResolvedEl.Flags) then
+        SetExpr:=CreatePrimitiveDotExpr('this.'+GetPathName+'.'+String(DotExpr.Name),El)
+      else
+        SetExpr:=IfReadOnlyCreateRaiseE(ParamContext);
       end
     else if FullGetter.ClassType=TJSBracketMemberExpression then
       begin

packages/pastojs/tests/tcmodules.pas

@@ -660,16 +660,13 @@ type
     // todo: TestTypeHelper_Property_Array
     // todo: TestTypeHelper_ClassProperty
     // todo: TestTypeHelper_ClassProperty_Array
-    // todo: TestTypeHelper_ClassMethod
-    // todo: TestTypeHelper_Constructor;
+    Procedure TestTypeHelper_ClassMethod;
+    Procedure TestTypeHelper_Constructor;
     Procedure TestTypeHelper_Word;
-    Procedure TestTypeHelper_String;
-    //Procedure TestTypeHelper_Char;
-    //Procedure TestTypeHelper_Currency;
-    //Procedure TestTypeHelper_Array;
-    //Procedure TestTypeHelper_EnumType;
-    //Procedure TestTypeHelper_SetType;
-    //Procedure TestTypeHelper_InterfaceFail;
+    Procedure TestTypeHelper_StringChar;
+    Procedure TestTypeHelper_Array;
+    Procedure TestTypeHelper_EnumType;
+    Procedure TestTypeHelper_SetType; // ToDo
 
     // proc types
     Procedure TestProcType;
@@ -21027,14 +21024,7 @@ begin
     'this.FooVar = function (a) {',
     '  $mod.THelper.DoIt.apply(a, 123);',
     '  var $with1 = a.get();',
-    '  $mod.THelper.DoIt.apply({',
-    '    get: function () {',
-    '        return $with1;',
-    '      },',
-    '    set: function (v) {',
-    '        $with1 = v;',
-    '      }',
-    '  }, 123);',
+    '  $mod.THelper.DoIt.apply(a, 123);',
     '};',
     '']),
     LinesToStr([ // $mod.$main
@@ -21206,6 +21196,110 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestTypeHelper_ClassMethod;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  THelper = type helper for word',
+  '    class procedure DoStatic; static;',
+  '  end;',
+  'class procedure THelper.DoStatic;',
+  'begin',
+  '  DoStatic;',
+  '  DoStatic();',
+  'end;',
+  'var w: word;',
+  'begin',
+  '  w.DoStatic;',
+  '  w.DoStatic();',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_ClassMethod',
+    LinesToStr([ // statements
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.DoStatic = function () {',
+    '    $mod.THelper.DoStatic();',
+    '    $mod.THelper.DoStatic();',
+    '  };',
+    '});',
+    'this.w = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.THelper.DoStatic();',
+    '$mod.THelper.DoStatic();',
+    '']));
+end;
+
+procedure TTestModule.TestTypeHelper_Constructor;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  THelper = type helper for word',
+  '    constructor Init(e: longint);',
+  '  end;',
+  'constructor THelper.Init(e: longint);',
+  'begin',
+  '  Self:=e;',
+  '  Init(e+1);',
+  'end;',
+  'var w: word;',
+  'begin',
+  '  w:=word.Init(2);',
+  '  w:=w.Init(3);',
+  '  with word do w:=Init(4);',
+  '  with w do w:=Init(5);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_Constructor',
+    LinesToStr([ // statements
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.Init = function (e) {',
+    '    this.set(e);',
+    '    $mod.THelper.Init.apply(this, e + 1);',
+    '    return this;',
+    '  };',
+    '  this.$new = function (fn, args) {',
+    '    return this[fn].call({',
+    '      p: 0,',
+    '      get: function () {',
+    '          return this.p;',
+    '        },',
+    '      set: function (v) {',
+    '          this.p = v;',
+    '        }',
+    '    }, args);',
+    '  };',
+    '});',
+    'this.w = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.w = $mod.THelper.$new("Init", [2]);',
+    '$mod.w = $mod.THelper.Init.apply({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.w;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.w = v;',
+    '    }',
+    '}, 3);',
+    '$mod.w = $mod.THelper.$new("Init", [4]);',
+    'var $with1 = $mod.w;',
+    '$mod.w = $mod.THelper.Init.apply({',
+    '  get: function () {',
+    '      return $with1;',
+    '    },',
+    '  set: function (v) {',
+    '      $with1 = v;',
+    '    }',
+    '}, 5);',
+    '']));
+end;
+
 procedure TTestModule.TestTypeHelper_Word;
 begin
   StartProgram(false);
@@ -21232,14 +21326,7 @@ begin
     '    this.set(e);',
     '    this.set(this.get() + 1);',
     '    var $with1 = this.get();',
-    '    $mod.THelper.DoIt.apply({',
-    '      get: function () {',
-    '          return $with1;',
-    '        },',
-    '      set: function (v) {',
-    '          $with1 = v;',
-    '        }',
-    '    }, 123);',
+    '    $mod.THelper.DoIt.apply(this, 123);',
     '  };',
     '});',
     '']),
@@ -21255,7 +21342,7 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestTypeHelper_String;
+procedure TTestModule.TestTypeHelper_StringChar;
 begin
   StartProgram(false);
   Add([
@@ -21282,7 +21369,7 @@ begin
   '  ''c''.Fly();',
   '']);
   ConvertProgram;
-  CheckSource('TestTypeHelper_String',
+  CheckSource('TestTypeHelper_StringChar',
     LinesToStr([ // statements
     'rtl.createHelper($mod, "TStringHelper", null, function () {',
     '  this.DoIt = function (e) {',
@@ -21324,6 +21411,226 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestTypeHelper_Array;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TArrOfBool = array of boolean;',
+  '  TArrOfJS = array of jsvalue;',
+  '  THelper = type helper for TArrOfBool',
+  '    procedure DoIt(e: byte = 123);',
+  '  end;',
+  'procedure THelper.DoIt(e: byte);',
+  'begin',
+  '  Self[1]:=true;',
+  '  Self[2]:=not Self[3];',
+  '  SetLength(Self,4);',
+  'end;',
+  'var',
+  '  b: TArrOfBool;',
+  '  j: TArrOfJS;',
+  'begin',
+  '  b.DoIt;',
+  '  TArrOfBool(j).DoIt();',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_Array',
+    LinesToStr([ // statements
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.DoIt = function (e) {',
+    '    this.get()[1] = true;',
+    '    this.get()[2] = !this.get()[3];',
+    '    this.set(rtl.arraySetLength(this.get(), false, 4));',
+    '  };',
+    '});',
+    'this.b = [];',
+    'this.j = [];',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.THelper.DoIt.apply({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.b;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.b = v;',
+    '    }',
+    '}, 123);',
+    '$mod.THelper.DoIt.apply({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.j;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.j = v;',
+    '    }',
+    '}, 123);',
+    '']));
+end;
+
+procedure TTestModule.TestTypeHelper_EnumType;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TEnum = (red,blue);',
+  '  THelper = type helper for TEnum',
+  '    procedure DoIt(e: byte = 123);',
+  '    class procedure Swing(w: word); static;',
+  '  end;',
+  'procedure THelper.DoIt(e: byte);',
+  'begin',
+  '  Self:=red;',
+  '  Self:=succ(Self);',
+  '  with Self do Doit;',
+  'end;',
+  'class procedure THelper.Swing(w: word);',
+  'begin',
+  'end;',
+  'var e: TEnum;',
+  'begin',
+  '  e.DoIt;',
+  '  red.DoIt;',
+  '  TEnum.blue.DoIt;',
+  '  TEnum(1).DoIt;',
+  '  TEnum.Swing(3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_EnumType',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "blue",',
+    '  blue: 1',
+    '};',
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.DoIt = function (e) {',
+    '    this.set($mod.TEnum.red);',
+    '    this.set(this.get() + 1);',
+    '    var $with1 = this.get();',
+    '    $mod.THelper.DoIt.apply(this, 123);',
+    '  };',
+    '  this.Swing = function (w) {',
+    '  };',
+    '});',
+    'this.e = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.THelper.DoIt.apply({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.e;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.e = v;',
+    '    }',
+    '}, 123);',
+    '$mod.THelper.DoIt.apply({',
+    '  p: $mod.TEnum,',
+    '  get: function () {',
+    '      return this.p.red;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.raiseE("EPropReadOnly");',
+    '    }',
+    '}, 123);',
+    '$mod.THelper.DoIt.apply({',
+    '  p: $mod.TEnum,',
+    '  get: function () {',
+    '      return this.p.blue;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.raiseE("EPropReadOnly");',
+    '    }',
+    '}, 123);',
+    '$mod.THelper.DoIt.apply({',
+    '  get: function () {',
+    '      return 1;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.raiseE("EPropReadOnly");',
+    '    }',
+    '}, 123);',
+    '$mod.THelper.Swing(3);',
+    '']));
+end;
+
+procedure TTestModule.TestTypeHelper_SetType;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TEnum = (red,blue);',
+  '  TSetOfEnum = set of TEnum;',
+  '  THelper = type helper for TSetOfEnum',
+  '    procedure DoIt(e: byte = 123);',
+  '    constructor Init(e: TEnum);',
+  '  end;',
+  'procedure THelper.DoIt(e: byte);',
+  'begin',
+  '  Self:=[];',
+  '  Self:=[red];',
+  '  Include(Self,blue);',
+  'end;',
+  'constructor THelper.Init(e: TEnum);',
+  'begin',
+  '  Self:=[];',
+  '  Self:=[e];',
+  '  Include(Self,blue);',
+  'end;',
+  'var s: TSetOfEnum;',
+  'begin',
+  //'  s.DoIt;',
+  //'  [red].DoIt;',
+  //'  with s do DoIt;',
+  //'  with [red,blue] do DoIt;',
+  //'  s:=TSetOfEnum.Init(blue);',
+  //'  s:=s.Init(blue);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_SetType',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "blue",',
+    '  blue: 1',
+    '};',
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.DoIt = function (e) {',
+    '    this.set({});',
+    '    this.set(rtl.createSet($mod.TEnum.red));',
+    '    this.set(rtl.includeSet(this.get(), $mod.TEnum.blue));',
+    '  };',
+    '  this.Init = function (e) {',
+    '    this.set({});',
+    '    this.set(rtl.createSet(e));',
+    '    this.set(rtl.includeSet(this.get(), $mod.TEnum.blue));',
+    '    return this;',
+    '  };',
+    '  this.$new = function (fn, args) {',
+    '    return this[fn].call({',
+    '      p: {},',
+    '      get: function () {',
+    '          return this.p;',
+    '        },',
+    '      set: function (v) {',
+    '          this.p = v;',
+    '        }',
+    '    }, args);',
+    '  };',
+    '});',
+    'this.s = {};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);