Browse Source

pastojs: call constructor without params, add default params

git-svn-id: trunk@37198 -
Mattias Gaertner 7 years ago
parent
commit
c586767de9
2 changed files with 61 additions and 3 deletions
  1. 17 3
      packages/pastojs/src/fppas2js.pp
  2. 44 0
      packages/pastojs/tests/tcmodules.pas

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

@@ -4595,7 +4595,8 @@ var
   Arg: TPasArgument;
   ParamContext: TParamContext;
   ResolvedEl: TPasResolverResult;
-  ProcType: TPasProcedureType;
+  ProcType, TargetProcType: TPasProcedureType;
+  ArrLit: TJSArrayLiteral;
 begin
   Result:=nil;
   if not (El.CustomData is TResolvedReference) then
@@ -4621,7 +4622,20 @@ begin
   if [rrfNewInstance,rrfFreeInstance]*Ref.Flags<>[] then
     begin
     // call constructor, destructor
-    Result:=CreateFreeOrNewInstanceExpr(Ref,AContext);
+    Call:=CreateFreeOrNewInstanceExpr(Ref,AContext);
+    Result:=Call;
+    if Decl is TPasProcedure then
+      begin
+      TargetProcType:=TPasProcedure(Decl).ProcType;
+      if TargetProcType.Args.Count>0 then
+        begin
+        // add default parameters:
+        // insert array parameter [], e.g. this.TObject.$create("create",[])
+        ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+        CreateProcedureCallArgs(ArrLit.Elements,nil,TargetProcType,AContext);
+        Call.Args.Elements.AddElement.Expr:=ArrLit;
+        end;
+      end;
     exit;
     end;
 
@@ -5651,6 +5665,7 @@ begin
         end
       else if Decl.CustomData is TResElDataBaseType then
         begin
+        // typecast to base type
         Result:=ConvertTypeCastToBaseType(El,AContext,TResElDataBaseType(Decl.CustomData));
         exit;
         end
@@ -6794,7 +6809,6 @@ begin
       else if TypeEl.ClassType=TPasArrayType then
         begin
         Ranges:=TPasArrayType(TypeEl).Ranges;
-        writeln('TPasToJSConverter.ConvertBuiltIn_Low AAA1');
         if length(Ranges)=0 then
           begin
           // dynamic array starts at 0

+ 44 - 0
packages/pastojs/tests/tcmodules.pas

@@ -335,6 +335,7 @@ type
     // classes
     Procedure TestClass_TObjectDefaultConstructor;
     Procedure TestClass_TObjectConstructorWithParams;
+    Procedure TestClass_TObjectConstructorWithDefaultParam;
     Procedure TestClass_Var;
     Procedure TestClass_Method;
     Procedure TestClass_Implementation;
@@ -6281,6 +6282,49 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestClass_TObjectConstructorWithDefaultParam;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('  public');
+  Add('    constructor Create;');
+  Add('  end;');
+  Add('  TTest = class(TObject)');
+  Add('  public');
+  Add('    constructor Create(const Par: longint = 1);');
+  Add('  end;');
+  Add('constructor tobject.create;');
+  Add('begin end;');
+  Add('constructor ttest.create(const par: longint);');
+  Add('begin end;');
+  Add('var t: ttest;');
+  Add('begin');
+  Add('  t:=ttest.create;');
+  Add('  t:=ttest.create(2);');
+  ConvertProgram;
+  CheckSource('TestClass_TObjectConstructorWithDefaultParam',
+    LinesToStr([ // statements
+    'rtl.createClass($mod,"TObject",null,function(){',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function(){',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TTest", $mod.TObject, function () {',
+    '  this.Create$1 = function (Par) {',
+    '  };',
+    '});',
+    'this.t = null;'
+    ]),
+    LinesToStr([ // $mod.$main
+    '$mod.t = $mod.TTest.$create("Create$1", [1]);',
+    '$mod.t = $mod.TTest.$create("Create$1", [2]);'
+    ]));
+end;
+
 procedure TTestModule.TestClass_Var;
 begin
   StartProgram(false);