From 1861dc83d971ab4e0c5135bf97e1d29dfd503726 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sun, 18 Apr 2021 12:51:54 +0000 Subject: [PATCH] pas2js: fixed delay init specializations after loading impl sections git-svn-id: trunk@49226 - --- packages/pastojs/src/fppas2js.pp | 63 ++++++++++++++-------- packages/pastojs/tests/tcgenerics.pas | 78 +++++++++++++++++++++++---- packages/pastojs/tests/testpas2js.pp | 2 +- 3 files changed, 111 insertions(+), 32 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 4c7c9ffdf2..bb222fd720 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -2082,8 +2082,8 @@ type Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual; Procedure AddHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual; Procedure AddImplHeaderStatement(JS: TJSElement; PosEl: TPasElement; aContext: TConvertContext); virtual; - Procedure AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual; - Procedure AddDelaySpecializeInit(El: TPasGenericType; Src: TJSSourceElements; AContext: TConvertContext); virtual; + function AddDelayedInits(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext): boolean; virtual; + function CreateDelaySpecializeInit(El: TPasGenericType; AContext: TConvertContext): TJSElement; virtual; // enum and sets Function CreateReferencedSet(El: TPasElement; SetExpr: TJSElement): TJSElement; virtual; // record @@ -8199,7 +8199,7 @@ Var ModuleName, ModVarName: String; IntfContext: TSectionContext; ImplVarSt: TJSVariableStatement; - HasImplUsesClause, ok, NeedRTLCheckVersion: Boolean; + HasImplCode, ok, NeedRTLCheckVersion: Boolean; Prg: TPasProgram; Lib: TPasLibrary; ImplFuncAssignSt: TJSSimpleAssignStatement; @@ -8280,7 +8280,7 @@ begin Prg:=TPasProgram(El); if Assigned(Prg.ProgramSection) then AddToSourceElements(Src,ConvertDeclarations(Prg.ProgramSection,IntfContext)); - AddDelayedInits(Prg,Src,IntfContext); + HasImplCode:=AddDelayedInits(Prg,Src,IntfContext); CreateInitSection(Prg,Src,IntfContext); end else if El is TPasLibrary then @@ -8288,7 +8288,7 @@ begin Lib:=TPasLibrary(El); if Assigned(Lib.LibrarySection) then AddToSourceElements(Src,ConvertDeclarations(Lib.LibrarySection,IntfContext)); - AddDelayedInits(Lib,Src,IntfContext); + HasImplCode:=AddDelayedInits(Lib,Src,IntfContext); CreateInitSection(Lib,Src,IntfContext); // ToDo: append exports end @@ -8317,7 +8317,9 @@ begin // append initialization section CreateInitSection(El,Src,IntfSecCtx); - if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then + if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count>0 then + HasImplCode:=true + else begin // empty implementation @@ -8325,18 +8327,14 @@ begin RemoveFromSourceElements(Src,ImplVarSt); // remove unneeded $mod.$implcode = function(){} RemoveFromSourceElements(Src,ImplFuncAssignSt); - HasImplUsesClause:=(El.ImplementationSection<>nil) + // keep impl uses section + HasImplCode:=(El.ImplementationSection<>nil) and (length(El.ImplementationSection.UsesClause)>0); - end - else - begin - HasImplUsesClause:=true; end; - if HasImplUsesClause then + if HasImplCode then // add implementation uses list: [,, ...] ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext)); - end; // end unit if (ModScope<>nil) and (coStoreImplJS in Options) then @@ -17846,13 +17844,18 @@ begin IntfSec.AddImplHeaderStatement(JS); end; -procedure TPasToJSConverter.AddDelayedInits(El: TPasModule; - Src: TJSSourceElements; AContext: TConvertContext); +function TPasToJSConverter.AddDelayedInits(El: TPasModule; + Src: TJSSourceElements; AContext: TConvertContext): boolean; var aResolver: TPas2JSResolver; Hub: TPas2JSResolverHub; i: Integer; + JS: TJSElement; + AssignSt: TJSSimpleAssignStatement; + FunDecl: TJSFunctionDeclarationStatement; + ImplSrc: TJSSourceElements; begin + Result:=false; aResolver:=AContext.Resolver; if aResolver=nil then exit; if El=nil then ; @@ -17860,12 +17863,29 @@ begin {$IFDEF VerbosePas2JS} writeln('TPasToJSConverter.AddDelayedInits Hub.JSDelaySpecializeCount=',Hub.JSDelaySpecializeCount); {$ENDIF} + ImplSrc:=nil; 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; -procedure TPasToJSConverter.AddDelaySpecializeInit(El: TPasGenericType; - Src: TJSSourceElements; AContext: TConvertContext); +function TPasToJSConverter.CreateDelaySpecializeInit(El: TPasGenericType; + AContext: TConvertContext): TJSElement; var C: TClass; Path: String; @@ -17876,6 +17896,7 @@ var ElTypeHi, ElTypeLo: TPasType; aResolver: TPas2JSResolver; begin + Result:=nil; if not IsElementUsed(El) then exit; if not AContext.Resolver.IsFullySpecialized(El) then RaiseNotSupported(El,AContext,20201202145045,'not fully specialized, probably a bug in the analyzer'); @@ -17889,7 +17910,7 @@ begin Path:=CreateReferencePath(El,AContext,rpkPathAndName)+'.'+GetBIName(pbifnClassInitSpecialize); Call:=CreateCallExpression(El); Call.Expr:=CreatePrimitiveDotExpr(Path,El); - AddToSourceElements(Src,Call); + Result:=Call; end else if (C=TPasProcedureType) or (C=TPasFunctionType) then begin @@ -17901,7 +17922,7 @@ begin DotExpr.Name:=TJSString(GetBIName(pbivnRTTIProc_InitSpec)); Call:=CreateCallExpression(El); Call.Expr:=DotExpr; - AddToSourceElements(Src,Call); + Result:=Call; end else if (C=TPasArrayType) then begin @@ -17928,7 +17949,7 @@ begin AssignSt.LHS:=CreateDotNameExpr(El,CreateTypeInfoRef(El,AContext,El), TJSString(GetBIName(pbivnRTTIArray_ElType))); AssignSt.Expr:=CreateTypeInfoRef(ElTypeHi,AContext,El); - AddToSourceElements(Src,AssignSt); + Result:=AssignSt; end else RaiseNotSupported(El,AContext,20200831115251); diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas index 1f486d4d9f..8b1c961aa3 100644 --- a/packages/pastojs/tests/tcgenerics.pas +++ b/packages/pastojs/tests/tcgenerics.pas @@ -20,7 +20,7 @@ type Procedure TestGen_Record_ClassVarRecord_Program; Procedure TestGen_Record_ClassVarRecord_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; // generic class @@ -288,7 +288,9 @@ begin '}, []);'])); CheckSource('TestGen_Record_ClassVarRecord_UnitImpl', LinesToStr([ // statements - 'pas.UnitA.TAnt$G1.$initSpec();', + '$mod.$implcode = function () {', + ' pas.UnitA.TAnt$G1.$initSpec();', + '};', '']), LinesToStr([ // $mod.$main ''])); @@ -355,6 +357,53 @@ begin ''])); end; +procedure TTestGenerics.TestGen_Record_Delay_UsedByImplUses; +begin + WithTypeInfo:=true; + StartProgram(true,[supTObject]); + AddModuleWithIntfImplSrc('UnitA.pas', + LinesToStr([ + '{$modeswitch AdvancedRecords}', + 'type', + ' generic TBird = 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;', + '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; begin StartProgram(false); @@ -1201,7 +1250,9 @@ begin ''])); CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', LinesToStr([ // statements - 'pas.UnitA.TAnt$G1.$initSpec();', + '$mod.$implcode = function () {', + ' pas.UnitA.TAnt$G1.$initSpec();', + '};', '']), LinesToStr([ // $mod.$main ''])); @@ -1453,7 +1504,6 @@ begin '}, []);'])); CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', LinesToStr([ // statements - //'pas.UnitA.TAnt$G1.$initSpec();', '']), LinesToStr([ // $mod.$main ''])); @@ -1706,7 +1756,9 @@ begin ' rtl.addIntf(this, pas.system.IUnknown);', '});', 'this.i = null;', - 'pas.UnitA.TAnt$G1.$initSpec();', + '$mod.$implcode = function () {', + ' pas.UnitA.TAnt$G1.$initSpec();', + '};', '']), LinesToStr([ // $mod.$main 'rtl.setIntfP($mod, "i", rtl.queryIntfT($mod.TBird.$create("Create"), pas.UnitA.TAnt$G1), true);', @@ -2424,7 +2476,9 @@ begin '});'])); CheckSource('TestGen_Array_OtherUnit', LinesToStr([ // statements - 'pas.UnitA.$rtti["TDyn"].eltype = pas.UnitB.$rtti["TAnt"];', + '$mod.$implcode = function () {', + ' pas.UnitA.$rtti["TDyn"].eltype = pas.UnitB.$rtti["TAnt"];', + '};', '']), LinesToStr([ // $mod.$main ' pas.UnitB.Run();', @@ -2504,9 +2558,11 @@ begin '}, []);'])); CheckSource('TestGen_ArrayOfUnitImplRec', LinesToStr([ // statements - 'pas.UnitA.$rtti["TDyn"].eltype = pas.UnitA.$rtti["TAnt"];', - 'pas.UnitA.$rtti["TDyn"].eltype = pas.UnitA.$rtti["TBird"];', - 'pas.UnitA.$rtti["TStatic"].eltype = pas.UnitA.$rtti["TBird"];', + '$mod.$implcode = function () {', + ' pas.UnitA.$rtti["TDyn"].eltype = pas.UnitA.$rtti["TAnt"];', + ' pas.UnitA.$rtti["TDyn"].eltype = pas.UnitA.$rtti["TBird"];', + ' pas.UnitA.$rtti["TStatic"].eltype = pas.UnitA.$rtti["TBird"];', + '};', '']), LinesToStr([ // $mod.$main ''])); @@ -2673,7 +2729,9 @@ begin '}, []);'])); CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', LinesToStr([ // statements - 'pas.UnitA.$rtti["TAnt"].init();', + '$mod.$implcode = function () {', + ' pas.UnitA.$rtti["TAnt"].init();', + '};', '']), LinesToStr([ // $mod.$main ''])); diff --git a/packages/pastojs/tests/testpas2js.pp b/packages/pastojs/tests/testpas2js.pp index 0437a3978c..dff9b3ccc0 100644 --- a/packages/pastojs/tests/testpas2js.pp +++ b/packages/pastojs/tests/testpas2js.pp @@ -21,7 +21,7 @@ uses MemCheck, {$ENDIF} Classes, consoletestrunner, tcconverter, TCModules, TCSrcMap, - TCFiler, TCUnitSearch, TCOptimizations, TCGenerics, TCPrecompile; + TCFiler, TCUnitSearch, TCOptimizations, TCGenerics, TCPrecompile, unit2; type