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