fcl-passrc: fixed generic proc overload

git-svn-id: trunk@43077 -

packages/fcl-passrc/src/pasresolver.pp

@@ -9812,6 +9812,7 @@ begin
     InlParams:=ParentParams.InlineSpec.Params
   else
     InlParams:=nil;
+  //writeln('TPasResolver.ResolveNameExpr Inline=',GetObjName(ParentParams.InlineSpec),' Params=',GetObjName(ParentParams.Params),' ',GetObjPath(El));
   if ParentParams.Params<>nil then
     begin
     case ParentParams.Params.Kind of
@@ -9830,11 +9831,10 @@ begin
     TypeCnt:=InlParams.Count;
     // ToDo: generic functions without params
     DeclEl:=FindGenericEl(aName,TypeCnt,FindData,El);
-    if DeclEl is TPasGenericType then
+    if DeclEl<>nil then
       begin
-      // GenType<params> -> create specialize type
-      DeclEl:=GetSpecializedEl(ParentParams.InlineSpec,TPasGenericType(DeclEl),
-                                 InlParams);
+      // GenType<params> -> create specialize type/proc
+      DeclEl:=GetSpecializedEl(ParentParams.InlineSpec,DeclEl,InlParams);
       end
     else
       RaiseXExpectedButYFound(20190916160829,'generic type',GetElementTypeName(DeclEl),El);
@@ -10473,6 +10473,9 @@ var
   GenTemplates: TFPList;
 begin
   // e.g. Name() -> find compatible
+  {$IFDEF VerbosePasResolver}
+  //writeln('TPasResolver.ResolveFuncParamsExprName NameExpr=',GetObjName(NameExpr),' TemplParams=',TemplParams<>nil,' CallName="',CallName,'"');
+  {$ENDIF}
   if CallName<>'' then
   else if NameExpr.ClassType=TPrimitiveExpr then
     CallName:=TPrimitiveExpr(NameExpr).Value

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -129,17 +129,20 @@ type
     procedure TestGenProc_BackRef1Fail;
     procedure TestGenProc_BackRef2Fail;
     procedure TestGenProc_BackRef3Fail;
-    //procedure TestGenProc_Inference;
     procedure TestGenProc_CallSelf;
+    // ToDo procedure TestGenProc_CallSelfNoParams;
     procedure TestGenProc_ForwardConstraints;
     procedure TestGenProc_ForwardConstraintsRepeatFail;
     procedure TestGenProc_ForwardTempNameMismatch;
     procedure TestGenProc_ForwardOverload;
     procedure TestGenProc_NestedFail;
+    procedure TestGenProc_TypeParamCntOverload;
+    procedure TestGenProc_TypeParamCntOverloadNoParams;
+    //procedure TestGenProc_Inference;
+
+    // generic methods
     procedure TestGenMethod_VirtualFail;
-    // ToDo: virtual method cannot have type parameters
-    // ToDo: message method cannot have type parameters
-    // ToDo: class interface method cannot have type parameters
+    procedure TestGenMethod_ClassInterfaceMethodFail;
     // ToDo: parametrized method mismatch interface method
     // ToDo: generic class method overload <T> <S,T>
     // ToDo: generic class method overload <T>(bool) <T>(word)
@@ -1970,6 +1973,48 @@ begin
   CheckResolverException('Type parameters not allowed on nested procedure',nTypeParamsNotAllowedOnX);
 end;
 
+procedure TTestResolveGenerics.TestGenProc_TypeParamCntOverload;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure {#A}Run<T>(a: T);',
+  'begin',
+  'end;',
+  'generic procedure {#B}Run<M,N>(a: M);',
+  'begin',
+  '  specialize {@A}Run<M>(a);',
+  '  specialize {@B}Run<double,char>(1.3);',
+  'end;',
+  'begin',
+  '  specialize {@A}Run<word>(3);',
+  '  specialize {@B}Run<word,char>(4);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_TypeParamCntOverloadNoParams;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure {#A}Run<T>;',
+  'begin',
+  'end;',
+  'generic procedure {#B}Run<M,N>;',
+  'begin',
+  '  specialize {@A}Run<M>;',
+  '  specialize {@A}Run<M>();',
+  '  specialize {@B}Run<double,char>;',
+  '  specialize {@B}Run<double,char>();',
+  'end;',
+  'begin',
+  '  specialize {@A}Run<word>;',
+  '  specialize {@A}Run<word>();',
+  '  specialize {@B}Run<word,char>;',
+  '  specialize {@B}Run<word,char>();',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
 begin
   StartProgram(false);
@@ -1984,6 +2029,19 @@ begin
     nXMethodsCannotHaveTypeParams);
 end;
 
+procedure TTestResolveGenerics.TestGenMethod_ClassInterfaceMethodFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  IUnknown = interface',
+  '    generic procedure Run<T>(a: T); virtual; abstract;',
+  '  end;',
+  'begin',
+  '']);
+  CheckParserException('generic is not allowed in interface',nParserXNotAllowedInY);
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);