mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 07:28:26 +02:00
fcl-passrc: useanalyzer: specializetype
git-svn-id: trunk@42523 -
This commit is contained in:
Mattias Gaertner
parent
811d39d995
commit
a2e96cd459
@ -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 }
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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<T> = class(TBird<word>) 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<T> = 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);
|
||||
|
||||
@ -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<number>;',
|
||||
'const',
|
||||
' ci = 2;',
|
||||
' cr: specialize TRec<number> = (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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user