pastojs: fixed TObject.Create()

git-svn-id: trunk@39477 -

packages/fcl-js/src/jstree.pp

@@ -1621,7 +1621,7 @@ end;
 
 destructor TJSArrayLiteralElement.Destroy;
 begin
-  FreeAndNil(Fexpr);
+  FreeAndNil(FExpr);
   inherited Destroy;
 end;
 

packages/pastojs/src/fppas2js.pp

@@ -5282,7 +5282,6 @@ var
   ClassScope: TPasClassScope;
   aClass: TPasElement;
   ArgEx: TJSLiteral;
-  ArgElems: TJSArrayLiteralElements;
   FunName: String;
 begin
   Result:=nil;
@@ -5308,10 +5307,9 @@ begin
       FunName:=FBuiltInNames[pbifnClassInstanceFree];
     FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+FunName;
     C.Expr:=CreatePrimitiveDotExpr(FunName,Ref.Element);
-    ArgElems:=C.Args.Elements;
     // parameter: "funcname"
     ArgEx := CreateLiteralString(Ref.Element,TransformVariableName(Proc,AContext));
-    ArgElems.AddElement.Expr:=ArgEx;
+    C.AddArg(ArgEx);
     ok:=true;
   finally
     if not ok then
@@ -6757,7 +6755,7 @@ begin
         // 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;
+        Call.AddArg(ArrLit);
         end;
       end;
     exit;
@@ -7908,7 +7906,7 @@ var
   TargetProcType: TPasProcedureType;
   Call: TJSCallExpression;
   Elements: TJSArrayLiteralElements;
-  E: TJSArrayLiteral;
+  JsArrLit: TJSArrayLiteral;
   OldAccess: TCtxAccess;
   DeclResolved, ParamResolved, ValueResolved: TPasResolverResult;
   Param: TPasExpr;
@@ -7920,6 +7918,7 @@ var
   aResolver: TPas2JSResolver;
   NeedIntfRef: Boolean;
   DestRange, SrcRange: TResEvalValue;
+  LastArg: TJSArrayLiteralElement;
 begin
   Result:=nil;
   if El.Kind<>pekFuncParams then
@@ -8216,8 +8215,19 @@ begin
       RaiseNotSupported(El,AContext,20170215114337);
       end;
     if [rrfNewInstance,rrfFreeInstance]*Ref.Flags<>[] then
+      begin
       // call constructor, destructor
       Call:=CreateFreeOrNewInstanceExpr(Ref,AContext);
+      if rrfNewInstance in Ref.Flags then
+        begin
+        // insert array parameter [], e.g. this.TObject.$create("create",[])
+        JsArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
+        Call.AddArg(JsArrLit);
+        Elements:=JsArrLit.Elements;
+        end
+      else
+        Elements:=Call.Args.Elements;
+      end;
     end;
 
   // BEWARE: TargetProcType can be nil, if called without resolver
@@ -8251,15 +8261,21 @@ begin
       Elements:=Call.Args.Elements;
       end
     else if Elements=nil then
+      RaiseInconsistency(20180720154413,El);
+    CreateProcedureCallArgs(Elements,El,TargetProcType,AContext);
+    if (Elements.Count=0)
+        and (Call.Args.Elements.Count>0)
+        then
       begin
-      // insert array parameter [], e.g. this.TObject.$create("create",[])
-      Elements:=Call.Args.Elements;
-      E:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El));
-      Elements.AddElement.Expr:=E;
-      Elements:=TJSArrayLiteral(E).Elements;
+      LastArg:=Call.Args.Elements[Call.Args.Elements.Count-1];
+      if not (LastArg.Expr is TJSArrayLiteral) then
+        RaiseNotSupported(El,AContext,20180720161317);
+      JsArrLit:=TJSArrayLiteral(LastArg.Expr);
+      if JsArrLit.Elements<>Elements then
+        RaiseNotSupported(El,AContext,20180720161324);
+      LastArg.Free;
       end;
-    CreateProcedureCallArgs(Elements,El,TargetProcType,AContext);
-    if Elements.Count=0 then
+    if Call.Args.Elements.Count=0 then
       begin
       Call.Args.Free;
       Call.Args:=nil;

packages/pastojs/tests/tcmodules.pas

@@ -9048,22 +9048,25 @@ end;
 procedure TTestModule.TestClass_TObjectDefaultConstructor;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class');
-  Add('  public');
-  Add('    constructor Create;');
-  Add('    destructor Destroy;');
-  Add('  end;');
-  Add('  TBird = TObject;');
-  Add('constructor tobject.create;');
-  Add('begin end;');
-  Add('destructor tobject.destroy;');
-  Add('begin end;');
-  Add('var Obj: tobject;');
-  Add('begin');
-  Add('  obj:=tobject.create;');
-  Add('  obj:=tbird.create;');
-  Add('  obj.destroy;');
+  Add(['type',
+  '  TObject = class',
+  '  public',
+  '    constructor Create;',
+  '    destructor Destroy;',
+  '  end;',
+  '  TBird = TObject;',
+  'constructor tobject.create;',
+  'begin end;',
+  'destructor tobject.destroy;',
+  'begin end;',
+  'var Obj: tobject;',
+  'begin',
+  '  obj:=tobject.create;',
+  '  obj:=tobject.create();',
+  '  obj:=tbird.create;',
+  '  obj:=tbird.create();',
+  '  obj.destroy;',
+  '']);
   ConvertProgram;
   CheckSource('TestClass_TObjectDefaultConstructor',
     LinesToStr([ // statements
@@ -9082,6 +9085,8 @@ begin
     LinesToStr([ // $mod.$main
     '$mod.Obj = $mod.TObject.$create("Create");',
     '$mod.Obj = $mod.TObject.$create("Create");',
+    '$mod.Obj = $mod.TObject.$create("Create");',
+    '$mod.Obj = $mod.TObject.$create("Create");',
     '$mod.Obj.$destroy("Destroy");',
     '']));
 end;

packages/pastojs/tests/testpas2js.pp

@@ -17,7 +17,9 @@ program testpas2js;
 {$mode objfpc}{$H+}
 
 uses
-  //MemCheck,
+  {$IFDEF EnableMemCheck}
+  MemCheck,
+  {$ENDIF}
   Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations, tcsrcmap,
   tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile;