mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-06 04:52:17 +02:00
fcl-passrc: call with generic template params, use first overload
git-svn-id: trunk@42954 -
This commit is contained in:
parent
a52153d424
commit
d25636b7fb
@ -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
|
||||||
|
@ -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]);
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user