fcl-passrc: fixed implicit call of specialized method

git-svn-id: trunk@47880 -

packages/fcl-passrc/src/pasresolver.pp

@@ -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)

packages/pastojs/tests/tcgenerics.pas

@@ -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;