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

fcl-passrc: resolver: generic type overload

Browse Source 
git-svn-id: trunk@43322 -
This commit is contained in:
Mattias Gaertner 2019-10-27 20:49:43 +00:00
parent 827c5ad389
commit 51998ca276
4 changed files with 125 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
packages/fcl-passrc/src/pasresolver.pp
View File

@ -1405,6 +1405,7 @@ type
Found: TPasElement; Found: TPasElement;
ElScope: TPasScope; // Where Found was found ElScope: TPasScope; // Where Found was found
StartScope: TPasScope; // where the search started StartScope: TPasScope; // where the search started
SkipGenerics: boolean;
end; end;
PPRFindData = ^TPRFindData; PPRFindData = ^TPRFindData;
@ -2047,9 +2048,9 @@ type
function FindElement(const aName: String): TPasElement; override; // used by TPasParser function FindElement(const aName: String): TPasElement; override; // used by TPasParser
function FindElementFor(const aName: String; AParent: TPasElement; TypeParamCount: integer): TPasElement; override; // used by TPasParser function FindElementFor(const aName: String; AParent: TPasElement; TypeParamCount: integer): TPasElement; override; // used by TPasParser
function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement; function FindElementWithoutParams(const AName: String; ErrorPosEl: TPasElement;
NoProcsWithArgs: boolean): TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement;
function FindElementWithoutParams(const AName: String; out Data: TPRFindData; function FindElementWithoutParams(const AName: String; out Data: TPRFindData;
ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement; ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement;
function FindFirstEl(const AName: String; out Data: TPRFindData; function FindFirstEl(const AName: String; out Data: TPRFindData;
ErrorPosEl: TPasElement): TPasElement; ErrorPosEl: TPasElement): TPasElement;
procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr); procedure FindLongestUnitName(var El: TPasElement; Expr: TPasExpr);
@ -4757,12 +4758,31 @@ procedure TPasResolver.OnFindFirst_PreferNoParams(El: TPasElement; ElScope,
var var
Data: PPRFindData absolute FindFirstElementData; Data: PPRFindData absolute FindFirstElementData;
ok: Boolean; ok: Boolean;
Proc: TPasProcedure;
Templates: TFPList;
begin begin
ok:=true; ok:=true;
if (El is TPasProcedure) if (El is TPasProcedure) then
and ProcNeedsParams(TPasProcedure(El).ProcType) then begin
// found a proc, but it needs parameters -> remember the first and continue Proc:=TPasProcedure(El);
ok:=false; if Data^.SkipGenerics then
begin
Templates:=GetProcTemplateTypes(Proc);
if (Templates<>nil) and (Templates.Count>0) then
ok:=false;
end;
if ok and ProcNeedsParams(Proc.ProcType) then
// found a proc, but it needs parameters -> remember the first and continue
ok:=false;
end
else if Data^.SkipGenerics then
begin
if El is TPasGenericType then
begin
if GetTypeParameterCount(TPasGenericType(El))>0 then
ok:=false;
end;
end;
if ok or (Data^.Found=nil) then if ok or (Data^.Found=nil) then
begin begin
Data^.Found:=El; Data^.Found:=El;
@ -5433,12 +5453,9 @@ function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
function SkipGenericTypes(Identifier: TPasIdentifier; function SkipGenericTypes(Identifier: TPasIdentifier;
TypeParamCnt: integer): TPasIdentifier; TypeParamCnt: integer): TPasIdentifier;
{$IFDEF EnableGenTypeOverload}
var var
CurEl: TPasElement; CurEl: TPasElement;
{$ENDIF}
begin begin
{$IFDEF EnableGenTypeOverload}
while Identifier<>nil do while Identifier<>nil do
begin begin
CurEl:=Identifier.Element; CurEl:=Identifier.Element;
@ -5454,9 +5471,6 @@ function TPasResolver.AddIdentifier(Scope: TPasIdentifierScope;
end; end;
Identifier:=Identifier.NextSameIdentifier; Identifier:=Identifier.NextSameIdentifier;
end; end;
{$ELSE}
if TypeParamCnt=0 then ;
{$ENDIF}
Result:=Identifier; Result:=Identifier;
end; end;
@ -8385,7 +8399,7 @@ var
if IsDefaultAncestor(aClass,DefAncestorName) then exit; if IsDefaultAncestor(aClass,DefAncestorName) then exit;
RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass); RaiseXExpectedButYFound(20190106132328,'top level '+DefAncestorName,'nested '+aClass.Name,aClass);
end; end;
CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false); CurEl:=FindElementWithoutParams(DefAncestorName,aClass,false,true);
if not (CurEl is TPasType) then if not (CurEl is TPasType) then
RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass); RaiseXExpectedButYFound(20180321150128,Expected,GetElementTypeName(CurEl),aClass);
DirectAncestor:=TPasType(CurEl); DirectAncestor:=TPasType(CurEl);
@ -8946,7 +8960,7 @@ begin
begin begin
// attribute without params // attribute without params
// -> resolve call 'Create' // -> resolve call 'Create'
DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false); DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false,true);
if DeclEl=nil then if DeclEl=nil then
RaiseIdentifierNotFound(20190221144516,'Create',NameExpr); RaiseIdentifierNotFound(20190221144516,'Create',NameExpr);
// check call is constructor // check call is constructor
@ -9996,7 +10010,7 @@ begin
RaiseXExpectedButYFound(20190916160829,'generic type',GetElementTypeName(DeclEl),El); RaiseXExpectedButYFound(20190916160829,'generic type',GetElementTypeName(DeclEl),El);
end end
else else
DeclEl:=FindElementWithoutParams(aName,FindData,El,false); DeclEl:=FindElementWithoutParams(aName,FindData,El,false,false);
if DeclEl.ClassType=TPasUsesUnit then if DeclEl.ClassType=TPasUsesUnit then
begin begin
@ -10980,7 +10994,7 @@ begin
else else
RaiseNotYetImplemented(20190131154557,NameExpr); RaiseNotYetImplemented(20190131154557,NameExpr);
DeclEl:=FindElementWithoutParams(ArrayName,FindData,NameExpr,true); DeclEl:=FindElementWithoutParams(ArrayName,FindData,NameExpr,true,true);
Ref:=CreateReference(DeclEl,NameExpr,Access,@FindData); Ref:=CreateReference(DeclEl,NameExpr,Access,@FindData);
CheckFoundElement(FindData,Ref); CheckFoundElement(FindData,Ref);
if DeclEl is TPasProcedure then if DeclEl is TPasProcedure then
@ -20548,7 +20562,7 @@ begin
RaiseInternalError(20190801104033); // caller forgot to handle "With" RaiseInternalError(20190801104033); // caller forgot to handle "With"
end end
else else
NextEl:=FindElementWithoutParams(CurName,ErrorEl,true); NextEl:=FindElementWithoutParams(CurName,ErrorEl,true,true);
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
//if RightPath<>'' then //if RightPath<>'' then
// writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl)); // writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl));
@ -20623,11 +20637,11 @@ begin
end; end;
function TPasResolver.FindElementWithoutParams(const AName: String; function TPasResolver.FindElementWithoutParams(const AName: String;
ErrorPosEl: TPasElement; NoProcsWithArgs: boolean): TPasElement; ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement;
var var
Data: TPRFindData; Data: TPRFindData;
begin begin
Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs); Result:=FindElementWithoutParams(AName,Data,ErrorPosEl,NoProcsWithArgs,NoGenerics);
if Data.Found=nil then exit; // forward type: class-of or ^ if Data.Found=nil then exit; // forward type: class-of or ^
CheckFoundElement(Data,nil); CheckFoundElement(Data,nil);
if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr) if (Data.StartScope<>nil) and (Data.StartScope.ClassType=ScopeClass_WithExpr)
@ -20636,8 +20650,8 @@ begin
end; end;
function TPasResolver.FindElementWithoutParams(const AName: String; out function TPasResolver.FindElementWithoutParams(const AName: String; out
Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs: boolean Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs,
): TPasElement; NoGenerics: boolean): TPasElement;
var var
Abort: boolean; Abort: boolean;
begin begin
@ -20646,6 +20660,7 @@ begin
Abort:=false; Abort:=false;
Data:=Default(TPRFindData); Data:=Default(TPRFindData);
Data.ErrorPosEl:=ErrorPosEl; Data.ErrorPosEl:=ErrorPosEl;
Data.SkipGenerics:=NoGenerics;
IterateElements(AName,@OnFindFirst_PreferNoParams,@Data,Abort); IterateElements(AName,@OnFindFirst_PreferNoParams,@Data,Abort);
Result:=Data.Found; Result:=Data.Found;
if Result=nil then if Result=nil then

31
packages/fcl-passrc/src/pparser.pp
View File

@ -410,7 +410,7 @@ type
function ArrayExprToText(Expr: TPasExprArray): String; function ArrayExprToText(Expr: TPasExprArray): String;
// Type declarations // Type declarations
function ResolveTypeReference(Name: string; Parent: TPasElement; ParamCnt: integer = 0): TPasType; function ResolveTypeReference(Name: string; Parent: TPasElement; ParamCnt: integer = 0): TPasType;
function ParseComplexType(Parent : TPasElement = Nil): TPasType; function ParseVarType(Parent : TPasElement = Nil): TPasType;
function ParseTypeDecl(Parent: TPasElement): TPasType; function ParseTypeDecl(Parent: TPasElement): TPasType;
function ParseGenericTypeDecl(Parent: TPasElement; AddToParent: boolean): TPasGenericType; function ParseGenericTypeDecl(Parent: TPasElement; AddToParent: boolean): TPasGenericType;
function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false): TPasType; function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false): TPasType;
@ -420,7 +420,7 @@ type
function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType; function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
function ParseAliasType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasType; function ParseAliasType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasType;
function ParseTypeReference(Parent: TPasElement; NeedExpr: boolean; out Expr: TPasExpr): TPasType; function ParseTypeReference(Parent: TPasElement; NeedExpr: boolean; out Expr: TPasExpr): TPasType;
function ParseSpecializeType(Parent: TPasElement; const TypeName, GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType; function ParseSpecializeType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName, GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType;
function ParsePointerType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasPointerType; function ParsePointerType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasPointerType;
Function ParseArrayType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String; PackMode : TPackMode) : TPasArrayType; Function ParseArrayType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String; PackMode : TPackMode) : TPasArrayType;
Function ParseFileType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String) : TPasFileType; Function ParseFileType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String) : TPasFileType;
@ -1504,10 +1504,11 @@ begin
begin begin
Params:=TParamsExpr(CreateElement(TParamsExpr,'',Result)); Params:=TParamsExpr(CreateElement(TParamsExpr,'',Result));
Params.Value:=Result.Expr; Params.Value:=Result.Expr;
Params.Value.Parent:=Params;
Result.Expr:=Params; Result.Expr:=Params;
LengthAsText:=''; LengthAsText:='';
NextToken; NextToken;
LengthExpr:=DoParseExpression(Result,nil,false); LengthExpr:=DoParseExpression(Params,nil,false);
Params.AddParam(LengthExpr); Params.AddParam(LengthExpr);
CheckToken(tkSquaredBraceClose); CheckToken(tkSquaredBraceClose);
LengthAsText:=ExprToText(LengthExpr); LengthAsText:=ExprToText(LengthExpr);
@ -1584,7 +1585,7 @@ begin
else if (CurToken = tkLessThan) else if (CurToken = tkLessThan)
and (MustBeSpecialize or (msDelphi in CurrentModeswitches)) then // A = B<t>; and (MustBeSpecialize or (msDelphi in CurrentModeswitches)) then // A = B<t>;
begin begin
Result:=ParseSpecializeType(Parent,TypeName,Name,Expr); Result:=ParseSpecializeType(Parent,NamePos,TypeName,Name,Expr);
ok:=true; ok:=true;
exit; exit;
end end
@ -1676,11 +1677,13 @@ function TPasParser.ParseTypeReference(Parent: TPasElement; NeedExpr: boolean;
var var
Name: String; Name: String;
IsSpecialize, ok: Boolean; IsSpecialize, ok: Boolean;
NamePos: TPasSourcePos;
begin begin
Result:=nil; Result:=nil;
Expr:=nil; Expr:=nil;
ok:=false; ok:=false;
try try
NamePos:=CurSourcePos;
if CurToken=tkspecialize then if CurToken=tkspecialize then
begin begin
IsSpecialize:=true; IsSpecialize:=true;
@ -1697,7 +1700,7 @@ begin
// specialize // specialize
if IsSpecialize or (msDelphi in CurrentModeswitches) then if IsSpecialize or (msDelphi in CurrentModeswitches) then
begin begin
Result:=ParseSpecializeType(Parent,'',Name,Expr); Result:=ParseSpecializeType(Parent,NamePos,'',Name,Expr);
NextToken; NextToken;
end end
else else
@ -1723,8 +1726,9 @@ begin
end; end;
end; end;
function TPasParser.ParseSpecializeType(Parent: TPasElement; const TypeName, function TPasParser.ParseSpecializeType(Parent: TPasElement;
GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType; const NamePos: TPasSourcePos; const TypeName, GenName: string;
var GenNameExpr: TPasExpr): TPasSpecializeType;
// after parsing CurToken is at > // after parsing CurToken is at >
var var
ST: TPasSpecializeType; ST: TPasSpecializeType;
@ -1732,7 +1736,7 @@ begin
Result:=nil; Result:=nil;
if CurToken<>tkLessThan then if CurToken<>tkLessThan then
ParseExcTokenError('[20190801112729]'); ParseExcTokenError('[20190801112729]');
ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,TypeName,Parent)); ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,TypeName,Parent,NamePos));
try try
if GenNameExpr<>nil then if GenNameExpr<>nil then
begin begin
@ -1998,7 +2002,9 @@ begin
Result.IsReferenceTo:=True; Result.IsReferenceTo:=True;
end; end;
function TPasParser.ParseComplexType(Parent : TPasElement = Nil): TPasType; function TPasParser.ParseVarType(Parent : TPasElement = Nil): TPasType;
var
NamePos: TPasSourcePos;
begin begin
NextToken; NextToken;
case CurToken of case CurToken of
@ -2017,8 +2023,9 @@ begin
UngetToken; // Unget semicolon UngetToken; // Unget semicolon
end; end;
else else
NamePos:=CurSourcePos;
UngetToken; UngetToken;
Result := ParseType(Parent,CurSourcePos); Result := ParseType(Parent,NamePos);
end; end;
end; end;
@ -3670,7 +3677,7 @@ begin
tkGeneric: tkGeneric:
begin begin
NextToken; NextToken;
if (CurToken in [tkprocedure,tkfunction]) then if (CurToken in [tkclass,tkprocedure,tkfunction]) then
begin begin
if msDelphi in CurrentModeswitches then if msDelphi in CurrentModeswitches then
ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
@ -4625,7 +4632,7 @@ begin
Until (CurToken=tkColon); Until (CurToken=tkColon);
OldForceCaret:=Scanner.SetForceCaret(True); OldForceCaret:=Scanner.SetForceCaret(True);
try try
VarType := ParseComplexType(VarEl); VarType := ParseVarType(VarEl);
{$IFDEF CheckPasTreeRefCount}if VarType.RefIds.IndexOf('CreateElement')>=0 then VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF}; {$IFDEF CheckPasTreeRefCount}if VarType.RefIds.IndexOf('CreateElement')>=0 then VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF};
finally finally
Scanner.SetForceCaret(OldForceCaret); Scanner.SetForceCaret(OldForceCaret);

68
packages/fcl-passrc/tests/tcresolvegenerics.pas
View File

@ -58,9 +58,10 @@ type
// generic class // generic class
procedure TestGen_Class; procedure TestGen_Class;
procedure TestGen_ClassDelphi; procedure TestGen_ClassDelphi;
procedure TestGen_ClassDelphi_TypeOverload; // ToDo: type overload procedure TestGen_ClassDelphi_TypeOverload;
procedure TestGen_ClassObjFPC; procedure TestGen_ClassObjFPC;
procedure TestGen_ClassObjFPC_OverloadFail; procedure TestGen_ClassObjFPC_OverloadFail;
procedure TestGen_ClassObjFPC_OverloadOtherUnit;
procedure TestGen_ClassForward; procedure TestGen_ClassForward;
procedure TestGen_ClassForwardConstraints; procedure TestGen_ClassForwardConstraints;
procedure TestGen_ClassForwardConstraintNameMismatch; procedure TestGen_ClassForwardConstraintNameMismatch;
@ -68,7 +69,7 @@ type
procedure TestGen_ClassForwardConstraintTypeMismatch; procedure TestGen_ClassForwardConstraintTypeMismatch;
procedure TestGen_ClassForward_Circle; procedure TestGen_ClassForward_Circle;
procedure TestGen_Class_RedeclareInUnitImplFail; procedure TestGen_Class_RedeclareInUnitImplFail;
procedure TestGen_Class_AnotherInUnitImpl; // ToDo: type overload procedure TestGen_Class_TypeOverloadInUnitImpl;
procedure TestGen_Class_MethodObjFPC; procedure TestGen_Class_MethodObjFPC;
procedure TestGen_Class_MethodOverride; procedure TestGen_Class_MethodOverride;
procedure TestGen_Class_MethodDelphi; procedure TestGen_Class_MethodDelphi;
@ -768,18 +769,18 @@ begin
'{$mode delphi}', '{$mode delphi}',
'type', 'type',
' TObject = class end;', ' TObject = class end;',
' TBird = word;', ' {#a}TBird = word;',
' TBird<T> = class', ' {#b}TBird<T> = class',
' v: T;', ' v: T;',
' end;', ' end;',
//' TEagle = TBird<word>;', ' {=b}TEagle = TBird<word>;',
//'var', 'var',
//' b: TBird<word>;', ' b: {@b}TBird<word>;',
//' w: TBird;', ' {=a}w: TBird;',
'begin', 'begin',
//' b.v:=w;', ' b.v:=w;',
'']); '']);
CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier); ParseProgram;
end; end;
procedure TTestResolveGenerics.TestGen_ClassObjFPC; procedure TTestResolveGenerics.TestGen_ClassObjFPC;
@ -816,6 +817,41 @@ begin
CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier); CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier);
end; end;
procedure TTestResolveGenerics.TestGen_ClassObjFPC_OverloadOtherUnit;
begin
AddModuleWithIntfImplSrc('unit1.pas',
LinesToStr([
'type',
' TBird = class b1: word; end;',
' generic TAnt<T> = class a1: T; end;',
'']),
LinesToStr([
'']));
AddModuleWithIntfImplSrc('unit2.pas',
LinesToStr([
'type',
' generic TBird<T> = class b2:T; end;',
' TAnt = class a2:word; end;',
'']),
LinesToStr([
'']));
StartProgram(true,[supTObject]);
Add([
'uses unit1, unit2;',
'var',
' b1: TBird;',
' b2: specialize TBird<word>;',
' a1: specialize TAnt<word>;',
' a2: TAnt;',
'begin',
' b1.b1:=1;',
' b2.b2:=2;',
' a1.a1:=3;',
' a2.a2:=4;',
'']);
ParseProgram;
end;
procedure TTestResolveGenerics.TestGen_ClassForward; procedure TTestResolveGenerics.TestGen_ClassForward;
begin begin
StartProgram(false); StartProgram(false);
@ -970,7 +1006,7 @@ begin
nDuplicateIdentifier); nDuplicateIdentifier);
end; end;
procedure TTestResolveGenerics.TestGen_Class_AnotherInUnitImpl; procedure TTestResolveGenerics.TestGen_Class_TypeOverloadInUnitImpl;
begin begin
StartUnit(false); StartUnit(false);
Add([ Add([
@ -981,7 +1017,7 @@ begin
'implementation', 'implementation',
'type generic TBird<T,U> = record x: T; y: U; end;', 'type generic TBird<T,U> = record x: T; y: U; end;',
'']); '']);
CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,16)',nDuplicateIdentifier); ParseUnit;
end; end;
procedure TTestResolveGenerics.TestGen_Class_MethodObjFPC; procedure TTestResolveGenerics.TestGen_Class_MethodObjFPC;
@ -995,10 +1031,18 @@ begin
' generic TBird<{#Templ}T> = class', ' generic TBird<{#Templ}T> = class',
' function Fly(p:T): T; virtual; abstract;', ' function Fly(p:T): T; virtual; abstract;',
' function Run(p:T): T;', ' function Run(p:T): T;',
' procedure Jump(p:T);',
' class procedure Go(p:T);',
' end;', ' end;',
'function TBird.Run(p:T): T;', 'function TBird.Run(p:T): T;',
'begin', 'begin',
'end;', 'end;',
'generic procedure TBird<T>.Jump(p:T);',
'begin',
'end;',
'generic class procedure TBird<T>.Go(p:T);',
'begin',
'end;',
'var', 'var',
' b: specialize TBird<word>;', ' b: specialize TBird<word>;',
' {=Typ}w: T;', ' {=Typ}w: T;',

18
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -1462,7 +1462,9 @@ var
if El.CustomData is TResolvedReference then if El.CustomData is TResolvedReference then
Ref:=TResolvedReference(El.CustomData).Declaration Ref:=TResolvedReference(El.CustomData).Declaration
else if El.CustomData is TPasPropertyScope then else if El.CustomData is TPasPropertyScope then
Ref:=TPasPropertyScope(El.CustomData).AncestorProp; Ref:=TPasPropertyScope(El.CustomData).AncestorProp
else if El.CustomData is TPasSpecializeTypeData then
Ref:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
if Ref<>nil then if Ref<>nil then
for j:=0 to LabelElements.Count-1 do for j:=0 to LabelElements.Count-1 do
begin begin
@ -1478,11 +1480,17 @@ var
El:=TPasElement(ReferenceElements[i]); El:=TPasElement(ReferenceElements[i]);
write('Reference candidate for "',aMarker^.Identifier,'" at reference ',aMarker^.Filename,'(',aMarker^.Row,',',aMarker^.StartCol,'-',aMarker^.EndCol,')'); write('Reference candidate for "',aMarker^.Identifier,'" at reference ',aMarker^.Filename,'(',aMarker^.Row,',',aMarker^.StartCol,'-',aMarker^.EndCol,')');
write(' El=',GetObjName(El)); write(' El=',GetObjName(El));
if EL is TPrimitiveExpr then
begin
writeln('CheckResolverReference ',TPrimitiveExpr(El).Value);
end;
Ref:=nil; Ref:=nil;
if El.CustomData is TResolvedReference then if El.CustomData is TResolvedReference then
Ref:=TResolvedReference(El.CustomData).Declaration Ref:=TResolvedReference(El.CustomData).Declaration
else if El.CustomData is TPasPropertyScope then else if El.CustomData is TPasPropertyScope then
Ref:=TPasPropertyScope(El.CustomData).AncestorProp; Ref:=TPasPropertyScope(El.CustomData).AncestorProp
else if El.CustomData is TPasSpecializeTypeData then
Ref:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
if Ref<>nil then if Ref<>nil then
begin begin
write(' Decl=',GetObjName(Ref)); write(' Decl=',GetObjName(Ref));
@ -1490,7 +1498,7 @@ var
write(',',Ref.SourceFilename,'(',aLine,',',aCol,')'); write(',',Ref.SourceFilename,'(',aLine,',',aCol,')');
end end
else else
write(' has no TResolvedReference'); write(' has no TResolvedReference. El.CustomData=',GetObjName(El.CustomData));
writeln; writeln;
end; end;
for i:=0 to LabelElements.Count-1 do for i:=0 to LabelElements.Count-1 do
@ -1533,7 +1541,7 @@ var
for i:=0 to ReferenceElements.Count-1 do for i:=0 to ReferenceElements.Count-1 do
begin begin
El:=TPasElement(ReferenceElements[i]); El:=TPasElement(ReferenceElements[i]);
//writeln('CheckDirectReference ',i,'/',ReferenceElements.Count,' ',GetTreeDesc(El,2)); //writeln('CheckDirectReference ',i,'/',ReferenceElements.Count,' ',GetTreeDbg(El,2));
if El.ClassType=TPasVariable then if El.ClassType=TPasVariable then
begin begin
if TPasVariable(El).VarType=nil then if TPasVariable(El).VarType=nil then
@ -1582,6 +1590,8 @@ var
begin begin
El:=TPasElement(ReferenceElements[i]); El:=TPasElement(ReferenceElements[i]);
writeln(' Reference ',GetObjName(El),' at ',ResolverEngine.GetElementSourcePosStr(El)); writeln(' Reference ',GetObjName(El),' at ',ResolverEngine.GetElementSourcePosStr(El));
//if EL is TPasVariable then
// writeln('CheckDirectReference ',GetObjPath(TPasVariable(El).VarType),' ',ResolverEngine.GetElementSourcePosStr(TPasVariable(EL).VarType));
end; end;
RaiseErrorAtSrcMarker('wrong direct reference "'+aMarker^.Identifier+'"',aMarker); RaiseErrorAtSrcMarker('wrong direct reference "'+aMarker^.Identifier+'"',aMarker);
finally finally