paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 07:31:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: call with generic template params, use first overload

Browse Source 
git-svn-id: trunk@42954 -
This commit is contained in:
Mattias Gaertner 2019-09-08 18:35:59 +00:00
parent a52153d424
commit d25636b7fb
2 changed files with 87 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2105,6 +2105,7 @@ type
// checking compatibilility
function IsSameType(TypeA, TypeB: TPasType; ResolveAlias: TPRResolveAlias): boolean; // check if it is exactly the same
function HasExactType(const ResolvedEl: TPasResolverResult): boolean; // false if HiTypeEl was guessed, e.g. 1 guessed a btLongint
function IndexOfGenericParam(Params: TPasExprArray): integer;
procedure CheckUseAsType(aType: TPasElement; id: TMaxPrecInt; ErrorEl: TPasElement);
function CheckCallProcCompatibility(ProcType: TPasProcedureType;
Params: TParamsExpr; RaiseOnError: boolean;
@ -10079,6 +10080,41 @@ end;
procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
Params: TParamsExpr; Access: TResolvedRefAccess; CallName: string);
procedure RaiseMultiFit;
var
FindCallData: TFindCallElData;
Msg: String;
i: Integer;
El: TPasElement;
Abort: boolean;
begin
FindCallData:=Default(TFindCallElData);
FindCallData.Params:=Params;
FindCallData.List:=TFPList.Create;
try
Abort:=false;
IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
Msg:='';
for i:=0 to FindCallData.List.Count-1 do
begin
El:=TPasElement(FindCallData.List[i]);
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDbg(El));
{$ENDIF}
// emit a hint for each candidate
if El is TPasProcedure then
LogMsg(20170417180320,mtHint,nFoundCallCandidateX,sFoundCallCandidateX,
[GetProcTypeDescription(TPasProcedure(El).ProcType,
[prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El);
Msg:=Msg+', '+GetElementSourcePosStr(El);
end;
finally
FindCallData.List.Free;
end;
RaiseMsg(20170216152200,nCantDetermineWhichOverloadedFunctionToCall,
sCantDetermineWhichOverloadedFunctionToCall+Msg,[CallName],NameExpr);
end;
procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
var
i: Integer;
@ -10089,11 +10125,9 @@ procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
end;
var
i: Integer;
Msg: String;
FindCallData: TFindCallElData;
Abort: boolean;
El, FoundEl: TPasElement;
FoundEl: TPasElement;
Ref: TResolvedReference;
FindData: TPRFindData;
BuiltInProc: TResElDataBuiltInProc;
@ -10160,33 +10194,16 @@ begin
// missing raise exception
RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FindCallData.Found));
end;
if FindCallData.Count>1 then
begin
// multiple overloads fit => search again and list the candidates
FindCallData:=Default(TFindCallElData);
FindCallData.Params:=Params;
FindCallData.List:=TFPList.Create;
try
IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
Msg:='';
for i:=0 to FindCallData.List.Count-1 do
begin
El:=TPasElement(FindCallData.List[i]);
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.ResolveFuncParamsExpr Overload Candidate: ',GetElementSourcePosStr(El),' ',GetTreeDbg(El));
{$ENDIF}
// emit a hint for each candidate
if El is TPasProcedure then
LogMsg(20170417180320,mtHint,nFoundCallCandidateX,sFoundCallCandidateX,
[GetProcTypeDescription(TPasProcedure(El).ProcType,
[prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El);
Msg:=Msg+', '+GetElementSourcePosStr(El);
end;
RaiseMsg(20170216152200,nCantDetermineWhichOverloadedFunctionToCall,
sCantDetermineWhichOverloadedFunctionToCall+Msg,[CallName],NameExpr);
finally
FindCallData.List.Free;
end;
// multiple overloads fit
if (FindCallData.Found is TPasProcedure)
and (IndexOfGenericParam(Params.Params)>=0) then
// generic params -> ignore ambiguity
else
// => search again and list the candidates
RaiseMultiFit;
end;
// FoundEl compatible element -> create reference
@ -25606,6 +25623,20 @@ begin
Result:=false;
end;
function TPasResolver.IndexOfGenericParam(Params: TPasExprArray): integer;
var
i: Integer;
ParamResolved: TPasResolverResult;
begin
for i:=0 to length(Params)-1 do
begin
ComputeElement(Params[i],ParamResolved,[]);
if ParamResolved.LoTypeEl is TPasGenericTemplateType then
exit(i);
end;
Result:=-1;
end;
procedure TPasResolver.CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
ErrorEl: TPasElement);
begin

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

@ -113,7 +113,7 @@ type
procedure TestGen_Statements;
procedure TestGen_InlineSpecializeExpr;
procedure TestGen_TryExcept;
// ToDo: call
procedure TestGen_Call;
// ToTo: nested proc
end;
@ -1644,6 +1644,33 @@ begin
ParseProgram;
end;
procedure TTestResolveGenerics.TestGen_Call;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' TObject = class end;',
' generic TBird<T> = class',
' function Fly(p:T): T;',
' end;',
'procedure Run(b: boolean); overload;',
'begin end;',
'procedure Run(w: word); overload;',
'begin end;',
'function TBird.Fly(p:T): T;',
'begin',
' Run(p);',
' Run(Result);',
'end;',
'var',
' w: specialize TBird<word>;',
' b: specialize TBird<boolean>;',
'begin',
'']);
ParseProgram;
end;
initialization
RegisterTests([TTestResolveGenerics]);