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

pas2js: fixed delay init specializations after loading impl sections

Browse Source
This commit is contained in:
mattias 2021-04-18 12:58:55 +00:00
parent be2c9a4933
commit 16595a5696
2 changed files with 107 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
compiler/packages/pastojs/src/fppas2js.pp
View File

@ -2072,8 +2072,8 @@ type
Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual; Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual; Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual; Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual;
Procedure AddDelayedInits(El: TPasProgram; Src: TJSSourceElements; AContext: TConvertContext); virtual; function AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext): boolean; virtual;
Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual; function CreateDelaySpecializeInit(El: TPasGenericType; AContext: TConvertContext): TJSElement; virtual;
// enum and sets // enum and sets
Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual; Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual;
// record // record
@ -8142,7 +8142,7 @@ Var
ModuleName, ModVarName: String; ModuleName, ModVarName: String;
IntfContext: TSectionContext; IntfContext: TSectionContext;
ImplVarSt: TJSVariableStatement; ImplVarSt: TJSVariableStatement;
HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean; HasImplCode, ok, NeedRTLCheckVersion: Boolean;
Prg: TPasProgram; Prg: TPasProgram;
Lib: TPasLibrary; Lib: TPasLibrary;
AssignSt: TJSSimpleAssignStatement; AssignSt: TJSSimpleAssignStatement;
@ -8223,7 +8223,7 @@ begin
Prg:=TPasProgram(El); Prg:=TPasProgram(El);
if Assigned(Prg.ProgramSection) then if Assigned(Prg.ProgramSection) then
AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext)); AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext));
AddDelayedInits(Prg,Src,IntfContext); HasImplCode:=AddDelayedInits(Prg,Src,IntfContext);
CreateInitSection(Prg,Src,IntfContext); CreateInitSection(Prg,Src,IntfContext);
end end
else if El is TPasLibrary then else if El is TPasLibrary then
@ -8231,7 +8231,7 @@ begin
Lib:=TPasLibrary(El); Lib:=TPasLibrary(El);
if Assigned(Lib.LibrarySection) then if Assigned(Lib.LibrarySection) then
AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext)); AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext));
// ToDo AddDelayedInits(Lib,Src,IntfContext); HasImplCode:=AddDelayedInits(Lib,Src,IntfContext);
CreateInitSection(Lib,Src,IntfContext); CreateInitSection(Lib,Src,IntfContext);
end end
else else
@ -8262,20 +8262,19 @@ begin
if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
begin begin
// empty implementation // empty implementation
// remove unneeded $impl from interface // remove unneeded $impl from interface
RemoveFromSourceElements(Src,ImplVarSt); RemoveFromSourceElements(Src,ImplVarSt);
// remove unneeded $mod.$implcode = function(){} // remove unneeded $mod.$implcode = function(){}
RemoveFromSourceElements(Src,AssignSt); RemoveFromSourceElements(Src,AssignSt);
HasImplUsesClause:=(El.ImplementationSection<>nil) HasImplCode:=(El.ImplementationSection<>nil)
and (length(El.ImplementationSection.UsesClause)>0); and (length(El.ImplementationSection.UsesClause)>0);
end end
else else
begin begin
HasImplUsesClause:=true; HasImplCode:=true;
end; end;
if HasImplUsesClause then if HasImplCode then
// add implementation uses list: [<implementation uses1>,<uses2>, ...] // add implementation uses list: [<implementation uses1>,<uses2>, ...]
ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext)); ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
@ -8286,7 +8285,6 @@ begin
finally finally
IntfContext.Free; IntfContext.Free;
end; end;
// add implementation function // add implementation function
if ImplVarSt<>nil then if ImplVarSt<>nil then
begin begin
@ -17783,13 +17781,18 @@ begin
IntfSec.AddImplHeaderStatement(JS); IntfSec.AddImplHeaderStatement(JS);
end; end;
procedure TPasToJSConverter.AddDelayedInits(El: TPasProgram; function TPasToJSConverter.AddDelayedInits(El: TPasModule;
Src: TJSSourceElements; AContext: TConvertContext); Src: TJSSourceElements; AContext: TConvertContext): boolean;
var var
aResolver: TPas2JSResolver; aResolver: TPas2JSResolver;
Hub: TPas2JSResolverHub; Hub: TPas2JSResolverHub;
i: Integer; i: Integer;
JS: TJSElement;
AssignSt: TJSSimpleAssignStatement;
FunDecl: TJSFunctionDeclarationStatement;
ImplSrc: TJSSourceElements;
begin begin
Result:=false;
aResolver:=AContext.Resolver; aResolver:=AContext.Resolver;
if aResolver=nil then exit; if aResolver=nil then exit;
if El=nil then ; if El=nil then ;
@ -17797,12 +17800,29 @@ begin
{$IFDEF VerbosePas2JS} {$IFDEF VerbosePas2JS}
writeln('TPasToJSConverter.AddDelayedInits Hub.JSDelaySpecializeCount=',Hub.JSDelaySpecializeCount); writeln('TPasToJSConverter.AddDelayedInits Hub.JSDelaySpecializeCount=',Hub.JSDelaySpecializeCount);
{$ENDIF} {$ENDIF}
ImplSrc:=nil;
for i:=0 to Hub.JSDelaySpecializeCount-1 do for i:=0 to Hub.JSDelaySpecializeCount-1 do
AddDelaySpecializeInit(Hub.JSDelaySpecializes[i],Src,AContext); begin
JS:=CreateDelaySpecializeInit(Hub.JSDelaySpecializes[i],AContext);
if JS=nil then continue;
if ImplSrc=nil then
begin
// create "$mod.$implcode = function(){ }"
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
AddToSourceElements(Src,AssignSt);
AssignSt.LHS:=CreateMemberExpression([GetBIName(pbivnModule),GetBIName(pbivnImplCode)]);
// create function(){}
FunDecl:=CreateFunctionSt(El,true,true);
AssignSt.Expr:=FunDecl;
ImplSrc:=TJSSourceElements(FunDecl.AFunction.Body.A);
end;
AddToSourceElements(ImplSrc,JS);
Result:=true;
end;
end; end;
procedure TPasToJSConverter.AddDelaySpecializeInit(El: TPasGenericType; function TPasToJSConverter.CreateDelaySpecializeInit(El: TPasGenericType;
Src: TJSSourceElements; AContext: TConvertContext); AContext: TConvertContext): TJSElement;
var var
C: TClass; C: TClass;
Path: String; Path: String;
@ -17813,6 +17833,7 @@ var
ElTypeHi, ElTypeLo: TPasType; ElTypeHi, ElTypeLo: TPasType;
aResolver: TPas2JSResolver; aResolver: TPas2JSResolver;
begin begin
Result:=nil;
if not IsElementUsed(El) then exit; if not IsElementUsed(El) then exit;
if not AContext.Resolver.IsFullySpecialized(El) then if not AContext.Resolver.IsFullySpecialized(El) then
RaiseNotSupported(El,AContext,20201202145045,'not fully specialized, probably a bug in the analyzer'); RaiseNotSupported(El,AContext,20201202145045,'not fully specialized, probably a bug in the analyzer');
@ -17826,7 +17847,7 @@ begin
Path:=CreateReferencePath(El,AContext,rpkPathAndName)+'.'+GetBIName(pbifnClassInitSpecialize); Path:=CreateReferencePath(El,AContext,rpkPathAndName)+'.'+GetBIName(pbifnClassInitSpecialize);
Call:=CreateCallExpression(El); Call:=CreateCallExpression(El);
Call.Expr:=CreatePrimitiveDotExpr(Path,El); Call.Expr:=CreatePrimitiveDotExpr(Path,El);
AddToSourceElements(Src,Call); Result:=Call;
end end
else if (C=TPasProcedureType) or (C=TPasFunctionType) then else if (C=TPasProcedureType) or (C=TPasFunctionType) then
begin begin
@ -17838,7 +17859,7 @@ begin
DotExpr.Name:=TJSString(GetBIName(pbivnRTTIProc_InitSpec)); DotExpr.Name:=TJSString(GetBIName(pbivnRTTIProc_InitSpec));
Call:=CreateCallExpression(El); Call:=CreateCallExpression(El);
Call.Expr:=DotExpr; Call.Expr:=DotExpr;
AddToSourceElements(Src,Call); Result:=Call;
end end
else if (C=TPasArrayType) then else if (C=TPasArrayType) then
begin begin
@ -17865,7 +17886,7 @@ begin
AssignSt.LHS:=CreateDotNameExpr(El,CreateTypeInfoRef(El,AContext,El), AssignSt.LHS:=CreateDotNameExpr(El,CreateTypeInfoRef(El,AContext,El),
TJSString(GetBIName(pbivnRTTIArray_ElType))); TJSString(GetBIName(pbivnRTTIArray_ElType)));
AssignSt.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El); AssignSt.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El);
AddToSourceElements(Src,AssignSt); Result:=AssignSt;
end end
else else
RaiseNotSupported(El,AContext,20200831115251); RaiseNotSupported(El,AContext,20200831115251);

78
compiler/packages/pastojs/tests/tcgenerics.pas
View File

@ -20,7 +20,7 @@ type
Procedure TestGen_Record_ClassVarRecord_Program; Procedure TestGen_Record_ClassVarRecord_Program;
Procedure TestGen_Record_ClassVarRecord_UnitImpl; Procedure TestGen_Record_ClassVarRecord_UnitImpl;
Procedure TestGen_Record_RTTI_UnitImpl; Procedure TestGen_Record_RTTI_UnitImpl;
// ToDo: delay RTTI with anonymous array a:array of T, array[1..2] of T procedure TestGen_Record_Delay_UsedByImplUses;
// ToDo: type alias type as parameter, TBird = type word; // ToDo: type alias type as parameter, TBird = type word;
// generic class // generic class
@ -288,7 +288,9 @@ begin
'}, []);'])); '}, []);']));
CheckSource('TestGen_Record_ClassVarRecord_UnitImpl', CheckSource('TestGen_Record_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.TAnt$G1.$initSpec();', '$mod.$implcode = function () {',
' pas.UnitA.TAnt$G1.$initSpec();',
'};',
'']), '']),
LinesToStr([ // $mod.$main LinesToStr([ // $mod.$main
''])); '']));
@ -355,6 +357,53 @@ begin
''])); '']));
end; end;
procedure TTestGenerics.TestGen_Record_Delay_UsedByImplUses;
begin
WithTypeInfo:=true;
StartProgram(true,[supTObject]);
AddModuleWithIntfImplSrc('UnitA.pas',
LinesToStr([
'{$modeswitch AdvancedRecords}',
'type',
' generic TBird<T> = record',
' class var a: T;',
' end;',
'']),
LinesToStr([
'']));
AddModuleWithIntfImplSrc('UnitB.pas',
LinesToStr([
'procedure Fly;',
'']),
LinesToStr([
'uses UnitA;',
'type',
' TFox = record',
' B: word;',
' end;',
'procedure Fly;',
'var Bird: specialize TBird<TFox>;',
'begin',
' if typeinfo(Bird)<>nil then ;',
' Bird.a:=Bird.a;',
'end;',
'']));
Add([
'uses UnitB;',
'begin',
' Fly;']);
ConvertProgram;
CheckSource('TestGen_Record_Delay_UsedByImplUses',
LinesToStr([ // statements
'$mod.$implcode = function () {',
' pas.UnitA.TBird$G1.$initSpec();',
'};',
'']),
LinesToStr([ // $mod.$main
'pas.UnitB.Fly();'
]));
end;
procedure TTestGenerics.TestGen_ClassEmpty; procedure TTestGenerics.TestGen_ClassEmpty;
begin begin
StartProgram(false); StartProgram(false);
@ -1201,7 +1250,9 @@ begin
''])); '']));
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.TAnt$G1.$initSpec();', '$mod.$implcode = function () {',
' pas.UnitA.TAnt$G1.$initSpec();',
'};',
'']), '']),
LinesToStr([ // $mod.$main LinesToStr([ // $mod.$main
''])); '']));
@ -1453,7 +1504,6 @@ begin
'}, []);'])); '}, []);']));
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
//'pas.UnitA.TAnt$G1.$initSpec();',
'']), '']),
LinesToStr([ // $mod.$main LinesToStr([ // $mod.$main
''])); '']));
@ -1706,7 +1756,9 @@ begin
' rtl.addIntf(this, pas.system.IUnknown);', ' rtl.addIntf(this, pas.system.IUnknown);',
'});', '});',
'this.i = null;', 'this.i = null;',
'pas.UnitA.TAnt$G1.$initSpec();', '$mod.$implcode = function () {',
' pas.UnitA.TAnt$G1.$initSpec();',
'};',
'']), '']),
LinesToStr([ // $mod.$main LinesToStr([ // $mod.$main
'rtl.setIntfP($mod, "i", rtl.queryIntfT($mod.TBird.$create("Create"), pas.UnitA.TAnt$G1), true);', 'rtl.setIntfP($mod, "i", rtl.queryIntfT($mod.TBird.$create("Create"), pas.UnitA.TAnt$G1), true);',
@ -2424,7 +2476,9 @@ begin
'});'])); '});']));
CheckSource('TestGen_Array_OtherUnit', CheckSource('TestGen_Array_OtherUnit',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.$rtti["TDyn<UnitB.TAnt>"].eltype = pas.UnitB.$rtti["TAnt"];', '$mod.$implcode = function () {',
' pas.UnitA.$rtti["TDyn<UnitB.TAnt>"].eltype = pas.UnitB.$rtti["TAnt"];',
'};',
'']), '']),
LinesToStr([ // $mod.$main LinesToStr([ // $mod.$main
' pas.UnitB.Run();', ' pas.UnitB.Run();',
@ -2504,9 +2558,11 @@ begin
'}, []);'])); '}, []);']));
CheckSource('TestGen_ArrayOfUnitImplRec', CheckSource('TestGen_ArrayOfUnitImplRec',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.$rtti["TDyn<UnitA.TAnt>"].eltype = pas.UnitA.$rtti["TAnt"];', '$mod.$implcode = function () {',
'pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];', ' pas.UnitA.$rtti["TDyn<UnitA.TAnt>"].eltype = pas.UnitA.$rtti["TAnt"];',
'pas.UnitA.$rtti["TStatic<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];', ' pas.UnitA.$rtti["TDyn<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
' pas.UnitA.$rtti["TStatic<UnitA.TBird>"].eltype = pas.UnitA.$rtti["TBird"];',
'};',
'']), '']),
LinesToStr([ // $mod.$main LinesToStr([ // $mod.$main
''])); '']));
@ -2673,7 +2729,9 @@ begin
'}, []);'])); '}, []);']));
CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
LinesToStr([ // statements LinesToStr([ // statements
'pas.UnitA.$rtti["TAnt<UnitA.TBird>"].init();', '$mod.$implcode = function () {',
' pas.UnitA.$rtti["TAnt<UnitA.TBird>"].init();',
'};',
'']), '']),
LinesToStr([ // $mod.$main LinesToStr([ // $mod.$main
''])); '']));