paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 05:59:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed clear com interface reference in class field on destroy

Browse Source
This commit is contained in:
mattias 2021-10-21 20:02:22 +02:00
parent 36ff644401
commit 429438fbb9
2 changed files with 69 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -19175,6 +19175,9 @@ var
Func: TJSFunctionDeclarationStatement;
VarType: TPasType;
AssignSt: TJSSimpleAssignStatement;
C: TClass;
ElClass: TPasClassType;
Call: TJSCallExpression;
begin
// add instance members
AncestorIsExternal:=(Ancestor is TPasClassType) and TPasClassType(Ancestor).IsExternal;
@ -19204,13 +19207,29 @@ begin
// mfFinalize: clear reference
if vmExternal in TPasVariable(P).VarModifiers then continue;
VarType:=ClassContext.Resolver.ResolveAliasType(TPasVariable(P).VarType);
if (VarType.ClassType=TPasRecordType)
or (VarType.ClassType=TPasClassType)
or (VarType.ClassType=TPasClassOfType)
or (VarType.ClassType=TPasSetType)
or (VarType.ClassType=TPasProcedureType)
or (VarType.ClassType=TPasFunctionType)
or (VarType.ClassType=TPasArrayType) then
C:=VarType.ClassType;
if (C=TPasClassType) then
begin
ElClass:=TPasClassType(VarType);
if (ElClass.ObjKind=okInterface) and (ElClass.InterfaceType=citCom) then
begin
// rtl.setIntfP(this,"FieldName",null)
Call:=CreateCallExpression(El);
NewEl:=Call;
Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnIntfSetIntfP)]);
Call.AddArg(CreatePrimitiveDotExpr('this',El));
Call.AddArg(CreateLiteralString(El,TransformElToJSName(P,New_FuncContext)));
Call.AddArg(CreateLiteralNull(El));
end;
end;
if (NewEl=nil)
and ((C=TPasRecordType)
or (C=TPasClassType)
or (C=TPasClassOfType)
or (C=TPasSetType)
or (C=TPasProcedureType)
or (C=TPasFunctionType)
or (C=TPasArrayType)) then
begin
// add 'this.FieldName = undefined;'
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
@ -21123,7 +21142,7 @@ begin
Result:=Call;
if LHS is TJSDotMemberExpression then
begin
// path.name = RHS -> rtl.setIntfP(path,"IntfVar",RHS})
// path.name = RHS -> rtl.setIntfP(path,"IntfVar",RHS)
Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnIntfSetIntfP)]);
Call.AddArg(TJSDotMemberExpression(LHS).MExpr);
TJSDotMemberExpression(LHS).MExpr:=nil;
@ -21136,7 +21155,7 @@ begin
end
else if LHS is TJSBracketMemberExpression then
begin
// path[index] = RHS -> rtl.setIntfP(path,index,RHS})
// path[index] = RHS -> rtl.setIntfP(path,index,RHS)
Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnIntfSetIntfP)]);
Call.AddArg(TJSBracketMemberExpression(LHS).MExpr);
TJSBracketMemberExpression(LHS).MExpr:=nil;

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

@ -20,7 +20,7 @@
unit TCModules;
{$mode objfpc}{$H+}
{$Optimization }
interface
uses
@ -910,10 +910,9 @@ type
// Library
Procedure TestLibrary_Empty;
Procedure TestLibrary_ExportFunc; // ToDo
// ToDo: export let as let fail
// ToDo: Procedure TestLibrary_ExportVar;
// ToDo: Procedure TestLibrary_Export_Index_Fail;
Procedure TestLibrary_ExportFunc;
Procedure TestLibrary_Export_Index_Fail;
Procedure TestLibrary_ExportVar; // ToDo
// ToDo: test delayed specialization init
// ToDo: analyzer
end;
@ -20885,7 +20884,7 @@ begin
' this.FAnt = null;',
' };',
' this.$final = function () {',
' this.FAnt = undefined;',
' rtl.setIntfP(this, "FAnt", null);',
' };',
' rtl.addIntf(this, $mod.IUnknown);',
'});',
@ -21063,7 +21062,7 @@ begin
' this.FDoveObj = null;',
' };',
' this.$final = function () {',
' this.FBirdIntf = undefined;',
' rtl.setIntfP(this, "FBirdIntf", null);',
' this.FDoveObj = undefined;',
' $mod.TObject.$final.call(this);',
' };',
@ -33821,6 +33820,41 @@ begin
CheckResolverUnexpectedHints();
end;
procedure TTestModule.TestLibrary_Export_Index_Fail;
begin
StartLibrary(false);
Add([
'procedure Run(w: word);',
'begin',
'end;',
'exports',
' Run index 3;',
'']);
SetExpectedPasResolverError('Not supported: export index',nNotSupportedX);
ConvertLibrary;
end;
procedure TTestModule.TestLibrary_ExportVar;
begin
exit;
StartLibrary(false);
Add([
'var Wing: word;',
'exports',
' Wing;',
'']);
ConvertLibrary;
CheckSource('TestLibrary_ExportVar',
LinesToStr([ // statements
'this.Wing = 0;',
'export { this.Wing as Wing };',
'']),
LinesToStr([
'']));
CheckResolverUnexpectedHints();
end;
Initialization
RegisterTests([TTestModule]);
end.