From 993c5115548c192c86688630281b6baccbdf1f49 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Thu, 22 Oct 2020 20:07:02 +0000 Subject: [PATCH] pastojs: filer: class forward git-svn-id: trunk@47153 - --- packages/pastojs/src/fppas2js.pp | 2 +- packages/pastojs/src/pas2jsfiler.pp | 85 ++++++++++++------- packages/pastojs/tests/tcfiler.pas | 124 +++++++++++++++++++++++++--- 3 files changed, 170 insertions(+), 41 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index eee6ca7c7a..9d9f0df5c8 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -18465,7 +18465,7 @@ begin aResolver:=AContext.Resolver; Proc:=TPasProcedure(ResolvedEl.IdentEl); - if not (Proc.Parent is TPasMembersType) + if (not (Proc.Parent is TPasMembersType)) or (ptmStatic in Proc.ProcType.Modifiers) then begin // not an "of object" method -> simply use the function diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp index e9a328088b..346d20509c 100644 --- a/packages/pastojs/src/pas2jsfiler.pp +++ b/packages/pastojs/src/pas2jsfiler.pp @@ -1028,10 +1028,11 @@ type protected // specialize FPendingSpecialize: TPCUReaderPendingSpecialized; // chain of TPCUReaderPendingSpecialized + function FindPendingSpecialize(Id: integer): 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 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); protected // json @@ -5418,9 +5419,20 @@ begin RaiseMsg(20200514130809,SpecData.Element,GetObjPath(RefEl)); 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 ): TPCUReaderPendingSpecialized; begin + if FindPendingSpecialize(Id)<>nil then + RaiseMsg(20201022214051,SpecName+'='+IntToStr(Id)); + Result:=TPCUReaderPendingSpecialized.Create; if FPendingSpecialize<>nil then begin @@ -5444,21 +5456,26 @@ var GenericEl: TPasGenericType; begin Result:=false; + {$IFDEF VerbosePCUFiler} + writeln('TPCUReader.CreateSpecializedElement Gen=',GetObjPath(PendSpec.GenericEl)); + {$ENDIF} if PendSpec.RefEl=nil then begin if PendSpec.GenericEl=nil then RaiseMsg(20200531101241,PendSpec.SpecName) else - RaiseMsg(20200531101105,PendSpec.GenericEl);// nothing uses this specialize + RaiseMsg(20200531101105,PendSpec.GenericEl,PendSpec.SpecName);// nothing uses this specialize end; if PendSpec.GenericEl=nil then - RaiseMsg(20200531101333,PendSpec.RefEl); + RaiseMsg(20200531101333,PendSpec.RefEl,PendSpec.SpecName); Obj:=PendSpec.Obj; if Obj=nil then - RaiseMsg(20200531101128,PendSpec.GenericEl); // specialize missing in JSON + RaiseMsg(20200531101128,PendSpec.GenericEl,PendSpec.SpecName); // specialize missing in JSON // resolve params RefParams:=PendSpec.Params; + if RefParams=nil then + RaiseMsg(20201022215141,PendSpec.GenericEl,PendSpec.SpecName); for i:=0 to RefParams.Count-1 do begin Param:=TPCUReaderPendingSpecializedParam(RefParams[i]); @@ -5501,25 +5518,18 @@ begin PendSpec.Free; end; -procedure TPCUReader.PromiseSpecialize(SpecId: integer; El: TPasElement; - const SpecName: string); -var - PendSpec: TPCUReaderPendingSpecialized; +function TPCUReader.PromiseSpecialize(SpecId: integer; const SpecName: string; + RefEl, ErrorEl: TPasElement): TPCUReaderPendingSpecialized; begin - PendSpec:=FPendingSpecialize; - while PendSpec<>nil do - begin - if PendSpec.Id=SpecId then - break; - PendSpec:=PendSpec.Next; - end; + Result:=FindPendingSpecialize(SpecId); + if Result=nil then + Result:=AddPendingSpecialize(SpecId,SpecName) + else if Result.SpecName<>SpecName then + RaiseMsg(20200531093342,ErrorEl,'Id='+IntToStr(SpecId)+' Expected SpecName "'+SpecName+'", but was "'+Result.SpecName+'"'); - if PendSpec=nil then - PendSpec:=AddPendingSpecialize(SpecId,SpecName) - else if PendSpec.SpecName<>SpecName then - RaiseMsg(20200531093342,El,'Id='+IntToStr(SpecId)+' Expected SpecName "'+SpecName+'", but was "'+PendSpec.SpecName+'"'); - if PendSpec.RefEl=nil then - PendSpec.RefEl:=El; + if Result.RefEl=nil then + Result.RefEl:=RefEl; + // Note: cannot specialize before ResolvePendingIdentifierScopes; end; procedure TPCUReader.ResolveSpecializedElements(Complete: boolean); @@ -5541,7 +5551,7 @@ begin if Ref<>nil then PendSpec.RefEl:=GetReferrerEl(Ref.Pending); end; - if PendSpec.RefEl<>nil then + if (PendSpec.RefEl<>nil) and (PendSpec.GenericEl<>nil) then begin if CreateSpecializedElement(PendSpec) then Changed:=true @@ -5554,8 +5564,20 @@ begin if Complete then UnresolvedSpec:=FPendingSpecialize; 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 - 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; procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string); @@ -6575,7 +6597,7 @@ begin if not ReadString(Obj,'SpecName',SpecName,GenEl) then RaiseMsg(20200531085133,GenEl); - PendSpec:=AddPendingSpecialize(Id,SpecName); + PendSpec:=PromiseSpecialize(Id,SpecName,nil,GenEl); PendSpec.Obj:=Obj; PendSpec.GenericEl:=GenEl; @@ -6596,6 +6618,11 @@ begin PendParam.Index:=i; PendParam.Id:=Id; 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; procedure TPCUReader.ReadExternalReferences(Obj: TJSONObject; El: TPasElement); @@ -8121,7 +8148,7 @@ procedure TPCUReader.ReadSpecializeType(Obj: TJSONObject; var GenType: TPasGenericType; GenericTemplateTypes: TFPList; - ExpName: string; + SpecName: string; i, SpecId: Integer; Data: TPasSpecializeTypeData; begin @@ -8153,12 +8180,12 @@ begin PromiseSetElReference(SpecId,@Set_SpecializeTypeData,Data,El); // check old specialized name - if not ReadString(Obj,'SpecName',ExpName,El) then + if not ReadString(Obj,'SpecName',SpecName,El) then RaiseMsg(20200219122919,El); - if ExpName='' then + if SpecName='' then RaiseMsg(20200530134152,El); - PromiseSpecialize(SpecId,El,ExpName); + PromiseSpecialize(SpecId,SpecName,El,El); end; procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject; diff --git a/packages/pastojs/tests/tcfiler.pas b/packages/pastojs/tests/tcfiler.pas index 928f14cb32..6f590c526b 100644 --- a/packages/pastojs/tests/tcfiler.pas +++ b/packages/pastojs/tests/tcfiler.pas @@ -84,6 +84,8 @@ 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 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 CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences; 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_GenericClass; procedure TestPC_GenericMethod; + // ToDo: GenericMethod Calls, ProcTypes 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 - // ToDo: inline specialize local generic type in proc body + procedure TestPC_Specialize_ClassForward; + procedure TestPC_InlineSpecialize_LocalTypeInUnit; // ToDo: specialize extern generic type in unit interface // ToDo: specialize extern generic type in unit implementation // ToDo: specialize extern generic type in proc decl @@ -920,6 +920,8 @@ procedure TCustomTestPrecompile.CheckRestoredRecordScope(const Path: string; begin CheckRestoredReference(Path+'.DefaultProperty',Orig.DefaultProperty,Rest.DefaultProperty); CheckRestoredIdentifierScope(Path,Orig,Rest,Flags); + // ok -> use same JSName + Rest.JSName:=Orig.JSName; end; procedure TCustomTestPrecompile.CheckRestoredClassScope(const Path: string; @@ -993,6 +995,9 @@ begin end; CheckRestoredIdentifierScope(Path,Orig,Rest,Flags); + + // ok -> use same JSName + Rest.JSName:=Orig.JSName; end; procedure TCustomTestPrecompile.CheckRestoredProcScope(const Path: string; @@ -1029,6 +1034,29 @@ begin begin // ImplProc 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; procedure TCustomTestPrecompile.CheckRestoredPrecompiledJS(const Path: string; @@ -1255,6 +1283,10 @@ begin CheckRestoredClassScope(Path+'[TPas2JSClassScope]',TPas2JSClassScope(Orig),TPas2JSClassScope(Rest),Flags) else if C=TPas2JSProcedureScope then 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 CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest),Flags) else if C=TPasGenericParamsScope then @@ -3280,19 +3312,89 @@ begin 'type', ' TWordBird = TBird;', 'procedure Run;', - //'type TShortIntBird = TBird;', + 'type TShortIntBird = TBird;', 'var', - //' shb: TShortIntBird;', + ' shb: TShortIntBird;', ' wb: TWordBird;', 'begin', - //' shb.a:=3;', + ' shb.a:=3;', ' wb.a:=4;', 'end;', 'procedure Fly;', - //'type TByteBird = TBird;', - //'var bb: TByteBird;', + 'type TByteBird = TBird;', + 'var bb: TByteBird;', '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 = class;', + ' TAnt = class', + ' b: TBird;', + ' end;', + ' TBird = class', + ' a: TAnt;', + ' end;', + 'procedure Fly;', + 'implementation', + 'procedure Fly;', + 'var b: TBird;', + '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 = class', + ' a: T;', + ' end;', + 'var', + ' db: TBIrd;', + 'procedure Fly;', + 'implementation', + 'constructor TObject.Create;', + 'begin', + 'end;', + 'var wb: TBird;', + 'procedure Run;', + 'var', + ' shb: TBird;', + ' bb: TBird;', + 'begin', + ' shb.a:=3;', + ' wb.a:=4;', + ' bb.a:=true;', + ' TBird.Create;', + 'end;', + 'procedure Fly;', + 'var lb: TBird;', + 'begin', + ' lb.a:=5;', ' Run;', 'end;', 'begin',