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

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

View File

@ -2105,6 +2105,7 @@ type
// checking compatibilility // checking compatibilility
function IsSameType(TypeA, TypeB: TPasType; ResolveAlias: TPRResolveAlias): boolean; // check if it is exactly the same 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 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); procedure CheckUseAsType(aType: TPasElement; id: TMaxPrecInt; ErrorEl: TPasElement);
function CheckCallProcCompatibility(ProcType: TPasProcedureType; function CheckCallProcCompatibility(ProcType: TPasProcedureType;
Params: TParamsExpr; RaiseOnError: boolean; Params: TParamsExpr; RaiseOnError: boolean;
@ -10079,6 +10080,41 @@ end;
procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr; procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
Params: TParamsExpr; Access: TResolvedRefAccess; CallName: string); 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); procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
var var
i: Integer; i: Integer;
@ -10089,11 +10125,9 @@ procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
end; end;
var var
i: Integer;
Msg: String;
FindCallData: TFindCallElData; FindCallData: TFindCallElData;
Abort: boolean; Abort: boolean;
El, FoundEl: TPasElement; FoundEl: TPasElement;
Ref: TResolvedReference; Ref: TResolvedReference;
FindData: TPRFindData; FindData: TPRFindData;
BuiltInProc: TResElDataBuiltInProc; BuiltInProc: TResElDataBuiltInProc;
@ -10160,33 +10194,16 @@ begin
// missing raise exception // missing raise exception
RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FindCallData.Found)); RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FindCallData.Found));
end; end;
if FindCallData.Count>1 then if FindCallData.Count>1 then
begin begin
// multiple overloads fit => search again and list the candidates // multiple overloads fit
FindCallData:=Default(TFindCallElData); if (FindCallData.Found is TPasProcedure)
FindCallData.Params:=Params; and (IndexOfGenericParam(Params.Params)>=0) then
FindCallData.List:=TFPList.Create; // generic params -> ignore ambiguity
try else
IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort); // => search again and list the candidates
Msg:=''; RaiseMultiFit;
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;
end; end;
// FoundEl compatible element -> create reference // FoundEl compatible element -> create reference
@ -25606,6 +25623,20 @@ begin
Result:=false; Result:=false;
end; 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; procedure TPasResolver.CheckUseAsType(aType: TPasElement; id: TMaxPrecInt;
ErrorEl: TPasElement); ErrorEl: TPasElement);
begin begin

View File

@ -113,7 +113,7 @@ type
procedure TestGen_Statements; procedure TestGen_Statements;
procedure TestGen_InlineSpecializeExpr; procedure TestGen_InlineSpecializeExpr;
procedure TestGen_TryExcept; procedure TestGen_TryExcept;
// ToDo: call procedure TestGen_Call;
// ToTo: nested proc // ToTo: nested proc
end; end;
@ -1644,6 +1644,33 @@ begin
ParseProgram; ParseProgram;
end; 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 initialization
RegisterTests([TTestResolveGenerics]); RegisterTests([TTestResolveGenerics]);