fcl-passrc: check delphi generic class method implementation params

git-svn-id: trunk@42769 -

packages/fcl-passrc/src/pasresolver.pp

@@ -11552,8 +11552,8 @@ var
   CurScope: TPasScope;
   LocalScope: TPasScope;
   Level, TypeParamCount, i: Integer;
-  TypeParam: TProcedureNamePart;
-  TemplType: TPasGenericTemplateType;
+  NameParams: TProcedureNamePart;
+  TemplType, FoundTemplType: TPasGenericTemplateType;
 begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.AddProcedure ',GetObjName(El));
@@ -11674,21 +11674,23 @@ begin
           // e.g. aclassname<T>.
           if Level>TypeParams.Count then
             RaiseNotYetImplemented(20190818122217,El);
-          TypeParam:=TProcedureNamePart(TypeParams[Level-1]);
-          if TypeParam.Name<>aClassName then
-            RaiseNotYetImplemented(20190818102541,El,IntToStr(Level)+': '+TypeParam.Name+'<>'+aClassName);
-          if TypeParam.Templates<>nil then
+          NameParams:=TProcedureNamePart(TypeParams[Level-1]);
+          if NameParams.Name<>aClassName then
+            RaiseNotYetImplemented(20190818102541,El,IntToStr(Level)+': '+NameParams.Name+'<>'+aClassName);
+          if NameParams.Templates<>nil then
             begin
-            TypeParamCount:=TypeParam.Templates.Count;
+            TypeParamCount:=NameParams.Templates.Count;
             for i:=0 to TypeParamCount-1 do
               begin
-              TemplType:=TPasGenericTemplateType(TypeParam.Templates[i]);
+              TemplType:=TPasGenericTemplateType(NameParams.Templates[i]);
               if length(TemplType.Constraints)>0 then
                 RaiseMsg(20190818102850,nXCannotHaveParameters,sXCannotHaveParameters,
                   [TemplType.Name],TemplType.Constraints[0]);
               end;
             end;
-          end;
+          end
+        else
+          NameParams:=nil;
         {$IFDEF VerbosePasResolver}
         writeln('TPasResolver.AddProcedure searching class "',aClassName,GetTypeParamCommas(TypeParamCount),'" ProcName="',ProcName,'" ...');
         {$ENDIF}
@@ -11717,6 +11719,18 @@ begin
           end;
         if ClassOrRecType.GetModule<>El.GetModule then
           RaiseNotYetImplemented(20190818120051,El);
+        if NameParams<>nil then
+          begin
+          for i:=0 to TypeParamCount-1 do
+            begin
+            TemplType:=TPasGenericTemplateType(NameParams.Templates[i]);
+            FoundTemplType:=TPasGenericTemplateType(ClassOrRecType.GenericTemplateTypes[i]);
+            if not SameText(TemplType.Name,FoundTemplType.Name) then
+              RaiseMsg(20190822014652,nXExpectedButYFound,
+                sXExpectedButYFound,[FoundTemplType.Name,TemplType.Name],TemplType);
+            end;
+          end;
+
       until false;
 
       if not IsValidIdent(ProcName) then
@@ -11729,10 +11743,10 @@ begin
         begin
         if Level<>TypeParams.Count then
           RaiseNotYetImplemented(20190818122315,El);
-        TypeParam:=TProcedureNamePart(TypeParams[Level-1]);
-        if TypeParam.Name<>ProcName then
-          RaiseNotYetImplemented(20190818122551,El,IntToStr(Level)+': '+TypeParam.Name+'<>'+ProcName);
-        if TypeParam.Templates<>nil then
+        NameParams:=TProcedureNamePart(TypeParams[Level-1]);
+        if NameParams.Name<>ProcName then
+          RaiseNotYetImplemented(20190818122551,El,IntToStr(Level)+': '+NameParams.Name+'<>'+ProcName);
+        if NameParams.Templates<>nil then
           begin
           // ToDo: generic method
           RaiseNotYetImplemented(20190818122619,El);

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -2516,6 +2516,7 @@ var
   i: Integer;
   Decl: TPasElement;
   Usage: TPAElement;
+  GenScope: TPasGenericScope;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitDeclarationsHints ',GetElModName(El));
@@ -2537,6 +2538,12 @@ begin
       if Usage=nil then
         begin
         // declaration was never used
+        if Decl is TPasGenericType then
+          begin
+          GenScope:=Decl.CustomData as TPasGenericScope;
+          if GenScope.SpecializedItem<>nil then
+            continue;
+          end;
         EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
           sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
         end;
@@ -2551,6 +2558,7 @@ var
   i: Integer;
   Member: TPasElement;
   Members: TFPList;
+  GenScope: TPasGenericScope;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
@@ -2566,6 +2574,12 @@ begin
       begin
       if (El is TPasClassType) and (TPasClassType(El).ObjKind=okInterface) then
         exit;
+      if El is TPasGenericType then
+        begin
+        GenScope:=El.CustomData as TPasGenericScope;
+        if GenScope.SpecializedItem<>nil then
+          exit;
+        end;
 
       EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
         sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -59,8 +59,9 @@ type
     procedure TestGen_Class_Method;
     procedure TestGen_Class_MethodOverride;
     procedure TestGen_Class_MethodDelphi;
-    // ToDo: procedure TestGen_Class_MethodDelphiTypeParamMissing;
-    // ToDo: procedure TestGen_Class_MethodImplConstraintFail;
+    procedure TestGen_Class_MethodDelphiTypeParamMissing;
+    procedure TestGen_Class_MethodImplConstraintFail;
+    procedure TestGen_Class_MethodImplTypeParamNameMismatch;
     procedure TestGen_Class_SpecializeSelfInside;
     procedure TestGen_Class_GenAncestor;
     procedure TestGen_Class_AncestorSelfFail;
@@ -721,6 +722,60 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_MethodDelphiTypeParamMissing;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T> = class',
+  '    function Run(p:T): T;',
+  '  end;',
+  'function TBird.Run(p:T): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('TBird<> expected, but TBird found',nXExpectedButYFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_MethodImplConstraintFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T: record> = class',
+  '    function Run(p:T): T;',
+  '  end;',
+  'function TBird<T: record>.Run(p:T): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('T cannot have parameters',nXCannotHaveParameters);
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_MethodImplTypeParamNameMismatch;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T> = class',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure TBird<S>.DoIt;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('T expected, but S found',nXExpectedButYFound);
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_SpecializeSelfInside;
 begin
   StartProgram(false);