paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 05:09:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: fixed marking implicit call in prop arg

Browse Source 
git-svn-id: trunk@43202 -
This commit is contained in:
Mattias Gaertner 2019-10-15 11:11:23 +00:00
parent 8a3df44734
commit a261b86aca
2 changed files with 72 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8970,7 +8970,7 @@ begin
argVar: ParamAccess:=rraVarParam; argVar: ParamAccess:=rraVarParam;
argOut: ParamAccess:=rraOutParam; argOut: ParamAccess:=rraOutParam;
end; end;
AccessExpr(Params.Params[i],ParamAccess); FinishCallArgAccess(Params.Params[i],ParamAccess);
end; end;
end; end;

72
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -715,8 +715,8 @@ type
Procedure TestClassProperty; Procedure TestClassProperty;
Procedure TestClassPropertyNonStaticFail; Procedure TestClassPropertyNonStaticFail;
Procedure TestClassPropertyNonStaticAllow; Procedure TestClassPropertyNonStaticAllow;
//Procedure TestClassPropertyStaticMismatchFail;
Procedure TestArrayProperty; Procedure TestArrayProperty;
Procedure TestArrayProperty_PassImplicitCallClassFunc;
Procedure TestProperty_WrongTypeAsIndexFail; Procedure TestProperty_WrongTypeAsIndexFail;
Procedure TestProperty_Option_ClassPropertyNonStatic; Procedure TestProperty_Option_ClassPropertyNonStatic;
Procedure TestDefaultProperty; Procedure TestDefaultProperty;
@ -12858,6 +12858,76 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolver.TestArrayProperty_PassImplicitCallClassFunc;
var
aMarker: PSrcMarker;
Elements: TFPList;
ActualImplicitCallWithoutParams, ExpectedImplicitCallWithoutParams: Boolean;
i: Integer;
El: TPasElement;
Ref: TResolvedReference;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' function GetItems(s: string): string;',
' property Items[s: string]: string read GetItems; default;',
' class function Desc: string; virtual; abstract;',
' end;',
'function TObject.GetItems(s: string): string;',
'begin',
' Result:=Items[{#a_implicit}Desc];',
' Result:=Items[{#b_direct}Desc()];',
' Result:=Items[Self.{#c_implicit}Desc];',
' Result:=Items[Self.{#d_direct}Desc()];',
'end;',
'var b: TObject;',
' s: string;',
'begin',
' s:=b.Items[b.{#m_implicit}Desc];',
' s:=b.Items[b.{#n_direct}Desc()];',
' s:=b.Items[TObject.{#o_implicit}Desc];',
' s:=b.Items[TObject.{#p_direct}Desc()];',
' s:=b[b.{#q_implicit}Desc];',
' s:=b[b.{#r_direct}Desc()];',
' s:=b[TObject.{#s_implicit}Desc];',
' s:=b[TObject.{#t_direct}Desc()];',
'']);
ParseProgram;
aMarker:=FirstSrcMarker;
while aMarker<>nil do
begin
//writeln('TTestResolver.TestArrayProperty_PassImplicitCallClassFunc ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
Elements:=FindElementsAt(aMarker);
try
ActualImplicitCallWithoutParams:=false;
Ref:=nil;
for i:=0 to Elements.Count-1 do
begin
El:=TPasElement(Elements[i]);
//writeln('TTestResolver.TestArrayProperty_PassImplicitCallClassFunc ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
if not (El.CustomData is TResolvedReference) then continue;
Ref:=TResolvedReference(El.CustomData);
if Ref.Declaration is TPasProcedure then
break
else
Ref:=nil;
end;
if Ref=nil then
RaiseErrorAtSrcMarker('missing proc ref at "#'+aMarker^.Identifier+'"',aMarker);
ActualImplicitCallWithoutParams:=rrfImplicitCallWithoutParams in Ref.Flags;
ExpectedImplicitCallWithoutParams:=RightStr(aMarker^.Identifier,length('_implicit'))='_implicit';
if ActualImplicitCallWithoutParams<>ExpectedImplicitCallWithoutParams then
RaiseErrorAtSrcMarker('wrong implicit call at "#'+aMarker^.Identifier
+', ExpectedImplicitCall='+BoolToStr(ExpectedImplicitCallWithoutParams,true)+'"',aMarker);
finally
Elements.Free;
end;
aMarker:=aMarker^.Next;
end;
end;
procedure TTestResolver.TestProperty_WrongTypeAsIndexFail; procedure TTestResolver.TestProperty_WrongTypeAsIndexFail;
begin begin
StartProgram(false); StartProgram(false);