fcl-passrc: fixed parsing a(b).c<d>()

This commit is contained in:
mattias 2020-12-29 00:26:24 +00:00
parent 917aba3de2
commit 26ca4e7d16
4 changed files with 117 additions and 3 deletions

View File

@ -4734,7 +4734,7 @@ end;
procedure TPasResolver.GetParamsOfNameExpr(El: TPasExpr; out
ParentParams: TPRParentParams);
// Checks is El is the name expression of a call or array access
// Checks if El is the name expression of a call or array access
// For example: a.b.El() a.El[]
// Note: TPasParser guarantees that there is at most one TBinaryExpr
// and one TInlineSpecializeExpr between El and TParamsExpr
@ -10207,9 +10207,19 @@ begin
begin
TemplTypes:=GetProcTemplateTypes(Proc);
if (TemplTypes<>nil) then
begin
// implicit function specialization without bracket
{$IFDEF VerbosePasResolver}
DeclEl:=El;
while DeclEl.Parent is TPasExpr do
DeclEl:=DeclEl.Parent;
{AllowWriteln}
writeln('TPasResolver.ResolveNameExpr ',WritePasElTree(TPasExpr(DeclEl),' '));
{AllowWriteln-}
{$ENDIF}
RaiseMsg(20191007222004,nCouldNotInferTypeArgXForMethodY,
sCouldNotInferTypeArgXForMethodY,[TPasGenericTemplateType(TemplTypes[0]).Name,Proc.Name],El);
end;
end;
if El.Parent.ClassType=TPasProperty then

View File

@ -1789,6 +1789,7 @@ function GenericTemplateTypesAsString(List: TFPList): string;
procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
function dbgs(const s: TProcTypeModifiers): string; overload;
function WritePasElTree(Expr: TPasExpr; FollowPrefix: string = ''): string;
{$IFDEF HasPTDumpStack}
procedure PTDumpStack;
@ -1903,6 +1904,77 @@ begin
Result:='['+Result+']';
end;
function WritePasElTree(Expr: TPasExpr; FollowPrefix: string): string;
{ TBinary Kind= OpCode=
+Left=TBinary Kind= OpCode=
| +Left=TParamsExpr[]
| | +Value=Prim Kind= Value=
| | +Params[1]=Prim Kind= Value=
+Right=Prim
}
var
C: TClass;
s: string;
ParamsExpr: TParamsExpr;
InlineSpecExpr: TInlineSpecializeExpr;
SubEl: TPasElement;
ArrayValues: TArrayValues;
i: Integer;
begin
if Expr=nil then exit('nil');
C:=Expr.ClassType;
Result:=C.ClassName;
str(Expr.Kind,s);
Result:=Result+' '+s;
str(Expr.OpCode,s);
Result:=Result+' '+s;
if C=TPrimitiveExpr then
Result:=Result+' Value="'+TPrimitiveExpr(Expr).Value+'"'
else if C=TUnaryExpr then
Result:=Result+' Operand='+WritePasElTree(TUnaryExpr(Expr).Operand,FollowPrefix)
else if C=TBoolConstExpr then
Result:=Result+' Value='+BoolToStr(TBoolConstExpr(Expr).Value,'True','False')
else if C=TArrayValues then
begin
ArrayValues:=TArrayValues(Expr);
for i:=0 to length(ArrayValues.Values)-1 do
Result:=Result+sLineBreak+FollowPrefix+'+Values['+IntToStr(i)+']='+WritePasElTree(ArrayValues.Values[i],FollowPrefix+'| ');
end
else if C=TBinaryExpr then
begin
Result:=Result+sLineBreak+FollowPrefix+'+Left='+WritePasElTree(TBinaryExpr(Expr).left,FollowPrefix+'| ');
Result:=Result+sLineBreak+FollowPrefix+'+Right='+WritePasElTree(TBinaryExpr(Expr).right,FollowPrefix+'| ');
end
else if C=TParamsExpr then
begin
ParamsExpr:=TParamsExpr(Expr);
Result:=Result+sLineBreak+FollowPrefix+'+Value='+WritePasElTree(ParamsExpr.Value,FollowPrefix+'| ');
for i:=0 to length(ParamsExpr.Params)-1 do
Result:=Result+sLineBreak+FollowPrefix+'+Params['+IntToStr(i)+']='+WritePasElTree(ParamsExpr.Params[i],FollowPrefix+'| ');
end
else if C=TInlineSpecializeExpr then
begin
InlineSpecExpr:=TInlineSpecializeExpr(Expr);
Result:=Result+sLineBreak+FollowPrefix+'+Name='+WritePasElTree(InlineSpecExpr.NameExpr,FollowPrefix+'| ');
if InlineSpecExpr.Params<>nil then
for i:=0 to InlineSpecExpr.Params.Count-1 do
begin
Result:=Result+sLineBreak+FollowPrefix+'+Params['+IntToStr(i)+']=';
SubEl:=TPasElement(InlineSpecExpr.Params[i]);
if SubEl=nil then
Result:=Result+'nil'
else if SubEl is TPasExpr then
Result:=Result+WritePasElTree(TPasExpr(SubEl),FollowPrefix+'| ')
else
Result:=Result+SubEl.Name+':'+SubEl.ClassName;
end;
end
else
Result:=C.ClassName+' Kind=';
end;
Function IndentStrings(S : TStrings; indent : Integer) : string;
Var
I,CurrLen,CurrPos : Integer;

View File

@ -2522,11 +2522,16 @@ begin
NextToken;
if CurToken=tkspecialize then
begin
// Obj.specialize ...
if CanSpecialize=aMust then
CheckToken(tkLessThan);
CanSpecialize:=aMust;
NextToken;
end;
end
else if msDelphi in CurrentModeswitches then
CanSpecialize:=aCan
else
CanSpecialize:=aCannot;
if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
begin
aName:=aName+'.'+CurTokenString;

View File

@ -156,7 +156,7 @@ type
procedure TestGenProc_TypeParamCntOverload;
procedure TestGenProc_TypeParamCntOverloadNoParams;
procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
procedure TestGenProc_ParamSpecWithT; // ToDo: Func<T>(Bird: TBird<T>)
procedure TestGenProc_ParamSpecWithT;
// ToDo: NestedResultAssign
// generic function infer types
@ -186,6 +186,7 @@ type
procedure TestGenMethod_OverloadTypeParamCntDelphi;
procedure TestGenMethod_OverloadArgs;
procedure TestGenMethod_TypeCastParam;
procedure TestGenMethod_TypeCastIdentDot;
end;
implementation
@ -3010,6 +3011,32 @@ begin
ParseUnit;
end;
procedure TTestResolveGenerics.TestGenMethod_TypeCastIdentDot;
begin
StartUnit(false);
Add([
'{$mode delphi}',
'interface',
'type',
' TObject = class end;',
' TBird = class end;',
' TEagle = class(TBird)',
' procedure Run<S>(p: S);',
' procedure Fly;',
' end;',
'implementation',
'procedure TEagle.Run<S>(p: S);',
'begin',
'end;',
'procedure TEagle.Fly;',
'var Bird: TBird;',
'begin',
' TEagle(Bird).Run<word>(3);',
'end;',
'']);
ParseUnit;
end;
initialization
RegisterTests([TTestResolveGenerics]);