diff --git a/compiler/packages/pastojs/src/fppas2js.pp b/compiler/packages/pastojs/src/fppas2js.pp index 2954b22..ae9ab02 100644 --- a/compiler/packages/pastojs/src/fppas2js.pp +++ b/compiler/packages/pastojs/src/fppas2js.pp @@ -3106,8 +3106,13 @@ end; procedure TPas2JSResolver.AddRecordType(El: TPasRecordType); begin inherited; - if El.Name='' then + if (El.Name='') and (El.Parent.ClassType<>TPasVariant) then + begin + {$IFDEF VerbosePas2JS} + writeln('TPas2JSResolver.AddRecordType ',GetObjName(El.Parent)); + {$ENDIF} RaiseNotYetImplemented(20190408224556,El,'anonymous record type'); + end; if El.Parent is TProcedureBody then // local record AddElevatedLocal(El); @@ -6304,15 +6309,17 @@ end; function TPasToJSConverter.CreateFreeOrNewInstanceExpr(Ref: TResolvedReference; AContext: TConvertContext): TJSCallExpression; -// create "$create("funcname");" +// class: create "$create("ProcName")" +// record: create "$new().ProcName()" var - C: TJSCallExpression; + C, SubCall: TJSCallExpression; Proc: TPasProcedure; ProcScope: TPasProcedureScope; ClassRecScope: TPasClassOrRecordScope; ClassOrRec: TPasElement; ArgEx: TJSLiteral; - FunName: String; + FunName, ProcName: String; + DotExpr: TJSDotMemberExpression; begin Result:=nil; //writeln('TPasToJSConverter.CreateFreeOrNewInstanceExpr Ref.Declaration=',GetObjName(Ref.Declaration)); @@ -6328,16 +6335,33 @@ begin RaiseInconsistency(20170125191923,ClassOrRec); C:=CreateCallExpression(Ref.Element); try - // add "$create()" - if rrfNewInstance in Ref.Flags then - FunName:=GetBIName(pbifnClassInstanceNew) + ProcName:=TransformVariableName(Proc,AContext); + if ClassOrRec.ClassType=TPasRecordType then + begin + // create "path.$new()" + FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+GetBIName(pbifnRecordNew); + SubCall:=CreateCallExpression(Ref.Element); + SubCall.Expr:=CreatePrimitiveDotExpr(FunName,Ref.Element); + // append ".ProcName" + DotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,Ref.Element)); + DotExpr.MExpr:=SubCall; + DotExpr.Name:=TJSString(ProcName); + // as call: "path.$new().ProcName()" + C.Expr:=DotExpr; + end else - FunName:=GetBIName(pbifnClassInstanceFree); - FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+FunName; - C.Expr:=CreatePrimitiveDotExpr(FunName,Ref.Element); - // parameter: "funcname" - ArgEx := CreateLiteralString(Ref.Element,TransformVariableName(Proc,AContext)); - C.AddArg(ArgEx); + begin + // add "$create()" + if rrfNewInstance in Ref.Flags then + FunName:=GetBIName(pbifnClassInstanceNew) + else + FunName:=GetBIName(pbifnClassInstanceFree); + FunName:=CreateReferencePath(Proc,AContext,rpkPathWithDot,false,Ref)+FunName; + C.Expr:=CreatePrimitiveDotExpr(FunName,Ref.Element); + // parameter: "ProcName" + ArgEx := CreateLiteralString(Ref.Element,ProcName); + C.AddArg(ArgEx); + end; Result:=C; finally if Result=nil then @@ -7995,10 +8019,16 @@ begin 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.AddArg(ArrLit); + if Decl.Parent.ClassType=TPasRecordType then + // insert default parameters, e.g. TRecord.$new().create(1,2,3) + CreateProcedureCallArgs(Call.Args.Elements,nil,TargetProcType,AContext) + else + begin + // insert array parameter [], e.g. TObject.$create("create",[]) + ArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El)); + CreateProcedureCallArgs(ArrLit.Elements,nil,TargetProcType,AContext); + Call.AddArg(ArrLit); + end; end; exit; end; @@ -9360,7 +9390,8 @@ var end; if Call=nil then Call:=CreateFreeOrNewInstanceExpr(Ref,AContext); - if rrfNewInstance in Ref.Flags then + if (rrfNewInstance in Ref.Flags) + and (Ref.Declaration.Parent.ClassType=TPasClassType) then begin // insert array parameter [], e.g. this.TObject.$create("create",[]) JsArrLit:=TJSArrayLiteral(CreateElement(TJSArrayLiteral,El)); diff --git a/compiler/packages/pastojs/tests/tcmodules.pas b/compiler/packages/pastojs/tests/tcmodules.pas index 929792f..76bdc66 100644 --- a/compiler/packages/pastojs/tests/tcmodules.pas +++ b/compiler/packages/pastojs/tests/tcmodules.pas @@ -11223,6 +11223,7 @@ begin 'var r: TPoint;', 'begin', ' r:=TPoint.Create(1,2);', + ' with TPoint do r:=Create(1,2);', ' r.Create(3);', ' r:=r.Create(4);', '']); @@ -11249,7 +11250,9 @@ begin 'this.r = $mod.TPoint.$new();', '']), LinesToStr([ // $mod.$main - '$mod.r.$assign($mod.TPoint.$create("Create", [1, 2]));', + '$mod.r.$assign($mod.TPoint.$new().Create(1, 2));', + 'var $with1 = $mod.TPoint;', + '$mod.r.$assign($with1.$new().Create(1, 2));', '$mod.r.Create(3, -1);', '$mod.r.$assign($mod.r.Create(4, -1));', ''])); @@ -21298,7 +21301,7 @@ begin 'rtl.createHelper($mod, "THelper", null, function () {', ' this.NewHlp = function (w) {', ' this.Create(2);', - ' $mod.TRec.$create("Create", [3]);', + ' $mod.TRec.$new().Create(3);', ' $mod.THelper.NewHlp.call(this, 4);', ' $mod.THelper.$new("NewHlp", [5]);', ' return this;',