paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 21:40:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed implicit call of specialized method

Browse Source 
git-svn-id: trunk@47880 -
This commit is contained in:
Mattias Gaertner 2020-12-29 01:16:22 +00:00
parent 1f4868caa8
commit db0fe18de5
2 changed files with 51 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -10176,7 +10176,6 @@ begin
if ParentParams.InlineSpec<>nil then
begin
TypeCnt:=InlParams.Count;
// ToDo: generic functions without params
DeclEl:=FindGenericEl(aName,TypeCnt,FindData,El);
if DeclEl<>nil then
begin
@ -10767,7 +10766,7 @@ begin
else if Value.ClassType=TInlineSpecializeExpr then
begin
// e.g. Name<>()
ResolveInlineSpecializeExpr(TInlineSpecializeExpr(Value),rraRead);
ResolveInlineSpecializeExpr(TInlineSpecializeExpr(Value),Access);
end
else if Value.ClassType=TParamsExpr then
begin
@ -27380,7 +27379,7 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
end
else if ParentNeedsExprResult(Expr) then
begin
// a procedure
// a procedure address
exit;
end;
if rcSetReferenceFlags in Flags then
@ -28245,6 +28244,8 @@ begin
else
Result:=true;
end
else if C=TInlineSpecializeExpr then
Result:=ParentNeedsExprResult(TInlineSpecializeExpr(P))
else if C.InheritsFrom(TPasExpr) then
Result:=true
else if (C=TPasEnumValue)

50
packages/pastojs/tests/tcgenerics.pas
View File

@ -77,7 +77,8 @@ type
// ToDo: FuncName:= instead of Result:=
// generic methods
procedure TestGenMethod_ObjFPC;
procedure TestGenMethod_ImplicitSpec_ObjFPC;
procedure TestGenMethod_Delphi;
// generic array
procedure TestGen_Array_OtherUnit;
@ -2135,7 +2136,7 @@ begin
'']));
end;
procedure TTestGenerics.TestGenMethod_ObjFPC;
procedure TTestGenerics.TestGenMethod_ImplicitSpec_ObjFPC;
begin
StartProgram(false);
Add([
@ -2166,7 +2167,7 @@ begin
' o.{@C}Run(''foo'',''bar'');',
'']);
ConvertProgram;
CheckSource('TestGenMethod_ObjFPC',
CheckSource('TestGenMethod_ImplicitSpec_ObjFPC',
LinesToStr([ // statements
'rtl.createClass(this, "TObject", null, function () {',
' this.$init = function () {',
@ -2192,6 +2193,49 @@ begin
'']));
end;
procedure TTestGenerics.TestGenMethod_Delphi;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'type',
' TObject = class',
' procedure Run<S>;',
' end; ',
'procedure TObject.Run<S>;',
'begin',
'end;',
'var o: TObject;',
'begin',
' o.Run<word>;',
' o.Run<word>();',
' with o do begin',
' Run<word>;',
' Run<word>();',
' end;',
'']);
ConvertProgram;
CheckSource('TestGenMethod_Delphi',
LinesToStr([ // statements
'rtl.createClass(this, "TObject", null, function () {',
' this.$init = function () {',
' };',
' this.$final = function () {',
' };',
' this.Run$G1 = function () {',
' };',
'});',
'this.o = null;',
'']),
LinesToStr([ // $mod.$main
'$mod.o.Run$G1();',
'$mod.o.Run$G1();',
'var $with = $mod.o;',
'$with.Run$G1();',
'$with.Run$G1();',
'']));
end;
procedure TTestGenerics.TestGen_Array_OtherUnit;
begin
WithTypeInfo:=true;