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

pastojs: filer: store generic procedure body

Browse Source 
git-svn-id: trunk@43853 -
This commit is contained in:
Mattias Gaertner 2020-01-03 19:52:54 +00:00
parent 451afd6e45
commit 0a9048a9a4
3 changed files with 1000 additions and 844 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1455,7 +1455,7 @@ type
function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
function HasAnonymousFunctions(El: TPasImplElement): boolean;
function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
function ProcCanBePrecompiled(Proc: TPasProcedure): boolean; virtual;
function ProcCanBePrecompiled(DeclProc: TPasProcedure): boolean; virtual;
function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
function IsExternalBracketAccessor(El: TPasElement): boolean;
function IsExternalClassConstructor(El: TPasElement): boolean;
@ -5940,30 +5940,30 @@ begin
end;
end;
function TPas2JSResolver.ProcCanBePrecompiled(Proc: TPasProcedure): boolean;
function TPas2JSResolver.ProcCanBePrecompiled(DeclProc: TPasProcedure): boolean;
var
El: TPasElement;
TemplTypes: TFPList;
ProcScope: TPas2JSProcedureScope;
GenScope: TPasGenericScope;
begin
if GetProcTemplateTypes(Proc)<>nil then
exit(false); // generic proc
ProcScope:=Proc.CustomData as TPas2JSProcedureScope;
if GetProcTemplateTypes(DeclProc)<>nil then
exit(false); // generic DeclProc
ProcScope:=DeclProc.CustomData as TPas2JSProcedureScope;
if ProcScope.SpecializedFromItem<>nil then
exit(false); // specialized generic proc
El:=Proc;
exit(false); // specialized generic DeclProc
El:=DeclProc;
repeat
El:=El.Parent;
if El=nil then
exit(true); // ok
if El is TPasProcedure then
exit(false); // Proc is a local proc
exit(false); // DeclProc is a local DeclProc
if El is TPasGenericType then
begin
TemplTypes:=TPasGenericType(El).GenericTemplateTypes;
if (TemplTypes<>nil) and (TemplTypes.Count>0) then
exit(false); // not fully specialized
exit(false); // method of a generic class/record type
GenScope:=El.CustomData as TPasGenericScope;
if GenScope.SpecializedFromItem<>nil then
exit(false); // method of a specialized class/record type

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

File diff suppressed because it is too large Load Diff

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

@ -56,6 +56,7 @@ type
procedure StartParsing; override;
function CheckRestoredObject(const Path: string; Orig, Rest: TObject): boolean; virtual;
procedure CheckRestoredJS(const Path, Orig, Rest: string); virtual;
procedure CheckRestoredStringList(const Path: string; Orig, Rest: TStrings); virtual;
// check restored parser+resolver
procedure CheckRestoredResolver(Original, Restored: TPas2JSResolver); virtual;
procedure CheckRestoredDeclarations(const Path: string; Orig, Rest: TPasDeclarations); virtual;
@ -125,7 +126,9 @@ type
procedure CheckRestoredProcNameParts(const Path: string; Orig, Rest: TPasProcedure); virtual;
procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
procedure CheckRestoredProcedureBody(const Path: string; Orig, Rest: TProcedureBody); virtual;
procedure CheckRestoredAttributes(const Path: string; Orig, Rest: TPasAttributes); virtual;
procedure CheckRestoredImplBeginBlock(const Path: string; Orig, Rest: TPasImplBeginBlock); virtual;
public
property Analyzer: TPas2JSAnalyzer read FAnalyzer;
property RestAnalyzer: TPas2JSAnalyzer read FRestAnalyzer;
@ -173,7 +176,7 @@ type
procedure TestPC_Attributes;
procedure TestPC_GenericClassSkip; // ToDo
procedure TestPC_GenericFunctionSkip;
procedure TestPC_GenericFunction;
procedure TestPC_UseUnit;
procedure TestPC_UseUnit_Class;
@ -486,7 +489,6 @@ end;
procedure TCustomTestPrecompile.CheckRestoredJS(const Path, Orig, Rest: string);
var
OrigList, RestList: TStringList;
i: Integer;
begin
if Orig=Rest then exit;
writeln('TCustomTestPrecompile.CheckRestoredJS ORIG START--------------');
@ -500,20 +502,31 @@ begin
try
OrigList.Text:=Orig;
RestList.Text:=Rest;
for i:=0 to OrigList.Count-1 do
begin
if i>=RestList.Count then
Fail(Path+' missing: '+OrigList[i]);
writeln(' ',i,': '+OrigList[i]);
end;
if OrigList.Count<RestList.Count then
Fail(Path+' too much: '+RestList[OrigList.Count]);
CheckRestoredStringList(Path,OrigList,RestList);
finally
OrigList.Free;
RestList.Free;
end;
end;
procedure TCustomTestPrecompile.CheckRestoredStringList(const Path: string;
Orig, Rest: TStrings);
var
i: Integer;
begin
CheckRestoredObject(Path,Orig,Rest);
if Orig=nil then exit;
if Orig.Text=Rest.Text then exit;
for i:=0 to Orig.Count-1 do
begin
if i>=Rest.Count then
Fail(Path+' missing: '+Orig[i]);
writeln(' ',i,': '+Orig[i]);
end;
if Orig.Count<Rest.Count then
Fail(Path+' too much: '+Rest[Orig.Count]);
end;
procedure TCustomTestPrecompile.CheckRestoredResolver(Original,
Restored: TPas2JSResolver);
var
@ -1200,6 +1213,8 @@ begin
else if (C=TPasOperator)
or (C=TPasClassOperator) then
CheckRestoredOperator(Path,TPasOperator(Orig),TPasOperator(Rest))
else if (C=TPasImplBeginBlock) then
CheckRestoredImplBeginBlock(Path,TPasImplBeginBlock(Orig),TPasImplBeginBlock(Rest))
else if (C=TPasModule)
or (C=TPasProgram)
or (C=TPasLibrary) then
@ -1617,8 +1632,11 @@ end;
procedure TCustomTestPrecompile.CheckRestoredProcedure(const Path: string;
Orig, Rest: TPasProcedure);
const
ImplMods = [pmInline,pmAssembler,pmNoReturn];
var
RestScope, OrigScope: TPas2JSProcedureScope;
DeclProc: TPasProcedure;
begin
CheckRestoredObject(Path+'.CustomData',Orig.CustomData,Rest.CustomData);
OrigScope:=Orig.CustomData as TPas2JSProcedureScope;
@ -1628,8 +1646,10 @@ begin
CheckRestoredReference(Path+'.CustomData[TPas2JSProcedureScope].DeclarationProc',
OrigScope.DeclarationProc,RestScope.DeclarationProc);
AssertEquals(Path+'.CustomData[TPas2JSProcedureScope].ResultVarName',OrigScope.ResultVarName,RestScope.ResultVarName);
if RestScope.DeclarationProc=nil then
DeclProc:=RestScope.DeclarationProc;
if DeclProc=nil then
begin
DeclProc:=Rest;
CheckRestoredProcNameParts(Path,Orig,Rest);
CheckRestoredElement(Path+'.ProcType',Orig.ProcType,Rest.ProcType);
CheckRestoredElement(Path+'.PublicName',Orig.PublicName,Rest.PublicName);
@ -1646,8 +1666,25 @@ begin
else
begin
// ImplProc
if Orig.Modifiers*ImplMods<>Rest.Modifiers*ImplMods then
Fail(Path+'.Impl-Modifiers');
end;
// ToDo: Body
// 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
begin
CheckRestoredProcedureBody(Path+'.Body',Orig.Body,Rest.Body);
end;
end
else if Rest.Body<>nil then
Fail(Path+'.Body<>nil, expected =nil');
end;
procedure TCustomTestPrecompile.CheckRestoredOperator(const Path: string; Orig,
@ -1659,12 +1696,27 @@ begin
CheckRestoredProcedure(Path,Orig,Rest);
end;
procedure TCustomTestPrecompile.CheckRestoredProcedureBody(const Path: string;
Orig, Rest: TProcedureBody);
begin
CheckRestoredObject(Path+'.CustomData',Orig.CustomData,Rest.CustomData);
CheckRestoredDeclarations(Path,Orig,Rest);
CheckRestoredElement(Path+'.Body',Orig.Body,Rest.Body);
end;
procedure TCustomTestPrecompile.CheckRestoredAttributes(const Path: string;
Orig, Rest: TPasAttributes);
begin
CheckRestoredPasExprArray(Path+'.Calls',Orig.Calls,Rest.Calls);
end;
procedure TCustomTestPrecompile.CheckRestoredImplBeginBlock(const Path: string;
Orig, Rest: TPasImplBeginBlock);
begin
CheckRestoredObject(Path+'.CustomData',Orig.CustomData,Rest.CustomData);
CheckRestoredElementList(Path,Orig.Elements,Rest.Elements);
end;
{ TTestPrecompile }
procedure TTestPrecompile.Test_Base256VLQ;
@ -2431,7 +2483,7 @@ begin
WriteReadUnit;
end;
procedure TTestPrecompile.TestPC_GenericFunctionSkip;
procedure TTestPrecompile.TestPC_GenericFunction;
begin
StartUnit(false);
Add([
@ -2441,7 +2493,7 @@ begin
'generic function Run<T>(a: T): T;',
'var b: T;',
'begin',
' b:=a; Result:=b;',
//' b:=a; Result:=b;',
'end;',
'']);
WriteReadUnit;