paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 21:29:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed TObject.Create()

Browse Source 
git-svn-id: trunk@39477 -
This commit is contained in:
Mattias Gaertner 2018-07-20 14:17:44 +00:00
parent 42432d4ef3
commit d0baf0577d
4 changed files with 54 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-js/src/jstree.pp
View File

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

42
packages/pastojs/src/fppas2js.pp
View File

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

37
packages/pastojs/tests/tcmodules.pas
View File

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

4
packages/pastojs/tests/testpas2js.pp
View File

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