mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-13 16:49:22 +02:00
fcl-passrc: fixed parsing a(b).c<d>()
This commit is contained in:
parent
917aba3de2
commit
26ca4e7d16
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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]);
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user