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

pastojs: filer: local specialize type

Browse Source 
git-svn-id: trunk@47134 -
This commit is contained in:
Mattias Gaertner 2020-10-18 20:29:54 +00:00
parent 201281ae2a
commit 79935d8579
3 changed files with 170 additions and 37 deletions
packages
fcl-passrc/src
pasuseanalyzer.pas
pastojs
src
pas2jsfiler.pp
tests
tcfiler.pas

2
packages/fcl-passrc/src/pasuseanalyzer.pas
View File

@ -1009,6 +1009,8 @@ procedure TPasAnalyzer.MarkImplScopeRef(El, RefEl: TPasElement;
if (RefEl.Name='') and not (RefEl is TInterfaceSection) then
exit; // reference to anonymous type -> not needed
if RefEl=ElImplScope.Element then
exit;
if ElImplScope is TPasProcedureScope then
TPasProcedureScope(ElImplScope).AddReference(RefEl,Access)
else if ElImplScope is TPasInitialFinalizationScope then

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

@ -942,6 +942,14 @@ type
AddRef: TPCUAddRef;
end;
{ TPCUReaderPendingElScopeRef }
TPCUReaderPendingElScopeRef = class(TPCUFilerPendingElRef)
public
References: TPasScopeReferences;
Access: TPSRefAccess;
end;
{ TPCUReaderPendingIdentifierScope }
TPCUReaderPendingIdentifierScope = class
@ -970,7 +978,7 @@ type
GenericEl: TPasGenericType;
Id: integer;
Params: TFPList; // list of PCUReaderPendingSpecializedParams
RefEl: TPasElement; // a TInlineSpecializeExpr or TPasSpecializeType
RefEl: TPasElement; // a TInlineSpecializeExpr, TPasSpecializeType, TPasProcedure or TInitializationSection
SpecName: string;
Prev, Next: TPCUReaderPendingSpecialized;
destructor Destroy; override;
@ -1024,7 +1032,7 @@ type
function CreateSpecializedElement(PendSpec: TPCUReaderPendingSpecialized): boolean; // false=param missing
procedure DeletePendingSpecialize(PendSpec: TPCUReaderPendingSpecialized);
procedure PromiseSpecialize(SpecId: integer; El: TPasElement; const SpecName: string); virtual;
procedure ResolveSpecializedElements;
procedure ResolveSpecializedElements(Complete: boolean);
protected
// json
procedure RaiseMsg(Id: int64; const Msg: string = ''); overload; override;
@ -1047,8 +1055,11 @@ type
AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
procedure PromiseSetElArrReference(Id: integer; Arr: TPasElementArray; Index: integer;
AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
procedure PromiseSetScopeReference(Id: integer; References: TPasScopeReferences;
Access: TPSRefAccess; ErrorEl: TPasElement); virtual;
procedure ResolvePendingIdentifierScopes; virtual;
procedure ResolvePending; virtual;
procedure ResolvePending(Complete: boolean); virtual;
function GetReferrerEl(PendingElRef: TPCUFilerPendingElRef): TPasElement;
procedure ReadBuiltInSymbols(Obj: TJSONObject; ErrorEl: TPasElement); virtual;
// module
procedure ReadHeaderMagic(Obj: TJSONObject); virtual;
@ -3309,7 +3320,8 @@ procedure TPCUWriter.WriteExtRefSignature(Ref: TPCUFilerElementRef;
end;
if Index<0 then
RaiseMsg(20180309184111,Member);
Obj.Add('MId',Index);
if Index>0 then
Obj.Add('MId',Index);
end;
end;
@ -5424,11 +5436,12 @@ function TPCUReader.CreateSpecializedElement(
PendSpec: TPCUReaderPendingSpecialized): boolean;
var
RefParams, ElParams: TFPList;
i: Integer;
i, Id: Integer;
SpecEl: TPasElement;
Param: TPCUReaderPendingSpecializedParam;
Ref: TPCUFilerElementRef;
Obj: TJSONObject;
GenericEl: TPasGenericType;
begin
Result:=false;
if PendSpec.RefEl=nil then
@ -5452,7 +5465,10 @@ begin
if Param.Element<>nil then continue;
Ref:=GetElReference(Param.Id,PendSpec.RefEl);
if Ref=nil then
begin
//writeln('TPCUReader.CreateSpecializedElement SpecName=',PendSpec.SpecName,' Id=',PendSpec.Id,' WAITING for param ',i,': ',Param.Id);
exit(false);
end;
Param.Element:=Ref.Element;
end;
// all RefParams resolved -> specialize
@ -5460,8 +5476,11 @@ begin
try
for i:=0 to RefParams.Count-1 do
ElParams.Add(TPCUReaderPendingSpecializedParam(RefParams[i]).Element);
SpecEl:=Resolver.GetSpecializedEl(Resolver.RootElement,PendSpec.GenericEl,ElParams);
Id:=PendSpec.Id;
GenericEl:=PendSpec.GenericEl;
SpecEl:=Resolver.GetSpecializedEl(Resolver.RootElement,GenericEl,ElParams);
DeletePendingSpecialize(PendSpec);
Ref:=AddElReference(Id,PendSpec.RefEl,SpecEl);
finally
ElParams.Free;
end;
@ -5503,10 +5522,11 @@ begin
PendSpec.RefEl:=El;
end;
procedure TPCUReader.ResolveSpecializedElements;
procedure TPCUReader.ResolveSpecializedElements(Complete: boolean);
var
PendSpec, NextPendSpec, UnresolvedSpec: TPCUReaderPendingSpecialized;
Changed: Boolean;
Ref: TPCUFilerElementRef;
begin
repeat
UnresolvedSpec:=nil;
@ -5515,6 +5535,12 @@ begin
while PendSpec<>nil do
begin
NextPendSpec:=PendSpec.Next;
if PendSpec.RefEl=nil then
begin
Ref:=GetElReference(PendSpec.Id,PendSpec.GenericEl);
if Ref<>nil then
PendSpec.RefEl:=GetReferrerEl(Ref.Pending);
end;
if PendSpec.RefEl<>nil then
begin
if CreateSpecializedElement(PendSpec) then
@ -5525,6 +5551,8 @@ begin
PendSpec:=NextPendSpec;
end;
until not Changed;
if Complete then
UnresolvedSpec:=FPendingSpecialize;
if UnresolvedSpec<>nil then
// a pending specialize cannot resolve its params
RaiseMsg(20200531101924,UnresolvedSpec.GenericEl,UnresolvedSpec.SpecName+' Id='+IntToStr(UnresolvedSpec.Id)+' RefEl='+GetObjPath(UnresolvedSpec.RefEl));
@ -5717,6 +5745,7 @@ var
PendingElArrRef: TPCUReaderPendingElArrRef;
{$IF defined(VerbosePCUFiler) or defined(memcheck)}
Node: TAVLTreeNode;
PendingElScopeRef: TPCUReaderPendingElScopeRef;
{$ENDIF}
begin
if Id<=0 then
@ -5791,6 +5820,11 @@ begin
if PendingElArrRef.AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(PendingElArrRef.AddRef){$ENDIF};
end
else if RefItem is TPCUReaderPendingElScopeRef then
begin
PendingElScopeRef:=TPCUReaderPendingElScopeRef(RefItem);
PendingElScopeRef.References.Add(Ref.Element,PendingElScopeRef.Access);
end
else
RaiseMsg(20180207153056,ErrorEl,RefItem.ClassName);
Ref.Pending:=RefItem.Next;
@ -5879,6 +5913,29 @@ begin
end;
end;
procedure TPCUReader.PromiseSetScopeReference(Id: integer;
References: TPasScopeReferences; Access: TPSRefAccess; ErrorEl: TPasElement);
var
Ref: TPCUFilerElementRef;
PendingItem: TPCUReaderPendingElScopeRef;
begin
Ref:=AddElReference(Id,ErrorEl,nil);
if Ref.Element<>nil then
begin
// element was already created -> add reference immediately
References.Add(Ref.Element,Access);
end
else
begin
// element was not yet created -> store
PendingItem:=TPCUReaderPendingElScopeRef.Create;
PendingItem.References:=References;
PendingItem.Access:=Access;
PendingItem.ErrorEl:=ErrorEl;
Ref.AddPending(PendingItem);
end;
end;
procedure TPCUReader.ResolvePendingIdentifierScopes;
var
i: Integer;
@ -5892,14 +5949,13 @@ begin
FPendingIdentifierScopes.Clear;
end;
procedure TPCUReader.ResolvePending;
procedure TPCUReader.ResolvePending(Complete: boolean);
var
Node: TAVLTreeNode;
Ref: TPCUFilerElementRef;
begin
ResolvePendingIdentifierScopes;
ResolveSpecializedElements;
ResolveSpecializedElements(Complete);
// check dangling references
Node:=FElementRefs.FindLowest;
@ -5920,6 +5976,18 @@ begin
end;
end;
function TPCUReader.GetReferrerEl(PendingElRef: TPCUFilerPendingElRef
): TPasElement;
begin
while PendingElRef<>nil do
begin
Result:=PendingElRef.ErrorEl;
if Result<>nil then exit;
PendingElRef:=PendingElRef.Next;
end;
Result:=nil;
end;
procedure TPCUReader.ReadBuiltInSymbols(Obj: TJSONObject; ErrorEl: TPasElement);
var
Arr: TJSONArray;
@ -6432,7 +6500,12 @@ begin
if not ReadString(SubObj,'Name',Name,El) then
RaiseMsg(20180309180233,El,IntToStr(i));
if not ReadInteger(SubObj,'MId',Index,El) then
RaiseMsg(20180309184629,El,IntToStr(i));
begin
if SubObj.Find('MId')=nil then
Index:=0
else
RaiseMsg(20180309184629,El,IntToStr(i));
end;
if (Index<0) or (Index>=Members.Count) then
RaiseMsg(20180309184718,El,IntToStr(Index)+' out of bounds 0-'+IntToStr(Members.Count));
ChildEl:=nil;
@ -6492,6 +6565,7 @@ var
PendSpec: TPCUReaderPendingSpecialized;
PendParam: TPCUReaderPendingSpecializedParam;
SpecName: string;
Ref: TPCUFilerElementRef;
begin
ErrorEl:=GenEl;
if ParamIDs.Count=0 then
@ -6505,6 +6579,9 @@ begin
PendSpec.Obj:=Obj;
PendSpec.GenericEl:=GenEl;
Ref:=AddElReference(Id,GenEl,nil);
Ref.Obj:=Obj;
PendSpec.Params:=TFPList.Create;
for i:=0 to ParamIDs.Count-1 do
begin
@ -6743,7 +6820,7 @@ begin
Scope.Finished:=true;
if Section is TInterfaceSection then
begin
ResolvePending;
ResolvePending(false);
Resolver.NotifyPendingUsedInterfaces;
end;
end;
@ -7219,7 +7296,6 @@ var
i, Id: Integer;
Data: TJSONData;
SubObj: TJSONObject;
Ref: TPCUFilerElementRef;
s: string;
Found: Boolean;
Access: TPSRefAccess;
@ -7239,12 +7315,6 @@ begin
Data:=SubObj.Find('Id');
if not (Data is TJSONIntegerNumber) then
RaiseMsg(20180221171546,El,GetObjName(Data));
Id:=Data.AsInteger;
Ref:=GetElReference(Id,El);
if Ref=nil then
RaiseMsg(20180221171940,El,IntToStr(Id));
if Ref.Element=nil then
RaiseMsg(20180221171940,El,IntToStr(Id));
if ReadString(SubObj,'Access',s,El) then
begin
Found:=false;
@ -7259,7 +7329,8 @@ begin
end
else
Access:=PCUDefaultPSRefAccess;
References.Add(Ref.Element,Access);
Id:=Data.AsInteger;
PromiseSetScopeReference(Id,References,Access,El);
end;
end;
@ -7904,7 +7975,7 @@ begin
aContext.ModeSwitches:=OldModeSwitches;
end;
ResolvePending;
ResolvePending(true);
Result:=true;
end;

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

@ -218,11 +218,9 @@ type
procedure TestPC_GenericFunction_AnonymousProc;
procedure TestPC_GenericClass;
procedure TestPC_GenericMethod;
procedure TestPC_SpecializeClassSameUnit; // ToDo
// ToDo: specialize local generic type in unit interface
// ToDo: specialize local generic type in unit implementation
// ToDo: specialize local generic type in proc decl
// ToDo: specialize local generic type in proc body
procedure TestPC_SpecializeClassSameUnit;
procedure TestPC_Specialize_LocalTypeInUnit;
// ToDo: specialize local generic type via class forward
// ToDo: inline specialize local generic type in unit interface
// ToDo: inline specialize local generic type in unit implementation
// ToDo: inline specialize local generic type in proc decl
@ -691,21 +689,21 @@ begin
SubPath:=SubPath+'?noname?';
// search specialization with same name
RestIndex:=0;
while RestIndex<Rest.Declarations.Count do
begin
repeat
if RestIndex=Rest.Declarations.Count then
Fail(SubPath+' missing in restored Declarations');
RestDecl:=TPasElement(Rest.Declarations[RestIndex]);
if IsSpecialization(RestDecl) and (OrigDecl.Name=RestDecl.Name) then
break;
inc(RestIndex);
end;
if RestIndex=Rest.Declarations.Count then
Fail(SubPath+' missing in restored Declarations');
until false;
if (OrigIndex<Rest.Declarations.Count) and (OrigIndex<>RestIndex) then
// move restored element to original place to generate the same JS
Rest.Declarations.Move(RestIndex,OrigIndex);
// check
CheckRestoredElement(SubPath,OrigDecl,RestDecl,Flags);
// move restored element to original place to generate the same JS
if OrigIndex<Rest.Declarations.Count then
Rest.Declarations.Move(RestIndex,OrigIndex);
end;
AssertEquals(Path+'.Declarations.Count',Orig.Declarations.Count,Rest.Declarations.Count);
@ -1026,12 +1024,14 @@ var
OrigList, RestList: TFPList;
i: Integer;
OrigRef, RestRef: TPasScopeReference;
ok: Boolean;
begin
if Flags=[] then ;
CheckRestoredObject(Path,Orig,Rest);
if Orig=nil then exit;
OrigList:=nil;
RestList:=nil;
ok:=false;
try
OrigList:=Orig.GetList;
RestList:=Rest.GetList;
@ -1054,7 +1054,21 @@ begin
RestRef:=TPasScopeReference(RestList[i]);
Fail(Path+'['+IntToStr(i)+'] Too many in Rest: "'+RestRef.Element.Name+'"');
end;
ok:=true;
finally
if not ok then
begin
for i:=0 to OrigList.Count-1 do
begin
OrigRef:=TPasScopeReference(OrigList[i]);
writeln('TCustomTestPrecompile.CheckRestoredScopeRefs Orig[',i,']=',GetObjPath(OrigRef.Element));
end;
for i:=0 to RestList.Count-1 do
begin
RestRef:=TPasScopeReference(RestList[i]);
writeln('TCustomTestPrecompile.CheckRestoredScopeRefs Rest[',i,']=',GetObjPath(RestRef.Element));
end;
end;
OrigList.Free;
RestList.Free;
end;
@ -1264,7 +1278,14 @@ begin
if RestUsed=nil then
Fail(Path+': used in OrigAnalyzer, but not used in RestAnalyzer');
if OrigUsed.Access<>RestUsed.Access then
AssertEquals(Path+'->Analyzer.Access',dbgs(OrigUsed.Access),dbgs(RestUsed.Access));
begin
if (OrigUsed.Access in [paiaReadWrite,paiaWriteRead])
and (RestUsed.Access in [paiaReadWrite,paiaWriteRead])
and not (Orig.Parent is TProcedureBody) then
// readwrite or writeread is irrelevant for globals
else
AssertEquals(Path+'->Analyzer.Access',dbgs(OrigUsed.Access),dbgs(RestUsed.Access));
end;
end
else if RestAnalyzer.IsUsed(Rest) then
begin
@ -3204,7 +3225,46 @@ begin
'implementation',
'begin',
' b.a:=1.3;',
'end.',
'']);
WriteReadUnit;
end;
procedure TTestPrecompile.TestPC_Specialize_LocalTypeInUnit;
begin
StartUnit(false);
Add([
'{$mode delphi}',
'interface',
'type',
' TObject = class',
' end;',
' TBird<T> = class',
' a: T;',
' end;',
//' TDoubleBird = TBIrd<double>;',
//'var',
//' db: TDoubleBird;',
'procedure Fly;',
'implementation',
'type',
' TWordBird = TBird<word>;',
'procedure Run;',
//'type TShortIntBird = TBird<shortint>;',
'var',
//' shb: TShortIntBird;',
' wb: TWordBird;',
'begin',
//' shb.a:=3;',
' wb.a:=4;',
'end;',
'procedure Fly;',
//'type TByteBird = TBird<byte>;',
//'var bb: TByteBird;',
'begin',
//' bb.a:=5;',
' Run;',
'end;',
'begin',
'']);
WriteReadUnit;
end;