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

pastojs: filer: class forward

Browse Source 
git-svn-id: trunk@47153 -
This commit is contained in:
Mattias Gaertner 2020-10-22 20:07:02 +00:00
parent 6fc930a0fc
commit 993c511554
3 changed files with 170 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -18465,7 +18465,7 @@ begin
aResolver:=AContext.Resolver; aResolver:=AContext.Resolver;
Proc:=TPasProcedure(ResolvedEl.IdentEl); Proc:=TPasProcedure(ResolvedEl.IdentEl);
if not (Proc.Parent is TPasMembersType) if (not (Proc.Parent is TPasMembersType))
or (ptmStatic in Proc.ProcType.Modifiers) then or (ptmStatic in Proc.ProcType.Modifiers) then
begin begin
// not an "of object" method -> simply use the function // not an "of object" method -> simply use the function

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

@ -1028,10 +1028,11 @@ type
protected protected
// specialize // specialize
FPendingSpecialize: TPCUReaderPendingSpecialized; // chain of TPCUReaderPendingSpecialized FPendingSpecialize: TPCUReaderPendingSpecialized; // chain of TPCUReaderPendingSpecialized
function FindPendingSpecialize(Id: integer): TPCUReaderPendingSpecialized;
function AddPendingSpecialize(Id: integer; const SpecName: string): TPCUReaderPendingSpecialized; function AddPendingSpecialize(Id: integer; const SpecName: string): TPCUReaderPendingSpecialized;
function CreateSpecializedElement(PendSpec: TPCUReaderPendingSpecialized): boolean; // false=param missing function CreateSpecializedElement(PendSpec: TPCUReaderPendingSpecialized): boolean; // false=param missing, Note: needs ResolvePendingIdentifierScopes
procedure DeletePendingSpecialize(PendSpec: TPCUReaderPendingSpecialized); procedure DeletePendingSpecialize(PendSpec: TPCUReaderPendingSpecialized);
procedure PromiseSpecialize(SpecId: integer; El: TPasElement; const SpecName: string); virtual; function PromiseSpecialize(SpecId: integer; const SpecName: string; RefEl, ErrorEl: TPasElement): TPCUReaderPendingSpecialized; virtual;
procedure ResolveSpecializedElements(Complete: boolean); procedure ResolveSpecializedElements(Complete: boolean);
protected protected
// json // json
@ -5418,9 +5419,20 @@ begin
RaiseMsg(20200514130809,SpecData.Element,GetObjPath(RefEl)); RaiseMsg(20200514130809,SpecData.Element,GetObjPath(RefEl));
end; end;
function TPCUReader.FindPendingSpecialize(Id: integer
): TPCUReaderPendingSpecialized;
begin
Result:=FPendingSpecialize;
while (Result<>nil) and (Result.Id<>Id) do
Result:=Result.Next;
end;
function TPCUReader.AddPendingSpecialize(Id: integer; const SpecName: string function TPCUReader.AddPendingSpecialize(Id: integer; const SpecName: string
): TPCUReaderPendingSpecialized; ): TPCUReaderPendingSpecialized;
begin begin
if FindPendingSpecialize(Id)<>nil then
RaiseMsg(20201022214051,SpecName+'='+IntToStr(Id));
Result:=TPCUReaderPendingSpecialized.Create; Result:=TPCUReaderPendingSpecialized.Create;
if FPendingSpecialize<>nil then if FPendingSpecialize<>nil then
begin begin
@ -5444,21 +5456,26 @@ var
GenericEl: TPasGenericType; GenericEl: TPasGenericType;
begin begin
Result:=false; Result:=false;
{$IFDEF VerbosePCUFiler}
writeln('TPCUReader.CreateSpecializedElement Gen=',GetObjPath(PendSpec.GenericEl));
{$ENDIF}
if PendSpec.RefEl=nil then if PendSpec.RefEl=nil then
begin begin
if PendSpec.GenericEl=nil then if PendSpec.GenericEl=nil then
RaiseMsg(20200531101241,PendSpec.SpecName) RaiseMsg(20200531101241,PendSpec.SpecName)
else else
RaiseMsg(20200531101105,PendSpec.GenericEl);// nothing uses this specialize RaiseMsg(20200531101105,PendSpec.GenericEl,PendSpec.SpecName);// nothing uses this specialize
end; end;
if PendSpec.GenericEl=nil then if PendSpec.GenericEl=nil then
RaiseMsg(20200531101333,PendSpec.RefEl); RaiseMsg(20200531101333,PendSpec.RefEl,PendSpec.SpecName);
Obj:=PendSpec.Obj; Obj:=PendSpec.Obj;
if Obj=nil then if Obj=nil then
RaiseMsg(20200531101128,PendSpec.GenericEl); // specialize missing in JSON RaiseMsg(20200531101128,PendSpec.GenericEl,PendSpec.SpecName); // specialize missing in JSON
// resolve params // resolve params
RefParams:=PendSpec.Params; RefParams:=PendSpec.Params;
if RefParams=nil then
RaiseMsg(20201022215141,PendSpec.GenericEl,PendSpec.SpecName);
for i:=0 to RefParams.Count-1 do for i:=0 to RefParams.Count-1 do
begin begin
Param:=TPCUReaderPendingSpecializedParam(RefParams[i]); Param:=TPCUReaderPendingSpecializedParam(RefParams[i]);
@ -5501,25 +5518,18 @@ begin
PendSpec.Free; PendSpec.Free;
end; end;
procedure TPCUReader.PromiseSpecialize(SpecId: integer; El: TPasElement; function TPCUReader.PromiseSpecialize(SpecId: integer; const SpecName: string;
const SpecName: string); RefEl, ErrorEl: TPasElement): TPCUReaderPendingSpecialized;
var
PendSpec: TPCUReaderPendingSpecialized;
begin begin
PendSpec:=FPendingSpecialize; Result:=FindPendingSpecialize(SpecId);
while PendSpec<>nil do if Result=nil then
begin Result:=AddPendingSpecialize(SpecId,SpecName)
if PendSpec.Id=SpecId then else if Result.SpecName<>SpecName then
break; RaiseMsg(20200531093342,ErrorEl,'Id='+IntToStr(SpecId)+' Expected SpecName "'+SpecName+'", but was "'+Result.SpecName+'"');
PendSpec:=PendSpec.Next;
end;
if PendSpec=nil then if Result.RefEl=nil then
PendSpec:=AddPendingSpecialize(SpecId,SpecName) Result.RefEl:=RefEl;
else if PendSpec.SpecName<>SpecName then // Note: cannot specialize before ResolvePendingIdentifierScopes;
RaiseMsg(20200531093342,El,'Id='+IntToStr(SpecId)+' Expected SpecName "'+SpecName+'", but was "'+PendSpec.SpecName+'"');
if PendSpec.RefEl=nil then
PendSpec.RefEl:=El;
end; end;
procedure TPCUReader.ResolveSpecializedElements(Complete: boolean); procedure TPCUReader.ResolveSpecializedElements(Complete: boolean);
@ -5541,7 +5551,7 @@ begin
if Ref<>nil then if Ref<>nil then
PendSpec.RefEl:=GetReferrerEl(Ref.Pending); PendSpec.RefEl:=GetReferrerEl(Ref.Pending);
end; end;
if PendSpec.RefEl<>nil then if (PendSpec.RefEl<>nil) and (PendSpec.GenericEl<>nil) then
begin begin
if CreateSpecializedElement(PendSpec) then if CreateSpecializedElement(PendSpec) then
Changed:=true Changed:=true
@ -5554,8 +5564,20 @@ begin
if Complete then if Complete then
UnresolvedSpec:=FPendingSpecialize; UnresolvedSpec:=FPendingSpecialize;
if UnresolvedSpec<>nil then if UnresolvedSpec<>nil then
begin
{$IF defined(VerbosePJUFiler) or defined(VerbosePas2JS)}
PendSpec:=FPendingSpecialize;
while PendSpec<>nil do
begin
{AllowWriteln}
writeln('TPCUReader.ResolveSpecializedElements PENDING: ',PendSpec.SpecName+' Id='+IntToStr(PendSpec.Id)+' RefEl='+GetObjPath(PendSpec.RefEl)+' GenericEl='+GetObjPath(PendSpec.GenericEl));;
{AllowWriteln-}
PendSpec:=PendSpec.Next;
end;
{$ENDIF}
// a pending specialize cannot resolve its params // a pending specialize cannot resolve its params
RaiseMsg(20200531101924,UnresolvedSpec.GenericEl,UnresolvedSpec.SpecName+' Id='+IntToStr(UnresolvedSpec.Id)+' RefEl='+GetObjPath(UnresolvedSpec.RefEl)); RaiseMsg(20200531101924,UnresolvedSpec.GenericEl,UnresolvedSpec.SpecName+' Id='+IntToStr(UnresolvedSpec.Id)+' RefEl='+GetObjPath(UnresolvedSpec.RefEl)+' GenericEl='+GetObjPath(UnresolvedSpec.GenericEl));
end;
end; end;
procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string); procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string);
@ -6575,7 +6597,7 @@ begin
if not ReadString(Obj,'SpecName',SpecName,GenEl) then if not ReadString(Obj,'SpecName',SpecName,GenEl) then
RaiseMsg(20200531085133,GenEl); RaiseMsg(20200531085133,GenEl);
PendSpec:=AddPendingSpecialize(Id,SpecName); PendSpec:=PromiseSpecialize(Id,SpecName,nil,GenEl);
PendSpec.Obj:=Obj; PendSpec.Obj:=Obj;
PendSpec.GenericEl:=GenEl; PendSpec.GenericEl:=GenEl;
@ -6596,6 +6618,11 @@ begin
PendParam.Index:=i; PendParam.Index:=i;
PendParam.Id:=Id; PendParam.Id:=Id;
end; end;
{$IFDEF VerbosePCUFiler}
writeln('TPCUReader.ReadSpecialization Id=',PendSpec.Id,' GenEl=',GetObjPath(PendSpec.GenericEl),' SpecName=',PendSpec.SpecName,' ElRef=',GetObjPath(PendSpec.RefEl));
{$ENDIF}
// Note: cannot specialize before ResolvePendingIdentifierScopes;
end; end;
procedure TPCUReader.ReadExternalReferences(Obj: TJSONObject; El: TPasElement); procedure TPCUReader.ReadExternalReferences(Obj: TJSONObject; El: TPasElement);
@ -8121,7 +8148,7 @@ procedure TPCUReader.ReadSpecializeType(Obj: TJSONObject;
var var
GenType: TPasGenericType; GenType: TPasGenericType;
GenericTemplateTypes: TFPList; GenericTemplateTypes: TFPList;
ExpName: string; SpecName: string;
i, SpecId: Integer; i, SpecId: Integer;
Data: TPasSpecializeTypeData; Data: TPasSpecializeTypeData;
begin begin
@ -8153,12 +8180,12 @@ begin
PromiseSetElReference(SpecId,@Set_SpecializeTypeData,Data,El); PromiseSetElReference(SpecId,@Set_SpecializeTypeData,Data,El);
// check old specialized name // check old specialized name
if not ReadString(Obj,'SpecName',ExpName,El) then if not ReadString(Obj,'SpecName',SpecName,El) then
RaiseMsg(20200219122919,El); RaiseMsg(20200219122919,El);
if ExpName='' then if SpecName='' then
RaiseMsg(20200530134152,El); RaiseMsg(20200530134152,El);
PromiseSpecialize(SpecId,El,ExpName); PromiseSpecialize(SpecId,SpecName,El,El);
end; end;
procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject; procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;

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

@ -84,6 +84,8 @@ type
procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPas2jsRecordScope; Flags: TPCCheckFlags); virtual; procedure CheckRestoredRecordScope(const Path: string; Orig, Rest: TPas2jsRecordScope; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredClassScope(const Path: string; Orig, Rest: TPas2JSClassScope; 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 CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredProcTypeScope(const Path: string; Orig, Rest: TPas2JSProcTypeScope; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredArrayScope(const Path: string; Orig, Rest: TPas2JSArrayScope; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredPrecompiledJS(const Path: string; OrigEl: TPasElement; Orig: TPas2JSPrecompiledJS; RestEl: TPasElement; Rest: TPas2JSPrecompiledJS; 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 CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences; Flags: TPCCheckFlags); virtual;
procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope; Flags: TPCCheckFlags); virtual; procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope; Flags: TPCCheckFlags); virtual;
@ -218,13 +220,11 @@ type
procedure TestPC_GenericFunction_AnonymousProc; procedure TestPC_GenericFunction_AnonymousProc;
procedure TestPC_GenericClass; procedure TestPC_GenericClass;
procedure TestPC_GenericMethod; procedure TestPC_GenericMethod;
// ToDo: GenericMethod Calls, ProcTypes
procedure TestPC_SpecializeClassSameUnit; procedure TestPC_SpecializeClassSameUnit;
procedure TestPC_Specialize_LocalTypeInUnit; procedure TestPC_Specialize_LocalTypeInUnit;
// ToDo: specialize local generic type via class forward procedure TestPC_Specialize_ClassForward;
// ToDo: inline specialize local generic type in unit interface procedure TestPC_InlineSpecialize_LocalTypeInUnit;
// ToDo: inline specialize local generic type in unit implementation
// ToDo: inline specialize local generic type in proc decl
// ToDo: inline specialize local generic type in proc body
// ToDo: specialize extern generic type in unit interface // ToDo: specialize extern generic type in unit interface
// ToDo: specialize extern generic type in unit implementation // ToDo: specialize extern generic type in unit implementation
// ToDo: specialize extern generic type in proc decl // ToDo: specialize extern generic type in proc decl
@ -920,6 +920,8 @@ procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string;
begin begin
CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty); CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty);
CheckRestoredIdentifierScope(Path,Orig,Rest,Flags); CheckRestoredIdentifierScope(Path,Orig,Rest,Flags);
// ok -> use same JSName
Rest.JSName:=Orig.JSName;
end; end;
procedure TCustomTestPrecompile.CheckRestoredClassScope(const Path: string; procedure TCustomTestPrecompile.CheckRestoredClassScope(const Path: string;
@ -993,6 +995,9 @@ begin
end; end;
CheckRestoredIdentifierScope(Path,Orig,Rest,Flags); CheckRestoredIdentifierScope(Path,Orig,Rest,Flags);
// ok -> use same JSName
Rest.JSName:=Orig.JSName;
end; end;
procedure TCustomTestPrecompile.CheckRestoredProcScope(const Path: string; procedure TCustomTestPrecompile.CheckRestoredProcScope(const Path: string;
@ -1029,6 +1034,29 @@ begin
begin begin
// ImplProc // ImplProc
end; end;
// ok -> use same JSName
Rest.JSName:=Orig.JSName;
end;
procedure TCustomTestPrecompile.CheckRestoredProcTypeScope(const Path: string;
Orig, Rest: TPas2JSProcTypeScope; Flags: TPCCheckFlags);
begin
if Path='' then ;
if Flags=[] then ;
// ok -> use same JSName
Rest.JSName:=Orig.JSName;
end;
procedure TCustomTestPrecompile.CheckRestoredArrayScope(const Path: string;
Orig, Rest: TPas2JSArrayScope; Flags: TPCCheckFlags);
begin
if Path='' then ;
if Flags=[] then ;
// ok -> use same JSName
Rest.JSName:=Orig.JSName;
end; end;
procedure TCustomTestPrecompile.CheckRestoredPrecompiledJS(const Path: string; procedure TCustomTestPrecompile.CheckRestoredPrecompiledJS(const Path: string;
@ -1255,6 +1283,10 @@ begin
CheckRestoredClassScope(Path+'[TPas2JSClassScope]',TPas2JSClassScope(Orig),TPas2JSClassScope(Rest),Flags) CheckRestoredClassScope(Path+'[TPas2JSClassScope]',TPas2JSClassScope(Orig),TPas2JSClassScope(Rest),Flags)
else if C=TPas2JSProcedureScope then else if C=TPas2JSProcedureScope then
CheckRestoredProcScope(Path+'[TPas2JSProcedureScope]',TPas2JSProcedureScope(Orig),TPas2JSProcedureScope(Rest),Flags) CheckRestoredProcScope(Path+'[TPas2JSProcedureScope]',TPas2JSProcedureScope(Orig),TPas2JSProcedureScope(Rest),Flags)
else if C=TPas2JSArrayScope then
CheckRestoredArrayScope(Path+'[TPas2JSArrayScope]',TPas2JSArrayScope(Orig),TPas2JSArrayScope(Rest),Flags)
else if C=TPas2JSProcTypeScope then
CheckRestoredProcTypeScope(Path+'[TPas2JSProcTypeScope]',TPas2JSProcTypeScope(Orig),TPas2JSProcTypeScope(Rest),Flags)
else if C=TPasPropertyScope then else if C=TPasPropertyScope then
CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest),Flags) CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest),Flags)
else if C=TPasGenericParamsScope then else if C=TPasGenericParamsScope then
@ -3280,19 +3312,89 @@ begin
'type', 'type',
' TWordBird = TBird<word>;', ' TWordBird = TBird<word>;',
'procedure Run;', 'procedure Run;',
//'type TShortIntBird = TBird<shortint>;', 'type TShortIntBird = TBird<shortint>;',
'var', 'var',
//' shb: TShortIntBird;', ' shb: TShortIntBird;',
' wb: TWordBird;', ' wb: TWordBird;',
'begin', 'begin',
//' shb.a:=3;', ' shb.a:=3;',
' wb.a:=4;', ' wb.a:=4;',
'end;', 'end;',
'procedure Fly;', 'procedure Fly;',
//'type TByteBird = TBird<byte>;', 'type TByteBird = TBird<byte>;',
//'var bb: TByteBird;', 'var bb: TByteBird;',
'begin', 'begin',
//' bb.a:=5;', ' bb.a:=5;',
' Run;',
'end;',
'begin',
'']);
WriteReadUnit;
end;
procedure TTestPrecompile.TestPC_Specialize_ClassForward;
begin
StartUnit(false);
Add([
'{$mode delphi}',
'interface',
'type',
' TObject = class',
' end;',
' TBird<T> = class;',
' TAnt = class',
' b: TBird<word>;',
' end;',
' TBird<T> = class',
' a: TAnt;',
' end;',
'procedure Fly;',
'implementation',
'procedure Fly;',
'var b: TBird<Double>;',
'begin',
' b.a:=nil;',
'end;',
'begin',
'']);
WriteReadUnit;
end;
procedure TTestPrecompile.TestPC_InlineSpecialize_LocalTypeInUnit;
begin
StartUnit(false);
Add([
'{$mode delphi}',
'interface',
'type',
' TObject = class',
' constructor Create;',
' end;',
' TBird<T> = class',
' a: T;',
' end;',
'var',
' db: TBIrd<double>;',
'procedure Fly;',
'implementation',
'constructor TObject.Create;',
'begin',
'end;',
'var wb: TBird<word>;',
'procedure Run;',
'var',
' shb: TBird<shortint>;',
' bb: TBird<boolean>;',
'begin',
' shb.a:=3;',
' wb.a:=4;',
' bb.a:=true;',
' TBird<string>.Create;',
'end;',
'procedure Fly;',
'var lb: TBird<longint>;',
'begin',
' lb.a:=5;',
' Run;', ' Run;',
'end;', 'end;',
'begin', 'begin',