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

pastojs: filer: store precompiled short references

Browse Source 
git-svn-id: trunk@47129 -
This commit is contained in:
Mattias Gaertner 2020-10-18 15:19:11 +00:00
parent f5d4e54ab3
commit 2f83458c33
4 changed files with 481 additions and 171 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1144,6 +1144,18 @@ type
function Add(const Identifier: String; El: TPasElement): TPasIdentifier; virtual;
end;
{ TPas2JSPrecompiledJS - Option coStoreImplJS }
TPas2JSPrecompiledJS = class
public
BodyJS: string;
EmptyJS: boolean; // true if Body.Body=nil
GlobalJS: TStringList;
ShortRefs: TFPList; // list of TPasElement needing a SectionContext.AddLocalVar
procedure AddShortRef(El: TPasElement);
destructor Destroy; override;
end;
{ TPas2JSSectionScope
JSElement is TJSSourceElements }
@ -1160,7 +1172,8 @@ type
TPas2JSInitialFinalizationScope = class(TPasInitialFinalizationScope)
public
JS: string; // Option coStoreProcJS
ImplJS: TPas2JSPrecompiledJS; // Option coStoreImplJS
destructor Destroy; override;
end;
TMessageIdToProc_List = TStringList;
@ -1199,9 +1212,7 @@ type
JSName: string;
ResultVarName: string; // valid in implementation ProcScope, empty means use ResolverResultVar
BodyOverloadsRenamed: boolean;
BodyJS: string; // Option coStoreProcJS: stored in ImplScope
GlobalJS: TStringList; // Option coStoreProcJS: stored in ImplScope
EmptyJS: boolean; // Option coStoreProcJS: stored in ImplScope, true if Body.Body=nil
ImplJS: TPas2JSPrecompiledJS; // Option coStoreImplJS: stored in ImplScope
procedure AddGlobalJS(const JS: string);
destructor Destroy; override;
end;
@ -1365,7 +1376,8 @@ type
coRTLVersionCheckMain, // insert rtl version check into main
coRTLVersionCheckSystem, // insert rtl version check into system unit init
coRTLVersionCheckUnit, // insert rtl version check into every unit init
coShortRefGlobals // use short local variables for global identifiers
coShortRefGlobals, // use short local variables for global identifiers
coShortRefGenFunc // create short local vars for generic methods
);
TPasToJsConverterOptions = set of TPasToJsConverterOption;
const
@ -1925,6 +1937,8 @@ type
Function CreateGlobalAliasForeign(El: TPasElement; JSPath: string; AContext: TConvertContext): string; virtual; // El in other module
Function CreateGlobalAliasNull(El: TPasElement; Prefix: TPas2JSBuiltInName;
SectionContext: TSectionContext): TFCLocalIdentifier; virtual;
Procedure CreateGlobalAlias_List(ElRefList: TFPList; AContext: TConvertContext); virtual;
Function ElNeedsGlobalAlias(El: TPasElement): boolean; virtual;
// utility functions for creating stuff
Function IsElementUsed(El: TPasElement): boolean; virtual;
Function IsSystemUnit(aModule: TPasModule): boolean; virtual;
@ -2002,13 +2016,15 @@ type
Function CreateRangeCheckCall_TypeRange(aType: TPasType; GetExpr: TJSElement;
AContext: TConvertContext; PosEl: TPasElement): TJSCallExpression; virtual;
// reference
Function CreateReferencePath(El: TPasElement; AContext : TConvertContext;
Function CreateReferencePath(El: TPasElement; AContext: TConvertContext;
Kind: TRefPathKind; Full: boolean = false; Ref: TResolvedReference = nil): string; virtual;
Function CreateReferencePathExpr(El: TPasElement; AContext : TConvertContext;
Function CreateReferencePathExpr(El: TPasElement; AContext: TConvertContext;
Full: boolean = false; Ref: TResolvedReference = nil): TJSElement; virtual;
Function CreateGlobalTypePath(El: TPasType; AContext : TConvertContext): string; virtual;
Function CreateStaticProcPath(El: TPasProcedure; AContext : TConvertContext): string; virtual;
Function CreateGlobalElPath(El: TPasElement; AContext : TConvertContext): string; virtual;
Function CreateGlobalTypePath(El: TPasType; AContext: TConvertContext): string; virtual;
Function CreateStaticProcPath(El: TPasProcedure; AContext: TConvertContext): string; virtual;
Function CreateGlobalElPath(El: TPasElement; AContext: TConvertContext): string; virtual;
Function GetLocalName(El: TPasElement; const Filter: TCtxVarKinds; AContext: TConvertContext): string;
Procedure StoreImplJSLocal(El: TPasElement; AContext: TConvertContext); virtual;
// section
Function CreateImplementationSection(El: TPasModule; IntfContext: TInterfaceSectionContext): TJSFunctionDeclarationStatement; virtual;
Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual;
@ -2394,6 +2410,14 @@ begin
Result:='['+Result+']';
end;
{ TPas2JSInitialFinalizationScope }
destructor TPas2JSInitialFinalizationScope.Destroy;
begin
FreeAndNil(ImplJS);
inherited Destroy;
end;
{ TInterfaceSectionContext }
destructor TInterfaceSectionContext.Destroy;
@ -2682,18 +2706,37 @@ begin
ElevatedLocals.FElevatedLocals.ForEachCall(@OnWriteItem,Pointer(Prefix));
end;
{ TPas2JSPrecompiledJS }
procedure TPas2JSPrecompiledJS.AddShortRef(El: TPasElement);
begin
if ShortRefs=nil then
ShortRefs:=TFPList.Create;
if ShortRefs.IndexOf(El)<0 then
ShortRefs.Add(El);
end;
destructor TPas2JSPrecompiledJS.Destroy;
begin
FreeAndNil(GlobalJS);
FreeAndNil(ShortRefs);
inherited Destroy;
end;
{ TPas2JSProcedureScope }
procedure TPas2JSProcedureScope.AddGlobalJS(const JS: string);
begin
if GlobalJS=nil then
GlobalJS:=TStringList.Create;
GlobalJS.Add(Js);
if ImplJS=nil then
raise Exception.Create('[20201018120133] TPas2JSProcedureScope.AddGlobalJS');
if ImplJS.GlobalJS=nil then
ImplJS.GlobalJS:=TStringList.Create;
ImplJS.GlobalJS.Add(Js);
end;
destructor TPas2JSProcedureScope.Destroy;
begin
FreeAndNil(GlobalJS);
FreeAndNil(ImplJS);
inherited Destroy;
end;
@ -6886,8 +6929,8 @@ begin
Scope:=Proc.CustomData as TPas2JSProcedureScope;
if Scope.ImplProc<>nil then
Scope:=Scope.ImplProc.CustomData as TPas2JSProcedureScope;
if Scope.BodyJS<>'' then
Result:=not Scope.EmptyJS;
if (Scope.ImplJS<>nil) and (Scope.ImplJS.BodyJS<>'') then
Result:=not Scope.ImplJS.EmptyJS;
end;
function TPas2JSResolver.HasAnonymousFunctions(El: TPasImplElement): boolean;
@ -7780,6 +7823,7 @@ Var
Prg: TPasProgram;
Lib: TPasLibrary;
AssignSt: TJSSimpleAssignStatement;
IntfSecCtx: TInterfaceSectionContext;
begin
Result:=Nil;
OuterSrc:=TJSSourceElements(CreateElement(TJSSourceElements, El));
@ -7859,6 +7903,7 @@ begin
end
else
begin // unit
IntfSecCtx:=TInterfaceSectionContext(IntfContext);
if Assigned(El.ImplementationSection) then
begin
// add var $impl = $mod.$impl
@ -7866,16 +7911,20 @@ begin
CreateMemberExpression([ModVarName,GetBIName(pbivnImplementation)]),El);
AddToSourceElements(Src,ImplVarSt);
// register local var $impl
IntfContext.AddLocalVar(GetBIName(pbivnImplementation),El.ImplementationSection,cvkGlobal,false);
IntfSecCtx.AddLocalVar(GetBIName(pbivnImplementation),El.ImplementationSection,cvkGlobal,false);
end;
if Assigned(El.InterfaceSection) then
AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfContext));
AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx));
ImplFunc:=CreateImplementationSection(El,TInterfaceSectionContext(IntfContext));
ImplFunc:=CreateImplementationSection(El,IntfSecCtx);
if ImplFunc=nil then
begin
// remove unneeded $impl from interface
RemoveFromSourceElements(Src,ImplVarSt);
if IntfSecCtx.HeaderIndex>0 then
dec(IntfSecCtx.HeaderIndex);
if IntfSecCtx.ImplHeaderIndex>0 then
dec(IntfSecCtx.ImplHeaderIndex);
HasImplUsesClause:=length(El.ImplementationSection.UsesClause)>0;
end
else
@ -7891,7 +7940,7 @@ begin
// add implementation uses list: [<implementation uses1>,<uses2>, ...]
ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
CreateInitSection(El,Src,IntfContext);
CreateInitSection(El,Src,IntfSecCtx);
end;
finally
@ -9470,7 +9519,7 @@ var
begin
if AContext.IsGlobal then
begin
ParentName:=AContext.GetLocalName(El.Parent,[cvkGlobal,cvkCurType,cvkInstance]);
ParentName:=GetLocalName(El.Parent,[cvkGlobal,cvkCurType],AContext);
if ParentName='' then
ParentName:='this';
if JSName[1]='[' then
@ -10100,7 +10149,7 @@ function TPasToJSConverter.ConvertInheritedExpr(El: TInheritedExpr;
SelfContext:=AContext.GetSelfContext;
if SelfContext=nil then
RaiseInconsistency(20170418114702,El);
SelfName:=AContext.GetLocalName(SelfContext.ThisVar.Element,[cvkCurType,cvkInstance]);
SelfName:=GetLocalName(SelfContext.ThisVar.Element,[cvkCurType,cvkInstance],AContext);
if Apply and (SelfContext<>AContext) then
DoError(20170418204325,nNestedInheritedNeedsParameters,sNestedInheritedNeedsParameters,
@ -15482,6 +15531,8 @@ begin
JSName:=SectionContext.GetLocalName(El,[cvkGlobal]);
if JSName='' then
RaiseNotSupported(El,AContext,20200926232620);
if coStoreImplJS in Options then
StoreImplJSLocal(El,AContext);
// $lt = this.TypeName = {}
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
AssignSt.LHS:=CreatePrimitiveDotExpr(JSName,El);
@ -16259,6 +16310,7 @@ Var
aResolver: TPas2JSResolver;
IsClassConDestructor: Boolean;
ThisKind: TCtxVarKind;
ImplJS: TPas2JSPrecompiledJS;
begin
Result:=nil;
@ -16282,11 +16334,12 @@ begin
ImplProc:=ProcScope.ImplProc;
ImplProcScope:=TPas2JSProcedureScope(ImplProc.CustomData);
if ImplProcScope.BodyJS<>'' then
ImplJS:=ImplProcScope.ImplJS;
if ImplJS<>nil then
begin
// using precompiled code
TPasResolver.UnmangleSourceLineNumber(El.SourceLinenumber,Line,Col);
if ImplProcScope.GlobalJS<>nil then
if ImplJS.GlobalJS<>nil then
begin
ConstContext:=AContext.GetGlobalFunc;
if not (ConstContext.JSElement is TJSSourceElements) then
@ -16297,19 +16350,29 @@ begin
RaiseNotSupported(El,AContext,20180228231008);
end;
ConstSrcElems:=TJSSourceElements(ConstContext.JSElement);
for i:=0 to ImplProcScope.GlobalJS.Count-1 do
for i:=0 to ImplJS.GlobalJS.Count-1 do
begin
// precompiled global var or type
Lit:=TJSLiteral.Create(Line,Col,El.SourceFilename);
Lit.Value.CustomValue:=StrToJSString(ImplProcScope.GlobalJS[i]);
Lit.Value.CustomValue:=StrToJSString(ImplJS.GlobalJS[i]);
AddToSourceElements(ConstSrcElems,Lit);
end;
end;
if coShortRefGlobals in Options then
CreateGlobalAlias_List(ImplJS.ShortRefs,AContext);
// precompiled body
Lit:=TJSLiteral.Create(Line,Col,El.SourceFilename);
Lit.Value.CustomValue:=StrToJSString(ImplProcScope.BodyJS);
Lit.Value.CustomValue:=StrToJSString(ImplJS.BodyJS);
Result:=Lit;
exit;
end
else if (coStoreImplJS in Options) and (aResolver<>nil) then
begin
if aResolver.ProcCanBePrecompiled(El) then
begin
ImplJS:=TPas2JSPrecompiledJS.Create;
ImplProcScope.ImplJS:=ImplJS;
end;
end;
AssignSt:=nil;
@ -16477,13 +16540,10 @@ begin
end;
end;
if (coStoreImplJS in Options) and (aResolver<>nil) then
if ImplJS<>nil then
begin
if aResolver.ProcCanBePrecompiled(El) then
begin
ImplProcScope.BodyJS:=CreatePrecompiledJS(Result);
ImplProcScope.EmptyJS:=BodyPas.Body=nil;
end;
ImplJS.BodyJS:=CreatePrecompiledJS(Result);
ImplJS.EmptyJS:=BodyPas.Body=nil;
end;
end;
@ -16566,6 +16626,7 @@ var
Lit: TJSLiteral;
Section: TInitializationSection;
RootContext: TRootContext;
ImplJS: TPas2JSPrecompiledJS;
begin
// create: '$mod.$init=function(){}'
Result:=nil;
@ -16602,9 +16663,11 @@ begin
// first convert main/initialization statements
if Section<>nil then
if Scope.JS<>'' then
begin
ImplJS:=Scope.ImplJS;
if ImplJS<>nil then
begin
S:=TrimRight(Scope.JS);
S:=TrimRight(ImplJS.BodyJS);
if S<>'' then
begin
Body:=CreateBody;
@ -16613,29 +16676,39 @@ begin
Lit:=TJSLiteral.Create(Line,Col,El.SourceFilename);
Lit.Value.CustomValue:=StrToJSString(S);
Body.A:=Lit;
if coShortRefGlobals in Options then
CreateGlobalAlias_List(ImplJS.ShortRefs,AContext);
end;
end
else if Section.Elements.Count>0 then
else
begin
Body:=CreateBody;
// Note: although the rtl sets 'this' as the module, the function can
// simply refer to $mod, so no need to set ThisPas here
Body.A:=ConvertImplBlockElements(Section,FuncContext,false);
FuncContext.BodySt:=Body.A;
AddInterfaceReleases(FuncContext,PosEl);
Body.A:=FuncContext.BodySt;
// store precompiled JS
if (coStoreImplJS in Options) and (AContext.Resolver<>nil) then
begin
Scope.JS:=TrimRight(CreatePrecompiledJS(Body.A));
if Scope.JS='' then
Scope.JS:=' '; // store the information, that there is an empty initialization section
ImplJS:=TPas2JSPrecompiledJS.Create;
Scope.ImplJS:=ImplJS;
end;
if Section.Elements.Count>0 then
begin
Body:=CreateBody;
// Note: although the rtl sets 'this' as the module, the function can
// simply refer to $mod, so no need to set ThisPas here
Body.A:=ConvertImplBlockElements(Section,FuncContext,false);
FuncContext.BodySt:=Body.A;
AddInterfaceReleases(FuncContext,PosEl);
Body.A:=FuncContext.BodySt;
// store precompiled JS
if ImplJS<>nil then
begin
ImplJS.BodyJS:=TrimRight(CreatePrecompiledJS(Body.A));
ImplJS.EmptyJS:=ImplJS.BodyJS=''; // store the information, that there is an empty initialization section
end;
end
else if ImplJS<>nil then
ImplJS.EmptyJS:=true; // store the information, that there is an empty initialization section
end
else if (coStoreImplJS in Options) and (AContext.Resolver<>nil) then
Scope.JS:=' '; // store the information, that there is an empty initialization section
end;
if length(RootContext.GlobalClassMethods)>0 then
begin
@ -18446,7 +18519,7 @@ begin
if SelfScope=nil then
RaiseNotSupported(PosEl,AContext,20190205230919);
if SelfScope.SelfArg<>nil then
TargetName:=AContext.GetLocalName(SelfScope.SelfArg,cvkAll)
TargetName:=GetLocalName(SelfScope.SelfArg,cvkAll,AContext)
else if SelfScope.ClassRecScope<>nil then
begin
TargetName:=CreateReferencePath(SelfScope.ClassRecScope.Element,
@ -20367,7 +20440,7 @@ var
Result:=CreatePrimitiveDotExpr(WithExprScope.WithVarName,Expr)
else if SelfScope<>nil then
begin
Path:=AContext.GetLocalName(SelfScope.SelfArg,cvkAll);
Path:=GetLocalName(SelfScope.SelfArg,cvkAll,AContext);
Result:=CreatePrimitiveDotExpr(Path,Expr);
end
else if Left=nil then
@ -24087,15 +24160,21 @@ begin
if (coShortRefGlobals in Options) and (Kind=rpkPathAndName) then
begin
if (El is TPasType) then
ElClass:=El.ClassType;
if ElClass.InheritsFrom(TPasType) then
begin
Result:=CreateGlobalTypePath(TPasType(El),AContext);
exit;
end
else if (El is TPasProcedure) and ProcHasNoSelf(TPasProcedure(El)) then
else if ElClass.InheritsFrom(TPasProcedure) and ProcHasNoSelf(TPasProcedure(El)) then
begin
Result:=CreateStaticProcPath(TPasProcedure(El),AContext);
exit;
end
else if (ElClass=TPasEnumValue) then
begin
Result:=CreateGlobalElPath(El,AContext);
exit;
end;
end;
@ -24167,7 +24246,7 @@ begin
if (SelfContext<>nil)
and IsA(TPasType(SelfContext.ThisVar.Element),TPasMembersType(ParentEl)) then
begin
ShortName:=AContext.GetLocalName(SelfContext.ThisVar.Element,VarKinds);
ShortName:=GetLocalName(SelfContext.ThisVar.Element,VarKinds,AContext);
if ShortName='' then
begin
if not (cvkGlobal in VarKinds) then
@ -24195,7 +24274,7 @@ begin
end;
end;
ShortName:=AContext.GetLocalName(ParentEl,VarKinds);
ShortName:=GetLocalName(ParentEl,VarKinds,AContext);
//writeln('TPasToJSConverter.CreateReferencePath NOT USING SELF ',GetObjPath(El),' ShortName=',ShortName);
if ShortName<>'' then
begin
@ -24221,7 +24300,7 @@ begin
else
begin
// check if ParentEl has a JS var
ShortName:=AContext.GetLocalName(ParentEl,[cvkGlobal]);
ShortName:=GetLocalName(ParentEl,[cvkGlobal],AContext);
if (ShortName<>'') then
begin
Prepend(Result,ShortName);
@ -24310,39 +24389,113 @@ var
ShortRefGlobals: Boolean;
Parent: TPasElement;
CurModule: TPasModule;
ElClass: TClass;
begin
Result:=AContext.GetLocalName(El,[cvkGlobal]);
if Result<>'' then
exit; // already exists
begin
// already exists
if coStoreImplJS in Options then
StoreImplJSLocal(El,AContext);
exit;
end;
ShortRefGlobals:=coShortRefGlobals in Options;
Parent:=El.Parent;
Result:=AContext.GetLocalName(Parent,[cvkGlobal]);
if Result<>'' then
else if Parent is TPasType then
Result:=CreateGlobalTypePath(TPasType(Parent),AContext)
else if Parent is TPasSection then
if Parent<>nil then
begin
// element is in foreign unit -> use pas.unitname
CurModule:=Parent.GetModule;
Result:=TransformModuleName(CurModule,true,AContext);
if (Parent.ClassType=TImplementationSection)
and (CurModule<>AContext.GetRootContext.PasElement.GetModule) then
Result:=AContext.GetLocalName(Parent,[cvkGlobal]);
if Result='' then
begin
// element is in foreign implementation section (not program/library section)
// -> use pas.unitname.$impl
Result:=Result+'.'+GetBIName(pbivnImplementation);
ElClass:=Parent.ClassType;
if ElClass.InheritsFrom(TPasType) then
Result:=CreateGlobalElPath(Parent,AContext)
else if ElClass.InheritsFrom(TPasSection) then
begin
// element is in foreign unit -> use pas.unitname
CurModule:=Parent.GetModule;
Result:=TransformModuleName(CurModule,true,AContext);
if (Parent.ClassType=TImplementationSection)
and (CurModule<>AContext.GetRootContext.PasElement.GetModule) then
begin
// element is in foreign implementation section (not program/library section)
// -> use pas.unitname.$impl
Result:=Result+'.'+GetBIName(pbivnImplementation);
end;
end
else if ElClass.InheritsFrom(TPasModule) then
Result:=TransformModuleName(TPasModule(Parent),true,AContext)
else
RaiseNotSupported(El,AContext,20200609230526,GetObjPath(El));
end;
Result:=Result+'.'+TransformElToJSName(El,AContext);
end
else if Parent is TPasModule then
Result:=TransformModuleName(TPasModule(Parent),true,AContext)
else
RaiseNotSupported(El,AContext,20200609230526,GetObjPath(El));
Result:=Result+'.'+TransformElToJSName(El,AContext);
begin
if El is TPasModule then
begin
Result:=TransformModuleName(TPasModule(El),true,AContext);
exit; // already created a shortrefglobal
end
else
RaiseNotSupported(El,AContext,20201010221704,GetObjPath(El));
end;
if ShortRefGlobals then
Result:=CreateGlobalAliasForeign(El,Result,AContext);
end;
function TPasToJSConverter.GetLocalName(El: TPasElement;
const Filter: TCtxVarKinds; AContext: TConvertContext): string;
begin
if coStoreImplJS in Options then
begin
if cvkGlobal in Filter then
begin
Result:=AContext.GetLocalName(El,[cvkGlobal]);
if Result<>'' then
begin
StoreImplJSLocal(El,AContext);
exit;
end
else if Filter=[cvkGlobal] then
exit('');
end;
end;
Result:=AContext.GetLocalName(El,Filter);
end;
procedure TPasToJSConverter.StoreImplJSLocal(El: TPasElement;
AContext: TConvertContext);
var
Ctx: TConvertContext;
CurEl: TPasElement;
Data: TObject;
ImplJS: TPas2JSPrecompiledJS;
begin
Ctx:=AContext;
while Ctx<>nil do
begin
CurEl:=Ctx.PasElement;
if CurEl<>nil then
begin
Data:=CurEl.CustomData;
if Data is TPas2JSProcedureScope then
begin
ImplJS:=TPas2JSProcedureScope(Data).ImplJS;
if ImplJS<>nil then
ImplJS.AddShortRef(El);
end
else if Data is TPas2JSInitialFinalizationScope then
begin
ImplJS:=TPas2JSInitialFinalizationScope(Data).ImplJS;
if ImplJS<>nil then
ImplJS.AddShortRef(El);
end;
end;
Ctx:=Ctx.Parent;
end;
end;
procedure TPasToJSConverter.CreateProcedureCall(var Call: TJSCallExpression;
Args: TParamsExpr; TargetProc: TPasProcedureType; AContext: TConvertContext);
// create a call, adding call by reference and default values
@ -25513,9 +25666,9 @@ begin
if (El.Parent=nil)
or ((El.Parent is TPasSection)
and (El.Parent.ClassType<>TImplementationSection)) then
JSParentName:=AContext.GetLocalName(El.GetModule,[cvkGlobal])
JSParentName:=GetLocalName(El.GetModule,[cvkGlobal],AContext)
else
JSParentName:=AContext.GetLocalName(El.Parent,[cvkGlobal]);
JSParentName:=GetLocalName(El.Parent,[cvkGlobal],AContext);
if JSParentName='' then
JSParentName:='this';
Call.AddArg(CreatePrimitiveDotExpr(JSParentName,El));
@ -25541,6 +25694,8 @@ begin
JSName:=AContext.GetLocalName(El,[cvkGlobal]);
if JSName='' then
RaiseNotSupported(El,AContext,20200926235501);
if coStoreImplJS in Options then
StoreImplJSLocal(El,AContext);
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
AssignSt.LHS:=CreatePrimitiveDotExpr(JSName,El);
AssignSt.Expr:=CreatePrimitiveDotExpr('this',El);
@ -25830,8 +25985,9 @@ var
begin
if AddModulesPrefix then
begin
Result:=AContext.GetLocalName(El,[cvkGlobal]);
if Result<>'' then exit;
Result:=GetLocalName(El,[cvkGlobal],AContext);
if Result<>'' then
exit;
end;
if El is TPasProgram then
Result:='program'
@ -26116,6 +26272,7 @@ var
Expr: TJSElement;
V: TJSVariableStatement;
AssignSt: TJSSimpleAssignStatement;
ElClass: TClass;
begin
Result:=JSPath;
if El is TPasUnresolvedSymbolRef then
@ -26135,16 +26292,21 @@ begin
SectionContext:=TSectionContext(AContext.GetMainSectionContext);
FuncContext:=AContext.GetFunctionContext;
if El is TPasModule then
Result:=GetBIName(pbivnLocalModuleRef)
else if El is TPasType then
ElClass:=El.ClassType;
if ElClass.InheritsFrom(TPasType) then
Result:=GetBIName(pbivnLocalTypeRef)
else if El is TPasProcedure then
else if ElClass.InheritsFrom(TPasProcedure) then
Result:=GetBIName(pbivnLocalProcRef)
else if ElClass=TPasEnumValue then
Result:=GetBIName(pbivnLocalTypeRef)
else if ElClass.InheritsFrom(TPasModule) then
Result:=GetBIName(pbivnLocalModuleRef)
else
RaiseNotSupported(El,AContext,20200608160225);
Result:=FuncContext.CreateLocalIdentifier(Result);
SectionContext.AddLocalVar(Result,El,cvkGlobal,false);
if coStoreImplJS in Options then
StoreImplJSLocal(El,AContext);
if aResolver.ImplementationUsesUnit(ElModule) then
begin
@ -26180,6 +26342,68 @@ begin
AddHeaderStatement(V,El,SectionContext);
end;
procedure TPasToJSConverter.CreateGlobalAlias_List(ElRefList: TFPList;
AContext: TConvertContext);
var
i: Integer;
SectionContext: TSectionContext;
El: TPasElement;
begin
if ElRefList=nil then exit;
if ElRefList.Count=0 then exit;
SectionContext:=TSectionContext(AContext.GetMainSectionContext);
for i:=0 to ElRefList.Count-1 do
begin
El:=TPasElement(ElRefList[i]);
if ElNeedsGlobalAlias(El) then
CreateGlobalElPath(El,SectionContext);
end;
end;
function TPasToJSConverter.ElNeedsGlobalAlias(El: TPasElement): boolean;
var
C: TClass;
Proc: TPasProcedure;
ProcScope: TPas2JSProcedureScope;
begin
Result:=false;
if El=nil then exit;
if not (coShortRefGlobals in Options) then
exit;
C:=El.ClassType;
if El.CustomData is TResElDataBuiltInSymbol then
exit(false)
else if C.InheritsFrom(TPasType) then
exit(true)
else if (C=TPasConstructor)
or (C=TPasDestructor)
or (C=TPasClassConstructor)
or (C=TPasClassDestructor)
or (C=TPasClassProcedure)
or (C=TPasClassOperator)
or (C=TPasClassFunction) then
exit(true)
else if (C=TPasProcedure) or (C=TPasFunction) or (C=TPasOperator) then
begin
Proc:=TPasProcedure(El);
if Proc.IsStatic or (Proc.Parent is TPasSection) then
exit(true);
if coShortRefGenFunc in Options then
begin
ProcScope:=TPas2JSProcedureScope(Proc.CustomData);
if ProcScope.SpecializedFromItem<>nil then
exit(true);
end;
end
else if C=TPasEnumValue then
begin
if not (coEnumNumbers in Options) then
exit(true);
end
else if C.InheritsFrom(TPasModule) then
exit(true);
end;
function TPasToJSConverter.ConvertPasElement(El: TPasElement;
Resolver: TPas2JSResolver): TJSElement;
var

145
packages/pastojs/src/pas2jsfiler.pp
View File

@ -95,7 +95,7 @@ uses
const
PCUMagic = 'Pas2JSCache';
PCUVersion = 6;
PCUVersion = 7;
{ Version Changes:
1: initial version
2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
@ -106,6 +106,7 @@ const
not the whole $init function (pas2js 1.5)
5: removed modeswitch ignoreattributes
6: default DispatchField=Msg, DispatchStrField=MsgStr
7: InitializationSection JS replaced with Body, Empty
}
BuiltInNodeName = 'BuiltIn';
@ -253,7 +254,8 @@ const
'RTLVersionCheckMain',
'RTLVersionCheckSystem',
'RTLVersionCheckUnit',
'AliasGlobals'
'ShortRefGlobals',
'ShortRefGenFuncs'
);
PCUDefaultTargetPlatform = PlatformBrowser;
@ -813,7 +815,7 @@ type
DefaultKind: TPasExprKind; DefaultOpCode: TExprOpCode; aContext: TPCUWriterContext); virtual;
procedure WritePasExprArray(Obj: TJSONObject; Parent: TPasElement;
const PropName: string; const ExprArr: TPasExprArray; aContext: TPCUWriterContext); virtual;
// references of a impl block which statements are not stored
// references of an impl block which statements are not stored
procedure WriteScopeReferences(Obj: TJSONObject; References: TPasScopeReferences;
const PropName: string; aContext: TPCUWriterContext); virtual;
// extern references
@ -872,6 +874,7 @@ type
procedure WriteProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUWriterContext); virtual;
procedure WriteOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUWriterContext); virtual;
procedure WriteAttributes(Obj: TJSONObject; El: TPasAttributes; aContext: TPCUWriterContext); virtual;
procedure WritePrecompiledJS(Obj: TJSONObject; El: TPasElement; ImplJS: TPas2JSPrecompiledJS; aContext: TPCUWriterContext); virtual;
procedure WriteImplCommand(Obj: TJSONObject; El: TPasImplCommand; aContext: TPCUWriterContext); virtual;
procedure WriteImplBeginBlock(Obj: TJSONObject; El: TPasImplBeginBlock; aContext: TPCUWriterContext); virtual;
procedure WriteImplAsmStatement(Obj: TJSONObject; El: TPasImplAsmStatement; aContext: TPCUWriterContext); virtual;
@ -1177,6 +1180,7 @@ type
procedure ReadProcedure(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
procedure ReadOperator(Obj: TJSONObject; El: TPasOperator; aContext: TPCUReaderContext); virtual;
procedure ReadAttributes(Obj: TJSONObject; El: TPasAttributes; aContext: TPCUReaderContext); virtual;
procedure ReadPrecompiledJS(Obj: TJSONObject; El: TPasElement; ImplJS: TPas2JSPrecompiledJS; aContext: TPCUReaderContext); virtual;
procedure ReadImplCommand(Obj: TJSONObject; El: TPasImplCommand; aContext: TPCUReaderContext); virtual;
procedure ReadImplBeginBlock(Obj: TJSONObject; El: TPasImplBeginBlock; aContext: TPCUReaderContext); virtual;
procedure ReadImplAsmStatement(Obj: TJSONObject; El: TPasImplAsmStatement; aContext: TPCUReaderContext); virtual;
@ -2569,12 +2573,16 @@ procedure TPCUWriter.WriteModule(Obj: TJSONObject; aModule: TPasModule;
procedure WImplBlock(Block: TPasImplBlock; const PropPrefix: string);
var
Scope: TPas2JSInitialFinalizationScope;
ImplJS: TPas2JSPrecompiledJS;
Sub: TJSONObject;
begin
if Block=nil then exit;
Scope:=Block.CustomData as TPas2JSInitialFinalizationScope;
if Scope.JS<>'' then
Obj.Add(PropPrefix+'JS',Scope.JS);
WriteScopeReferences(Obj,Scope.References,PropPrefix+'Refs',aContext);
ImplJS:=Scope.ImplJS;
Sub:=TJSONObject.Create;
Obj.Add(PropPrefix,Sub);
WriteScopeReferences(Sub,Scope.References,'Refs',aContext);
WritePrecompiledJS(Sub,Block,ImplJS,aContext);
end;
procedure RaisePending(Ref: TPCUFilerElementRef);
@ -4511,8 +4519,6 @@ procedure TPCUWriter.WriteProcedure(Obj: TJSONObject; El: TPasProcedure;
var
DefProcMods, ImplProcMods, DeclProcMods: TProcedureModifiers;
Scope: TPas2JSProcedureScope;
Arr: TJSONArray;
i: Integer;
DeclProc: TPasProcedure;
DeclScope: TPas2JsProcedureScope;
BodyObj: TJSONObject;
@ -4527,6 +4533,8 @@ begin
// spezialiations are generated on the fly -> cannot be stored
RaiseMsg(20191120180305,El,GetObjPath(Scope.SpecializedFromItem.FirstSpecialize));
end;
if (Scope.ImplJS<>nil) and (Scope.ImplProc<>nil) then
RaiseMsg(20180228142831,El);
if Scope.DeclarationProc=nil then
begin
@ -4575,23 +4583,12 @@ begin
WriteScopeReferences(Obj,DeclScope.References,'Refs',aContext);
// precompiled body
if Scope.BodyJS<>'' then
begin
if Scope.GlobalJS<>nil then
begin
Arr:=TJSONArray.Create;
Obj.Add('Globals',Arr);
for i:=0 to Scope.GlobalJS.Count-1 do
Arr.Add(Scope.GlobalJS[i]);
end;
Obj.Add('Body',Scope.BodyJS);
Obj.Add('Empty',Scope.EmptyJS);
end;
WritePrecompiledJS(Obj,El,Scope.ImplJS,aContext);
end
else
begin
// generic function: store pascal elements
if Scope.BodyJS<>'' then
if Scope.ImplJS<>nil then
RaiseMsg(20191120171941,El);
ImplProcMods:=El.Modifiers*PCUProcedureModifiersImplProc;
DeclProcMods:=DeclProc.Modifiers*PCUProcedureModifiersImplProc;
@ -4606,8 +4603,6 @@ begin
aContext.InGeneric:=OldInGeneric;
end;
end;
if (Scope.BodyJS<>'') and (Scope.ImplProc<>nil) then
RaiseMsg(20180228142831,El);
end;
procedure TPCUWriter.WriteOperator(Obj: TJSONObject; El: TPasOperator;
@ -4626,6 +4621,30 @@ begin
WritePasExprArray(Obj,El,'Calls',El.Calls,aContext);
end;
procedure TPCUWriter.WritePrecompiledJS(Obj: TJSONObject; El: TPasElement;
ImplJS: TPas2JSPrecompiledJS; aContext: TPCUWriterContext);
var
Arr: TJSONArray;
i: Integer;
begin
if ImplJS=nil then exit;
if (ImplJS.BodyJS<>'') then
begin
if ImplJS.GlobalJS<>nil then
begin
Arr:=TJSONArray.Create;
Obj.Add('Globals',Arr);
for i:=0 to ImplJS.GlobalJS.Count-1 do
Arr.Add(ImplJS.GlobalJS[i]);
end;
if ImplJS.ShortRefs<>nil then
WriteElementList(Obj,El,'ShortRefs',ImplJS.ShortRefs,aContext,true);
Obj.Add('Body',ImplJS.BodyJS);
end;
if ImplJS.EmptyJS then
Obj.Add('Empty',ImplJS.EmptyJS);
end;
procedure TPCUWriter.WriteImplCommand(Obj: TJSONObject; El: TPasImplCommand;
aContext: TPCUWriterContext);
begin
@ -7799,13 +7818,23 @@ var
const PropPrefix: string);
var
Scope: TPas2JSInitialFinalizationScope;
s: string;
ImplJS: TPas2JSPrecompiledJS;
Sub: TJSONObject;
begin
Scope:=TPas2JSInitialFinalizationScope(Resolver.CreateScope(Block,Resolver.ScopeClass_InitialFinalization));
Block.CustomData:=Scope;
if not ReadString(Obj,PropPrefix+'JS',s,Block) then exit;
Scope.JS:=s;
ReadScopeReferences(Obj,Scope,PropPrefix+'Refs',Scope.References);
ImplJS:=TPas2JSPrecompiledJS.Create;
Scope.ImplJS:=ImplJS;
if FileVersion<7 then
begin
ReadScopeReferences(Obj,Scope,PropPrefix+'Refs',Scope.References);
ReadString(Obj,PropPrefix+'JS',ImplJS.BodyJS,Block);
end
else if ReadObject(Obj,PropPrefix,Sub,Block) then
begin
ReadScopeReferences(Sub,Scope,'Refs',Scope.References);
ReadPrecompiledJS(Sub,Block,ImplJS,aContext);
end;
end;
var
@ -7858,12 +7887,14 @@ begin
TImplementationSection) then
exit; // pending uses interfaces -> pause
end;
if Obj.Find('InitJS')<>nil then
if (Obj.Find('Init')<>nil)
or ((FileVersion<7) and (Obj.Find('InitJS')<>nil)) then
begin
aModule.InitializationSection:=TInitializationSection(CreateElement(TInitializationSection,'',aModule));
ReadInitialFinal(Obj,aModule.InitializationSection,'Init');
end;
if Obj.Find('FinalJS')<>nil then
if (Obj.Find('Final')<>nil)
or ((FileVersion<7) and (Obj.Find('FinalJS')<>nil)) then
begin
aModule.FinalizationSection:=TFinalizationSection(CreateElement(TFinalizationSection,'',aModule));
ReadInitialFinal(Obj,aModule.FinalizationSection,'Final');
@ -9027,22 +9058,18 @@ procedure TPCUReader.ReadProcedureBody(Obj: TJSONObject; El: TPasProcedure;
var
ImplScope: TPas2JSProcedureScope;
s: string;
Arr: TJSONArray;
i: Integer;
Data: TJSONData;
DeclProc: TPasProcedure;
BodyObj, BodyBodyObj: TJSONObject;
ProcBody: TProcedureBody;
ImplEl: TPasElement;
OldInGeneric: Boolean;
ImplJS: TPas2JSPrecompiledJS;
begin
ImplScope:=TPas2JSProcedureScope(El.CustomData);
if ImplScope.ImplProc<>nil then
RaiseMsg(20191231152850,El);
if ImplScope.BodyJS<>'' then
RaiseMsg(20180228231510,El);
if ImplScope.GlobalJS<>nil then
RaiseMsg(20180228231511,El);
if ImplScope.ImplJS<>nil then
RaiseMsg(20201018121506,El);
DeclProc:=ImplScope.DeclarationProc;
if DeclProc=nil then
DeclProc:=El;
@ -9050,20 +9077,9 @@ begin
if Resolver.ProcCanBePrecompiled(DeclProc) then
begin
// normal proc (non generic)
if not ReadString(Obj,'Body',s,El) then
RaiseMsg(20180228131232,El);
ReadBoolean(Obj,'Empty',ImplScope.EmptyJS,El);
ImplScope.BodyJS:=s;
if ReadArray(Obj,'Globals',Arr,El) then
begin
for i:=0 to Arr.Count-1 do
begin
Data:=Arr[i];
if not (Data is TJSONString) then
RaiseMsg(20180228231555,El,IntToStr(i)+':'+GetObjName(Data));
ImplScope.AddGlobalJS(Data.AsString);
end;
end;
ImplJS:=TPas2JSPrecompiledJS.Create;
ImplScope.ImplJS:=ImplJS;
ReadPrecompiledJS(Obj,El,ImplJS,aContext);
end
else
begin
@ -9217,6 +9233,35 @@ begin
ReadPasExprArray(Obj,El,'Calls',El.Calls,aContext);
end;
procedure TPCUReader.ReadPrecompiledJS(Obj: TJSONObject; El: TPasElement;
ImplJS: TPas2JSPrecompiledJS; aContext: TPCUReaderContext);
var
Arr: TJSONArray;
i: Integer;
Data: TJSONData;
begin
ReadString(Obj,'Body',ImplJS.BodyJS,El);
ReadBoolean(Obj,'Empty',ImplJS.EmptyJS,El);
if ReadArray(Obj,'Globals',Arr,El) then
begin
for i:=0 to Arr.Count-1 do
begin
Data:=Arr[i];
if not (Data is TJSONString) then
RaiseMsg(20180228231555,El,IntToStr(i)+':'+GetObjName(Data));
if ImplJS.GlobalJS=nil then
ImplJS.GlobalJS:=TStringList.Create;
ImplJS.GlobalJS.Add(Data.AsString);
end;
end;
ImplJS.ShortRefs:=TFPList.Create;
ReadElementList(Obj,El,'ShortRefs',ImplJS.ShortRefs,false,aContext);
if ImplJS.ShortRefs.Count=0 then
FreeAndNil(ImplJS.ShortRefs);
end;
procedure TPCUReader.ReadImplCommand(Obj: TJSONObject; El: TPasImplCommand;
aContext: TPCUReaderContext);
// an empty statement, e.g. if expr then else ;

19
packages/pastojs/src/pas2jslibcompiler.pp
View File

@ -67,8 +67,6 @@ Type
FOnWriteJSCallBack: TWriteJSCallBack;
FOnWriteJSData: Pointer;
FReadBufferLen: Cardinal;
function GetLogEncoding: String;
procedure SetLogEncoding(AValue: String);
Protected
Function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; override;
Procedure GetLastError(AError : PAnsiChar; Var AErrorLength : Longint;
@ -82,7 +80,6 @@ Type
Function LibraryRun(ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) :Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
Property LastError : String Read FLastError Write FLastError;
Property LastErrorClass : String Read FLastErrorClass Write FLastErrorClass;
property LogEncoding: String read GetLogEncoding write SetLogEncoding;
Property OnLibLogCallBack : TLibLogCallBack Read FOnLibLogCallBack Write FOnLibLogCallBack;
Property OnLibLogData : Pointer Read FOnLibLogData Write FOnLibLogData;
Property OnWriteJSCallBack : TWriteJSCallBack Read FOnWriteJSCallBack Write FOnWriteJSCallBack;
@ -110,7 +107,6 @@ Function RunPas2JSCompiler(P : PPas2JSCompiler; ACompilerExe, AWorkingDir : PAns
Procedure FreePas2JSCompiler(P : PPas2JSCompiler); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
Function GetPas2JSCompiler : PPas2JSCompiler; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
Procedure GetPas2JSCompilerLastError(P : PPas2JSCompiler; AError : PAnsiChar; Var AErrorLength : Longint; AErrorClass : PAnsiChar; Var AErrorClassLength : Longint); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
procedure SetPas2JSLogEncoding(P : PPas2JSCompiler; Enconding: PAnsiChar); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
implementation
@ -124,16 +120,6 @@ begin
Result:=OnReadDir(FOnReadDirData,Dir,PAnsiChar(Dir.Path));
end;
function TLibraryPas2JSCompiler.GetLogEncoding: String;
begin
Result := Log.Encoding;
end;
procedure TLibraryPas2JSCompiler.SetLogEncoding(AValue: String);
begin
Log.Encoding := AValue;
end;
function TLibraryPas2JSCompiler.DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean;
Var
@ -358,10 +344,5 @@ begin
TLibraryPas2JSCompiler(P).GetLastError(AError,AErrorLength,AErrorClass,AErrorClassLength);
end;
procedure SetPas2JSLogEncoding(P : PPas2JSCompiler; Enconding: PAnsiChar); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
begin
TLibraryPas2JSCompiler(P).LogEncoding := Enconding;
end;
end.

96
packages/pastojs/tests/tcfiler.pas
View File

@ -35,6 +35,11 @@ type
);
TPCCheckFlags = set of TPCCheckFlag;
TPCCheckedElementPair = class
public
Orig, Rest: TPasElement;
end;
{ TCustomTestPrecompile }
TCustomTestPrecompile = Class(TCustomTestModule)
@ -44,6 +49,7 @@ type
FPCUReader: TPCUReader;
FPCUWriter: TPCUWriter;
FRestAnalyzer: TPas2JSAnalyzer;
FCheckedElements: TPasAnalyzerKeySet; // keyset of TPCCheckedElementPair, key is Orig
procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar;
out Count: integer);
function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
@ -78,6 +84,7 @@ type
procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPas2jsRecordScope; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredClassScope(const Path: string; Orig, Rest: TPas2JSClassScope; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredPrecompiledJS(const Path: string; OrigEl: TPasElement; Orig: TPas2JSPrecompiledJS; RestEl: TPasElement; Rest: TPas2JSPrecompiledJS; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredGenericParamScope(const Path: string; Orig, Rest: TPasGenericParamsScope; Flags: TPCCheckFlags); virtual;
@ -238,6 +245,8 @@ type
end;
function CompareListOfProcScopeRef(Item1, Item2: Pointer): integer;
function CompareCheckedElementPairs(Item1, Item2: Pointer): integer;
function CompareElWithCheckedElementPair(Key, Item: Pointer): integer;
implementation
@ -251,6 +260,22 @@ begin
Result:=ComparePointer(Ref1.Element,Ref2.Element);
end;
function CompareCheckedElementPairs(Item1, Item2: Pointer): integer;
var
Pair1: TPCCheckedElementPair absolute Item1;
Pair2: TPCCheckedElementPair absolute Item2;
begin
Result:=ComparePointer(Pair1.Orig,Pair2.Orig);
end;
function CompareElWithCheckedElementPair(Key, Item: Pointer): integer;
var
El: TPasElement absolute Key;
Pair: TPCCheckedElementPair absolute Item;
begin
Result:=ComparePointer(El,Pair.Orig);
end;
{ TCustomTestPrecompile }
procedure TCustomTestPrecompile.OnFilerGetSrc(Sender: TObject;
@ -348,6 +373,7 @@ begin
inherited SetUp;
FInitialFlags:=TPCUInitialFlags.Create;
FAnalyzer:=TPas2JSAnalyzer.Create;
FCheckedElements:=TPasAnalyzerKeySet.Create(@CompareCheckedElementPairs,@CompareElWithCheckedElementPair);
Analyzer.Resolver:=Engine;
Analyzer.Options:=Analyzer.Options+[paoImplReferences];
Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
@ -356,6 +382,11 @@ end;
procedure TCustomTestPrecompile.TearDown;
begin
if FCheckedElements<>nil then
begin
FCheckedElements.FreeItems;
FreeAndNil(FCheckedElements);
end;
FreeAndNil(FAnalyzer);
FreeAndNil(FPCUWriter);
FreeAndNil(FPCUReader);
@ -390,6 +421,7 @@ var
begin
InitialParserOptions:=Parser.Options;
Analyzer.Options:=Analyzer.Options+[paoSkipGenericProc];
Converter.Options:=Converter.Options+[coShortRefGlobals,coShortRefGenFunc];
ConvertUnit;
FPCUWriter:=TPCUWriter.Create;
@ -534,13 +566,13 @@ begin
if Orig=nil then
begin
if Rest<>nil then
Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
Fail(Path+': Orig=nil Rest='+GetObjPath(Rest));
exit(false);
end
else if Rest=nil then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
Fail(Path+': Orig='+GetObjPath(Orig)+' Rest=nil');
if Orig.ClassType<>Rest.ClassType then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
Fail(Path+': Orig='+GetObjPath(Orig)+' Rest='+GetObjPath(Rest));
Result:=true;
end;
@ -793,8 +825,7 @@ procedure TCustomTestPrecompile.CheckRestoredInitialFinalizationScope(
Flags: TPCCheckFlags);
begin
CheckRestoredScopeRefs(Path+'.References',Orig.References,Rest.References,Flags);
if Orig.JS<>Rest.JS then
CheckRestoredJS(Path+'.JS',Orig.JS,Rest.JS);
CheckRestoredPrecompiledJS(Path+'.ImplJS',Orig.Element,Orig.ImplJS,Rest.Element,Rest.ImplJS,Flags);
end;
procedure TCustomTestPrecompile.CheckRestoredEnumTypeScope(const Path: string;
@ -891,10 +922,7 @@ var
begin
CheckRestoredReference(Path+'.DeclarationProc',Orig.DeclarationProc,Rest.DeclarationProc);
CheckRestoredReference(Path+'.ImplProc',Orig.ImplProc,Rest.ImplProc);
if Orig.BodyJS<>Rest.BodyJS then
CheckRestoredJS(Path+'.BodyJS',Orig.BodyJS,Rest.BodyJS);
CheckRestoredStringList(Path+'.GlobalJS',Orig.GlobalJS,Rest.GlobalJS);
CheckRestoredPrecompiledJS(Path+'.ImplJS',Orig.Element,Orig.ImplJS,Rest.Element,Rest.ImplJS,Flags);
if Rest.DeclarationProc=nil then
begin
@ -923,6 +951,24 @@ begin
end;
end;
procedure TCustomTestPrecompile.CheckRestoredPrecompiledJS(const Path: string;
OrigEl: TPasElement; Orig: TPas2JSPrecompiledJS; RestEl: TPasElement;
Rest: TPas2JSPrecompiledJS; Flags: TPCCheckFlags);
begin
CheckRestoredObject(Path,Orig,Rest);
if Orig=nil then exit;
if Flags=[] then ;
AssertEquals(Path+'.EmptyJS',Orig.EmptyJS,Rest.EmptyJS);
if Orig.BodyJS<>Rest.BodyJS then
CheckRestoredJS(Path+'.BodyJS',Orig.BodyJS,Rest.BodyJS);
if Orig.BodyJS<>'' then
begin
CheckRestoredStringList(Path+'.GlobalJS',Orig.GlobalJS,Rest.GlobalJS);
CheckRestoredElRefList(Path+'.ShortRefs',OrigEl,Orig.ShortRefs,RestEl,Rest.ShortRefs,false,Flags);
end;
end;
procedure TCustomTestPrecompile.CheckRestoredScopeRefs(const Path: string;
Orig, Rest: TPasScopeReferences; Flags: TPCCheckFlags);
var
@ -1180,11 +1226,27 @@ procedure TCustomTestPrecompile.CheckRestoredElement(const Path: string; Orig,
var
C: TClass;
AModule: TPasModule;
Pair: TPCCheckedElementPair;
begin
//writeln('TCustomTestPrecompile.CheckRestoredElement START Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
if not CheckRestoredObject(Path,Orig,Rest) then exit;
//writeln('TCustomTestPrecompile.CheckRestoredElement CheckRestoredObject Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
Pair:=TPCCheckedElementPair(FCheckedElements.FindKey(Orig));
if Pair<>nil then
begin
if Pair.Rest<>Rest then
Fail(Path+': Orig='+GetObjPath(Orig)+' Rest='+GetObjPath(Rest));
exit;
end
else
begin
Pair:=TPCCheckedElementPair.Create;
Pair.Orig:=Orig;
Pair.Rest:=Rest;
FCheckedElements.Add(Pair,false);
end;
AModule:=Orig.GetModule;
if AModule<>Module then
begin
@ -1779,9 +1841,9 @@ begin
RestScope:=Rest.CustomData as TPas2JSProcedureScope;
if OrigScope=nil then
exit; // msIgnoreInterfaces
CheckRestoredReference(Path+'.CustomData[TPas2JSProcedureScope].DeclarationProc',
CheckRestoredReference(Path+'.CustomData[TPas2JSProcedureScope].DeclarationProc [20201018123102]',
OrigScope.DeclarationProc,RestScope.DeclarationProc);
AssertEquals(Path+'.CustomData[TPas2JSProcedureScope].ResultVarName',OrigScope.ResultVarName,RestScope.ResultVarName);
AssertEquals(Path+'.CustomData[TPas2JSProcedureScope].ResultVarName [20201018123057]',OrigScope.ResultVarName,RestScope.ResultVarName);
DeclProc:=RestScope.DeclarationProc;
if DeclProc=nil then
begin
@ -1808,15 +1870,13 @@ begin
// Body
if Orig.Body<>nil then
begin
if Engine.ProcCanBePrecompiled(DeclProc) then
begin
AssertEquals(Path+'.EmptyJS',OrigScope.EmptyJS,RestScope.EmptyJS);
CheckRestoredJS(Path+'.BodyJS',OrigScope.BodyJS,RestScope.BodyJS);
CheckRestoredStringList(Path+'.GlobalJS',OrigScope.GlobalJS,RestScope.GlobalJS);
end
else
if not Engine.ProcCanBePrecompiled(DeclProc) then
begin
// generic body
if OrigScope.ImplJS<>nil then
Fail(Path+'.CustomData[TPas2JSProcedureScope].ImplJS [20201018123049] OrigScope.ImplJS<>nil');
if RestScope.ImplJS<>nil then
Fail(Path+'.CustomData[TPas2JSProcedureScope].ImplJS [20201018123139] RestScope.ImplJS<>nil');
CheckRestoredProcedureBody(Path+'.Body',Orig.Body,Rest.Body,Flags+[PCCGeneric]);
end;
end