paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 01:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: implicit function specialization: default values

Browse Source 
git-svn-id: trunk@43151 -
This commit is contained in:
Mattias Gaertner 2019-10-07 20:34:50 +00:00
parent a046acab28
commit 61bb33406f
2 changed files with 80 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9864,7 +9864,7 @@ var
ProcScope: TPasProcedureScope;
ParentParams: TPRParentParams;
TypeCnt: Integer;
InlParams: TFPList;
InlParams, TemplTypes: TFPList;
begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.ResolveNameExpr El=',GetObjName(El),' Name="',aName,'" ',Access);
@ -9917,13 +9917,22 @@ begin
if DeclEl is TPasProcedure then
begin
// identifier is a proc and args brackets are missing
Proc:=TPasProcedure(DeclEl);
if ParentParams.InlineSpec=nil then
begin
TemplTypes:=GetProcTemplateTypes(Proc);
if (TemplTypes<>nil) then
// implicit function specialization without bracket
RaiseMsg(20191007222004,nCouldNotInferTypeArgXForMethodY,
sCouldNotInferTypeArgXForMethodY,[TPasGenericTemplateType(TemplTypes[0]).Name,Proc.Name],El);
end;
if El.Parent.ClassType=TPasProperty then
// a property accessor does not need args -> ok
// Note: the detailed tests are in FinishProperty
else
begin
// examples: funca or @proca or a.funca or @a.funca ...
Proc:=TPasProcedure(DeclEl);
if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
and (El.ClassType=TPrimitiveExpr)
and (El.Parent.ClassType=TPasImplAssign)
@ -10575,7 +10584,8 @@ begin
TemplParamsCnt:=0;
Abort:=false;
IterateElements(CallName,@OnFindCallElements,@FindCallData,Abort);
if FindCallData.Found=nil then
FoundEl:=FindCallData.Found;
if FoundEl=nil then
RaiseIdentifierNotFound(20170216152544,CallName,NameExpr);
if FindCallData.Distance=cIncompatible then
begin
@ -10584,51 +10594,53 @@ begin
writeln('TPasResolver.ResolveFuncParamsExpr found one element, but it was incompatible => check again to raise error. Found=',GetObjName(FindCallData.Found));
WriteScopes;
{$ENDIF}
if FindCallData.Found is TPasProcedure then
CheckCallProcCompatibility(TPasProcedure(FindCallData.Found).ProcType,Params,true)
else if FindCallData.Found is TPasProcedureType then
CheckTypeCast(TPasProcedureType(FindCallData.Found),Params,true)
else if FindCallData.Found.ClassType=TPasUnresolvedSymbolRef then
if FoundEl is TPasProcedure then
CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true)
else if FoundEl is TPasProcedureType then
CheckTypeCast(TPasProcedureType(FoundEl),Params,true)
else if FoundEl.ClassType=TPasUnresolvedSymbolRef then
begin
if FindCallData.Found.CustomData is TResElDataBuiltInProc then
if FoundEl.CustomData is TResElDataBuiltInProc then
begin
BuiltInProc:=TResElDataBuiltInProc(FindCallData.Found.CustomData);
BuiltInProc:=TResElDataBuiltInProc(FoundEl.CustomData);
BuiltInProc.GetCallCompatibility(BuiltInProc,Params,true);
end
else if FindCallData.Found.CustomData is TResElDataBaseType then
CheckTypeCast(TPasUnresolvedSymbolRef(FindCallData.Found),Params,true)
else if FoundEl.CustomData is TResElDataBaseType then
CheckTypeCast(TPasUnresolvedSymbolRef(FoundEl),Params,true)
else
RaiseNotYetImplemented(20161006132825,FindCallData.Found);
RaiseNotYetImplemented(20161006132825,FoundEl);
end
else if FindCallData.Found is TPasType then
else if FoundEl is TPasType then
// Note: check TPasType after TPasUnresolvedSymbolRef
CheckTypeCast(TPasType(FindCallData.Found),Params,true)
else if FindCallData.Found is TPasVariable then
CheckTypeCast(TPasType(FoundEl),Params,true)
else if FoundEl is TPasVariable then
begin
TypeEl:=ResolveAliasType(TPasVariable(FindCallData.Found).VarType);
TypeEl:=ResolveAliasType(TPasVariable(FoundEl).VarType);
if TypeEl is TPasProcedureType then
CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
else
RaiseMsg(20170405003522,nIllegalQualifierAfter,sIllegalQualifierAfter,['(',TypeEl.ElementTypeName],Params);
RaiseMsg(20170405003522,nIllegalQualifierAfter,sIllegalQualifierAfter,
['(',TypeEl.ElementTypeName],Params);
end
else if FindCallData.Found is TPasArgument then
else if FoundEl is TPasArgument then
begin
TypeEl:=ResolveAliasType(TPasArgument(FindCallData.Found).ArgType);
TypeEl:=ResolveAliasType(TPasArgument(FoundEl).ArgType);
if TypeEl is TPasProcedureType then
CheckCallProcCompatibility(TPasProcedureType(TypeEl),Params,true)
else
RaiseMsg(20180228145412,nIllegalQualifierAfter,sIllegalQualifierAfter,['(',TypeEl.ElementTypeName],Params);
RaiseMsg(20180228145412,nIllegalQualifierAfter,sIllegalQualifierAfter,
['(',TypeEl.ElementTypeName],Params);
end
else
RaiseNotYetImplemented(20161003134755,FindCallData.Found);
RaiseNotYetImplemented(20161003134755,FoundEl);
// missing raise exception
RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FindCallData.Found));
RaiseNotYetImplemented(20180621002400,Params,'missing exception, Found='+GetObjName(FoundEl));
end;
if FindCallData.Count>1 then
begin
// multiple overloads fit
if (FindCallData.Found is TPasProcedure)
if (FoundEl is TPasProcedure)
and (IndexOfGenericParam(Params.Params)>=0) then
// generic params -> ignore ambiguity
else
@ -10637,7 +10649,6 @@ begin
end;
// check template params
FoundEl:=FindCallData.Found;
if FoundEl is TPasProcedure then
GenTemplates:=GetProcTemplateTypes(TPasProcedure(FoundEl))
else if FoundEl is TPasGenericType then
@ -10670,6 +10681,8 @@ begin
ReleaseElementList(InferenceParams{$IFDEF CheckPasTreeRefCount},RefIdInferenceParamsExpr{$ENDIF});
FreeAndNil(InferenceParams);
end;
// check if params fit the implicit specialized function
CheckCallProcCompatibility(TPasProcedure(FoundEl).ProcType,Params,true);
end
else
// GenericType() -> missing type params
@ -15512,8 +15525,6 @@ type
Expr: TPasExpr;
begin
//writeln('InferParam i=',i,' NeedVar=',NeedVar,' IsDelphi=',IsDelphi,' ProcArgs.Count=',ProcArgs.Count);
if i>=ProcArgs.Count then
exit; // a proc with varargs
Arg:=TPasArgument(ProcArgs[i]);
ArgType:=Arg.ArgType;
if ArgType=nil then
@ -15523,7 +15534,13 @@ type
if NeedVar<>(Arg.Access in [argVar, argOut]) then
exit;
Expr:=ParamsExprs[i];
if i<length(ParamsExprs) then
Expr:=ParamsExprs[i]
else
begin
Expr:=Arg.ValueExpr;
if Expr=nil then exit;
end;
ComputeArgumentAndExpr(Arg,ArgResolved,Expr,ExprResolved,false);
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.CreateInferenceTypesForCall Arg=',GetTreeDbg(Arg,2),' ArgResolved=',GetResolverResultDbg(ArgResolved));
@ -15561,11 +15578,11 @@ begin
InferenceTypes[i]:=Default(TInferredType);
// first infer from var/out args exact types
for i:=0 to length(ParamsExprs)-1 do
for i:=0 to ProcArgs.Count-1 do
InferParam(i,true,ParamsExprs,ProcArgs,InferenceTypes,TemplTypes,IsDelphi);
// then infer from the other args
for i:=0 to length(ParamsExprs)-1 do
for i:=0 to ProcArgs.Count-1 do
InferParam(i,false,ParamsExprs,ProcArgs,InferenceTypes,TemplTypes,IsDelphi);
// check that all types are inferred
@ -22467,10 +22484,6 @@ begin
ProcArgs:=ProcType.Args;
Value:=Params.Value;
if Value is TInlineSpecializeExpr then
begin
//TInlineSpecializeExpr(Value).DestType;
end;
if Value is TBinaryExpr then
Value:=TBinaryExpr(Value).right;

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

@ -143,7 +143,8 @@ type
procedure TestGenProc_Inference_Overload;
procedure TestGenProc_Inference_Var_Overload;
//procedure TestGenProc_Inference_Widen;
// ToDo procedure TestGenProc_Inference_DefaultValue
procedure TestGenProc_Inference_DefaultValue;
procedure TestGenProc_Inference_DefaultValueMismatch;
procedure TestGenProc_Inference_ProcT;
procedure TestGenProc_Inference_Mismatch;
// ToDo procedure TestGenProc_Inference_ArrayOfT;
@ -2123,6 +2124,37 @@ begin
ParseProgram;
end;
procedure TTestResolveGenerics.TestGenProc_Inference_DefaultValue;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'generic procedure {#A}Run<S>(a: S = 2; b: S = 10); overload;',
'begin',
'end;',
'begin',
' {@A}Run(1,2);',
' {@A}Run(3);',
' {@A}Run();',
'']);
ParseProgram;
end;
procedure TTestResolveGenerics.TestGenProc_Inference_DefaultValueMismatch;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'generic procedure {#A}Run<S>(a: S; b: S = 10); overload;',
'begin',
'end;',
'begin',
' {@A}Run(false,true);',
'']);
CheckResolverException('Incompatible types: got "Longint" expected "Boolean"',
nIncompatibleTypesGotExpected);
end;
procedure TTestResolveGenerics.TestGenProc_Inference_ProcT;
begin
exit;