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

pastojs: allow calling Free inside method

Browse Source 
git-svn-id: trunk@40051 -
This commit is contained in:
Mattias Gaertner 2018-10-27 11:58:41 +00:00
parent 2b459b30d2
commit 5a88c840d8
2 changed files with 92 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1694,7 +1694,8 @@ type
Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
Function ConvertExternalConstructor(Left: TPasElement; Ref: TResolvedReference; Function ConvertExternalConstructor(Left: TPasElement; Ref: TResolvedReference;
ParamsExpr: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; ParamsExpr: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
Function ConvertTObjectFree(Bin: TBinaryExpr; NameExpr: TPasExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertTObjectFree_Bin(Bin: TBinaryExpr; NameExpr: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
Function ConvertTObjectFree_With(NameExpr: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
Function ConvertTypeCastToBaseType(El: TParamsExpr; AContext: TConvertContext; ToBaseTypeData: TResElDataBaseType): TJSElement; virtual; Function ConvertTypeCastToBaseType(El: TParamsExpr; AContext: TConvertContext; ToBaseTypeData: TResElDataBaseType): TJSElement; virtual;
Function ConvertArrayOrSetLiteral(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertArrayOrSetLiteral(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
Function ConvertBuiltIn_Length(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertBuiltIn_Length(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
@ -2488,6 +2489,7 @@ procedure TPas2JSResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
Left: TPasExpr; Left: TPasExpr;
LeftResolved: TPasResolverResult; LeftResolved: TPasResolverResult;
IdentEl: TPasElement; IdentEl: TPasElement;
C: TClass;
begin begin
if not IsTObjectFreeMethod(El) then exit; if not IsTObjectFreeMethod(El) then exit;
if Ref.WithExprScope<>nil then if Ref.WithExprScope<>nil then
@ -2497,8 +2499,10 @@ procedure TPas2JSResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
exit; // with TSomeClass.Free do Free -> ok exit; // with TSomeClass.Free do Free -> ok
RaiseMsg(20170517092407,nFreeNeedsVar,sFreeNeedsVar,[],El); RaiseMsg(20170517092407,nFreeNeedsVar,sFreeNeedsVar,[],El);
end; end;
if (El.Parent.ClassType<>TBinaryExpr) then C:=El.Parent.ClassType;
RaiseMsg(20170516151916,nFreeNeedsVar,sFreeNeedsVar,[],El); if (C=TBinaryExpr) then
begin
// expr.Free
Bin:=TBinaryExpr(El.Parent); Bin:=TBinaryExpr(El.Parent);
if (Bin.right<>El) or (Bin.OpCode<>eopSubIdent) then if (Bin.right<>El) or (Bin.OpCode<>eopSubIdent) then
RaiseMsg(20170516151950,nFreeNeedsVar,sFreeNeedsVar,[],El); RaiseMsg(20170516151950,nFreeNeedsVar,sFreeNeedsVar,[],El);
@ -2537,6 +2541,13 @@ procedure TPas2JSResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
if IdentEl.ClassType=TPasResultElement then if IdentEl.ClassType=TPasResultElement then
exit; // readable and writable function result -> ok exit; // readable and writable function result -> ok
RaiseMsg(20170516152455,nFreeNeedsVar,sFreeNeedsVar,[],El); RaiseMsg(20170516152455,nFreeNeedsVar,sFreeNeedsVar,[],El);
end
else if C.InheritsFrom(TPasImplBlock) then
begin
// e.g. "begin Free end;" OR "if expr then Free;" -> ok
exit;
end;
RaiseMsg(20170516152454,nFreeNeedsVar,sFreeNeedsVar,[],El);
end; end;
procedure CheckResultEl(Ref: TResolvedReference); procedure CheckResultEl(Ref: TResolvedReference);
@ -5388,7 +5399,6 @@ function TPasToJSConverter.CreateFreeOrNewInstanceExpr(Ref: TResolvedReference;
AContext: TConvertContext): TJSCallExpression; AContext: TConvertContext): TJSCallExpression;
// create "$create("funcname");" // create "$create("funcname");"
var var
ok: Boolean;
C: TJSCallExpression; C: TJSCallExpression;
Proc: TPasProcedure; Proc: TPasProcedure;
ProcScope: TPasProcedureScope; ProcScope: TPasProcedureScope;
@ -5411,7 +5421,6 @@ begin
RaiseInconsistency(20170125191923,aClass); RaiseInconsistency(20170125191923,aClass);
//writeln('TPasToJSConverter.CreateFreeOrNewInstanceExpr aClass.Name=',aClass.Name); //writeln('TPasToJSConverter.CreateFreeOrNewInstanceExpr aClass.Name=',aClass.Name);
C:=CreateCallExpression(Ref.Element); C:=CreateCallExpression(Ref.Element);
ok:=false;
try try
// add "$create()" // add "$create()"
if rrfNewInstance in Ref.Flags then if rrfNewInstance in Ref.Flags then
@ -5423,12 +5432,11 @@ begin
// parameter: "funcname" // parameter: "funcname"
ArgEx := CreateLiteralString(Ref.Element,TransformVariableName(Proc,AContext)); ArgEx := CreateLiteralString(Ref.Element,TransformVariableName(Proc,AContext));
C.AddArg(ArgEx); C.AddArg(ArgEx);
ok:=true; Result:=C;
finally finally
if not ok then if Result=nil then
C.Free; C.Free;
end; end;
Result:=C;
end; end;
function TPasToJSConverter.CreateFunctionSt(El: TPasElement; WithBody: boolean; function TPasToJSConverter.CreateFunctionSt(El: TPasElement; WithBody: boolean;
@ -6560,7 +6568,7 @@ begin
end end
else if aResolver.IsTObjectFreeMethod(RightEl) then else if aResolver.IsTObjectFreeMethod(RightEl) then
begin begin
Result:=ConvertTObjectFree(El,RightEl,AContext); Result:=ConvertTObjectFree_Bin(El,RightEl,AContext);
exit; exit;
end; end;
end; end;
@ -6869,7 +6877,7 @@ begin
if (Ref.WithExprScope<>nil) and aResolver.IsTObjectFreeMethod(El) then if (Ref.WithExprScope<>nil) and aResolver.IsTObjectFreeMethod(El) then
begin begin
Result:=ConvertTObjectFree(nil,El,AContext); Result:=ConvertTObjectFree_With(El,AContext);
exit; exit;
end; end;
@ -8468,7 +8476,7 @@ begin
end; end;
end; end;
function TPasToJSConverter.ConvertTObjectFree(Bin: TBinaryExpr; function TPasToJSConverter.ConvertTObjectFree_Bin(Bin: TBinaryExpr;
NameExpr: TPasExpr; AContext: TConvertContext): TJSElement; NameExpr: TPasExpr; AContext: TConvertContext): TJSElement;
function CreateCallRTLFree(Obj, Prop: TJSElement): TJSElement; function CreateCallRTLFree(Obj, Prop: TJSElement): TJSElement;
@ -8488,33 +8496,13 @@ var
DotExpr: TJSDotMemberExpression; DotExpr: TJSDotMemberExpression;
BracketJS: TJSBracketMemberExpression; BracketJS: TJSBracketMemberExpression;
aName: TJSString; aName: TJSString;
WithExprScope: TPas2JSWithExprScope;
begin begin
Result:=nil; Result:=nil;
LeftJS:=nil;
try
WithExprScope:=TResolvedReference(NameExpr.CustomData).WithExprScope as TPas2JSWithExprScope;
if WithExprScope<>nil then
begin
if AContext.Resolver.GetNewInstanceExpr(WithExprScope.Expr)<>nil then
begin
// "with TSomeClass.Create do Free"
// -> "$with1=rtl.freeLoc($with1);
Getter:=CreatePrimitiveDotExpr(WithExprScope.WithVarName,WithExprScope.Expr);
Setter:=CreatePrimitiveDotExpr(WithExprScope.WithVarName,WithExprScope.Expr);
Result:=CreateCallRTLFreeLoc(Setter,Getter,NameExpr);
exit;
end;
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.ConvertTObjectFree With=',GetObjName(WithExprScope.Expr));
{$ENDIF}
RaiseInconsistency(20170517092248,Bin);
end;
LeftJS:=ConvertElement(Bin.left,AContext); LeftJS:=ConvertElement(Bin.left,AContext);
try
{$IFDEF VerbosePas2JS} {$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.ConvertTObjectFree ',GetObjName(LeftJS)); writeln('TPasToJSConverter.ConvertTObjectFree_Bin ',GetObjName(LeftJS));
{$ENDIF} {$ENDIF}
if LeftJS is TJSPrimaryExpressionIdent then if LeftJS is TJSPrimaryExpressionIdent then
@ -8559,6 +8547,31 @@ begin
end; end;
end; end;
function TPasToJSConverter.ConvertTObjectFree_With(NameExpr: TPasExpr;
AContext: TConvertContext): TJSElement;
var
WithExprScope: TPas2JSWithExprScope;
Getter, Setter: TJSElement;
begin
Result:=nil;
WithExprScope:=TResolvedReference(NameExpr.CustomData).WithExprScope as TPas2JSWithExprScope;
if WithExprScope=nil then
RaiseInconsistency(20181027133210,NameExpr);
if AContext.Resolver.GetNewInstanceExpr(WithExprScope.Expr)<>nil then
begin
// "with TSomeClass.Create do Free"
// -> "$with1=rtl.freeLoc($with1);
Getter:=CreatePrimitiveDotExpr(WithExprScope.WithVarName,WithExprScope.Expr);
Setter:=CreatePrimitiveDotExpr(WithExprScope.WithVarName,WithExprScope.Expr);
Result:=CreateCallRTLFreeLoc(Setter,Getter,NameExpr);
exit;
end;
{$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.ConvertTObjectFree_With With=',GetObjName(WithExprScope.Expr));
{$ENDIF}
RaiseInconsistency(20170517092248,NameExpr);
end;
function TPasToJSConverter.ConvertTypeCastToBaseType(El: TParamsExpr; function TPasToJSConverter.ConvertTypeCastToBaseType(El: TParamsExpr;
AContext: TConvertContext; ToBaseTypeData: TResElDataBaseType): TJSElement; AContext: TConvertContext; ToBaseTypeData: TResElDataBaseType): TJSElement;
var var

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

@ -11793,10 +11793,16 @@ begin
' TObject = class', ' TObject = class',
' Obj: tobject;', ' Obj: tobject;',
' procedure Free;', ' procedure Free;',
' procedure Release;',
' end;', ' end;',
'procedure tobject.free;', 'procedure tobject.free;',
'begin', 'begin',
'end;', 'end;',
'procedure tobject.release;',
'begin',
' free;',
' if true then free;',
'end;',
'function DoIt(o: tobject): tobject;', 'function DoIt(o: tobject): tobject;',
'var l: tobject;', 'var l: tobject;',
'begin', 'begin',
@ -11830,6 +11836,10 @@ begin
' };', ' };',
' this.Free = function () {', ' this.Free = function () {',
' };', ' };',
' this.Release = function () {',
' this.Free();',
' if (true) this.Free();',
' };',
'});', '});',
'this.DoIt = function (o) {', 'this.DoIt = function (o) {',
' var Result = null;', ' var Result = null;',