From a2e96cd459e738fa93d5d0ead7de04992cad4927 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Sun, 28 Jul 2019 20:16:42 +0000 Subject: [PATCH] fcl-passrc: useanalyzer: specializetype git-svn-id: trunk@42523 - --- packages/fcl-passrc/src/pasresolveeval.pas | 2 + packages/fcl-passrc/src/pasresolver.pp | 38 ++++++++++++++++--- packages/fcl-passrc/src/pastree.pp | 2 +- packages/fcl-passrc/src/pasuseanalyzer.pas | 21 ++++++++++ packages/fcl-passrc/src/pparser.pp | 9 ++++- .../fcl-passrc/tests/tcresolvegenerics.pas | 19 ++++++++++ packages/fcl-passrc/tests/tcuseanalyzer.pas | 29 ++++++++++++++ 7 files changed, 111 insertions(+), 9 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolveeval.pas b/packages/fcl-passrc/src/pasresolveeval.pas index 85bca36f72..9224c4f5b1 100644 --- a/packages/fcl-passrc/src/pasresolveeval.pas +++ b/packages/fcl-passrc/src/pasresolveeval.pas @@ -194,6 +194,7 @@ const nConstraintXAndConstraintYCannotBeTogether = 3128; nXIsNotAValidConstraint = 3129; nWrongNumberOfParametersForGenericType = 3130; + nGenericsWithoutSpecializationAsType = 3131; // using same IDs as FPC nVirtualMethodXHasLowerVisibility = 3250; // was 3050 @@ -335,6 +336,7 @@ resourcestring sConstraintXAndConstraintYCannotBeTogether = '''%s'' constraint and ''%s'' constraint cannot be specified together'; sXIsNotAValidConstraint = '''%s'' is not a valid constraint'; sWrongNumberOfParametersForGenericType = 'wrong number of parameters for generic type %s'; + sGenericsWithoutSpecializationAsType = 'Generics without specialization cannot be used as a type for a %s'; type { TResolveData - base class for data stored in TPasElement.CustomData } diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 31332a5f22..d605109c3a 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -14110,6 +14110,7 @@ var OldStashCount, i: Integer; Scope: TPasGenericScope; TemplType: TPasGenericTemplateType; + NewParent: TPasElement; begin Result:=nil; GenericType:=El.DestType as TPasGenericType; @@ -14134,9 +14135,23 @@ begin SpecializedTypes.Add(Result); NewName:=GenericType.Name+'$G'+IntToStr(SpecializedTypes.Count); NewClass:=TPTreeElement(GenericType.ClassType); - NewEl:=TPasGenericType(NewClass.Create(NewName,GenericType.Parent)); - Result.SpecializedType:=NewEl; - NewEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF}; + NewParent:=GenericType.Parent; + NewEl:=TPasGenericType(NewClass.Create(NewName,NewParent)); + Result.SpecializedType:=NewEl; // this calls AddRef + + if NewParent is TPasDeclarations then + begin + TPasDeclarations(NewParent).Declarations.Add(NewEl); + {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasDeclarations.Children');{$ENDIF} + end + else if NewParent is TPasMembersType then + begin + TPasMembersType(NewParent).Members.Add(NewEl); + {$IFDEF CheckPasTreeRefCount}NewEl.RefIds.Add('TPasMembersType.Members');{$ENDIF} + end + else + NewEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF}; // fix refcount + SpecializePasElementProperties(GenericType,NewEl); // create scope of specialized type @@ -14202,6 +14217,8 @@ function TPasResolver.InitSpecializeScopes(El: TPasElement): integer; begin if CurEl.Parent=nil then RaiseInternalError(20190728130238,GetObjName(CurEl)); + if CurEl.CustomData=nil then + exit(PushParentScopes(CurEl.Parent)); if not (CurEl.CustomData is TPasIdentifierScope) then RaiseNotYetImplemented(20190728131934,El,GetObjName(CurEl)+' '+GetObjName(CurEl.CustomData)); Keep:=PushParentScopes(CurEl.Parent); @@ -22951,9 +22968,18 @@ procedure TPasResolver.CheckUseAsType(aType: TPasElement; id: TMaxPrecInt; ErrorEl: TPasElement); begin if aType=nil then exit; - if aType.ClassType<>TPasClassType then exit; - if TPasClassType(aType).HelperForType<>nil then - RaiseHelpersCannotBeUsedAsType(id,ErrorEl); + if aType is TPasGenericType then + begin + if aType.ClassType=TPasClassType then + begin + if TPasClassType(aType).HelperForType<>nil then + RaiseHelpersCannotBeUsedAsType(id,ErrorEl); + end; + if (TPasGenericType(aType).GenericTemplateTypes<>nil) + and (TPasGenericType(aType).GenericTemplateTypes.Count>0) then + RaiseMsg(id,nGenericsWithoutSpecializationAsType,sGenericsWithoutSpecializationAsType, + [ErrorEl.ElementTypeName],ErrorEl); + end; end; function TPasResolver.GetPasClassAncestor(ClassEl: TPasClassType; diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index eb5660ecf7..8aed55336e 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/packages/fcl-passrc/src/pastree.pp @@ -3045,7 +3045,7 @@ begin begin Child:=TPasElement(Declarations[i]); Child.Parent:=nil; - Child.Release{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Childs'){$ENDIF}; + Child.Release{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Children'){$ENDIF}; end; FreeAndNil(Declarations); diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas index e8fe174b6f..f09b680c73 100644 --- a/packages/fcl-passrc/src/pasuseanalyzer.pas +++ b/packages/fcl-passrc/src/pasuseanalyzer.pas @@ -270,6 +270,7 @@ type procedure UseType(El: TPasType; Mode: TPAUseMode); virtual; procedure UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode); virtual; procedure UseClassConstructor(El: TPasMembersType); virtual; + procedure UseSpecializeType(El: TPasSpecializeType; Mode: TPAUseMode); virtual; procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess; UseFull: boolean); virtual; procedure UseResourcestring(El: TPasResString); virtual; @@ -1924,6 +1925,8 @@ begin end else if C.InheritsFrom(TPasProcedureType) then UseProcedureType(TPasProcedureType(El)) + else if C=TPasSpecializeType then + UseSpecializeType(TPasSpecializeType(El),Mode) else RaiseNotSupported(20170306170315,El); @@ -2200,6 +2203,24 @@ begin end; end; +procedure TPasAnalyzer.UseSpecializeType(El: TPasSpecializeType; + Mode: TPAUseMode); +var + Param: TPasElement; + i: Integer; +begin + if not MarkElementAsUsed(El) then exit; + // El.DestType is TPasGenericType, which is never be used + if El.CustomData is TPasSpecializeTypeData then + UseElType(El,TPasSpecializeTypeData(El.CustomData).SpecializedType,Mode); + for i:=0 to El.Params.Count-1 do + begin + Param:=TPasElement(El.Params[i]); + if Param is TPasGenericTemplateType then continue; + UseElement(Param,rraRead,false); + end; +end; + procedure TPasAnalyzer.UseVariable(El: TPasVariable; Access: TResolvedRefAccess; UseFull: boolean); var diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index b2b140d481..fc7afead49 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -3358,6 +3358,7 @@ var procedure InitGenericType(NewEl: TPasGenericType; GenericTemplateTypes: TFPList); begin Declarations.Declarations.Add(NewEl); + {$IFDEF CheckPasTreeRefCount}NewEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF} NewEl.SetGenericTemplates(GenericTemplateTypes); Engine.FinishScope(stGenericTypeTemplates,NewEl); end; @@ -3504,6 +3505,7 @@ begin if Assigned(TypeEl) then // !!! begin Declarations.Declarations.Add(TypeEl); + {$IFDEF CheckPasTreeRefCount}if TypeEl.RefIds.IndexOf('CreateElement')>=0 then TypeEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF} if (TypeEl.ClassType = TPasClassType) and (not (po_keepclassforward in Options)) then begin @@ -3548,6 +3550,7 @@ begin begin ExpEl := TPasExportSymbol(List[i]); Declarations.Declarations.Add(ExpEl); + {$IFDEF CheckPasTreeRefCount}ExpEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF} Declarations.ExportSymbols.Add(ExpEl); end; finally @@ -3578,6 +3581,7 @@ begin begin PropEl:=ParseProperty(Declarations,CurtokenString,visDefault,false); Declarations.Declarations.Add(PropEl); + {$IFDEF CheckPasTreeRefCount}PropEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF} Declarations.Properties.Add(PropEl); Engine.FinishScope(stDeclaration,PropEl); end; @@ -3911,10 +3915,8 @@ end; // Starts after the variable name function TPasParser.ParseConstDecl(Parent: TPasElement): TPasConst; - var OldForceCaret,ok: Boolean; - begin SaveComments; Result := TPasConst(CreateElement(TPasConst, CurTokenString, Parent)); @@ -3930,6 +3932,7 @@ begin OldForceCaret:=Scanner.SetForceCaret(True); try Result.VarType := ParseType(Result,CurSourcePos); + {$IFDEF CheckPasTreeRefCount}if Result.VarType.RefIds.IndexOf('CreateElement')>=0 then Result.VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF}; finally Scanner.SetForceCaret(OldForceCaret); end; @@ -4506,6 +4509,7 @@ begin OldForceCaret:=Scanner.SetForceCaret(True); try VarType := ParseComplexType(VarEl); + {$IFDEF CheckPasTreeRefCount}if VarType.RefIds.IndexOf('CreateElement')>=0 then VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF}; finally Scanner.SetForceCaret(OldForceCaret); end; @@ -5432,6 +5436,7 @@ begin if CurToken = tkColon then begin Result.VarType := ParseType(Result,CurSourcePos); + {$IFDEF CheckPasTreeRefCount}if Result.VarType.RefIds.IndexOf('CreateElement')>=0 then Result.VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF}; NextToken; end else if not IsClass then diff --git a/packages/fcl-passrc/tests/tcresolvegenerics.pas b/packages/fcl-passrc/tests/tcresolvegenerics.pas index bd0f700b87..3bd63b9c77 100644 --- a/packages/fcl-passrc/tests/tcresolvegenerics.pas +++ b/packages/fcl-passrc/tests/tcresolvegenerics.pas @@ -13,8 +13,12 @@ type TTestResolveGenerics = Class(TCustomTestResolver) Published + // generic functions procedure TestGen_GenericFunction; // ToDo + + // generic types procedure TestGen_MissingTemplateFail; + procedure TestGen_VarTypeWithoutSpecializeFail; procedure TestGen_ConstraintStringFail; procedure TestGen_ConstraintMultiClassFail; procedure TestGen_ConstraintRecordExpectedFail; @@ -31,10 +35,13 @@ type // ToDo: generic class // ToDo: generic class forward // ToDo: ancestor cycle: TBird = class(TBird) fail + // ToDo: class-of // ToDo: UnitA.impl uses UnitB.intf uses UnitA.intf, UnitB has specialize of UnitA // ToDo: generic interface // ToDo: generic array // ToDo: generic procedure type + // ToDo: pointer of generic + // ToDo: generic helpers end; implementation @@ -68,6 +75,18 @@ begin CheckParserException('Expected "Identifier"',nParserExpectTokenError); end; +procedure TTestResolveGenerics.TestGen_VarTypeWithoutSpecializeFail; +begin + StartProgram(false); + Add([ + 'type generic TBird = record end;', + 'var b: TBird;', + 'begin', + '']); + CheckResolverException('Generics without specialization cannot be used as a type for a variable', + nGenericsWithoutSpecializationAsType); +end; + procedure TTestResolveGenerics.TestGen_ConstraintStringFail; begin StartProgram(false); diff --git a/packages/fcl-passrc/tests/tcuseanalyzer.pas b/packages/fcl-passrc/tests/tcuseanalyzer.pas index 0bad2cb330..4874fe83a6 100644 --- a/packages/fcl-passrc/tests/tcuseanalyzer.pas +++ b/packages/fcl-passrc/tests/tcuseanalyzer.pas @@ -67,6 +67,7 @@ type procedure TestM_Const; procedure TestM_ResourceString; procedure TestM_Record; + procedure TestM_RecordGeneric; procedure TestM_PointerTyped_Record; procedure TestM_Array; procedure TestM_NestedFuncResult; @@ -880,6 +881,34 @@ begin AnalyzeProgram; end; +procedure TTestUseAnalyzer.TestM_RecordGeneric; +begin + StartProgram(false); + Add([ + 'procedure {#DoIt_used}DoIt;', + 'type', + ' {#integer_used}integer = longint;', + ' {#number_used}number = word;', + ' generic {#trec_used}TRec<{#trec_t_notused}T> = record', + ' {#a_used}a: integer;', + ' {#b_notused}b: integer;', + ' {#c_used}c: T;', + ' end;', + 'var', + ' {#r_used}r: specialize TRec;', + 'const', + ' ci = 2;', + ' cr: specialize TRec = (a:0;b:ci;c:2);', + 'begin', + ' r.a:=3;', + ' with r do c:=4;', + ' r:=cr;', + 'end;', + 'begin', + ' DoIt;']); + AnalyzeProgram; +end; + procedure TTestUseAnalyzer.TestM_PointerTyped_Record; begin StartProgram(false);