fcl-passrc: check generic constraint T:T

git-svn-id: trunk@46517 -

packages/fcl-passrc/src/pasresolver.pp

@@ -6595,6 +6595,9 @@ begin
 
       if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
         begin
+        if ResolvedEl.LoTypeEl=El then
+          RaiseMsg(20200820185313,nTypeCycleFound,sTypeCycleFound,[],
+                      GetGenericConstraintErrorEl(ConEl,El));
         // ok
         if length(El.Constraints)>1 then
           RaiseXIsNotAValidConstraint(20190831213645,ResolvedEl.HiTypeEl.Name);

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -34,6 +34,8 @@ type
     procedure TestGen_ConstraintSpecialize;
     procedure TestGen_ConstraintTSpecializeWithT;
     procedure TestGen_ConstraintTSpecializeAsTFail;
+    procedure TestGen_ConstraintTcolonTFail; // A<T:T>
+    // ToDo: A<T:B<T>> fail
     procedure TestGen_TemplNameEqTypeNameFail;
     procedure TestGen_ConstraintInheritedMissingRecordFail;
     procedure TestGen_ConstraintInheritedMissingClassTypeFail;
@@ -42,8 +44,6 @@ type
     procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
     procedure TestGen_ConstraintClassType_ForInT;
     procedure TestGen_ConstraintClassType_IsAs;
-    // ToDo: A<T:T> fail
-    // ToDo: A<T:B<T>> fail
 
     // generic record
     procedure TestGen_RecordLocalNameDuplicateFail;
@@ -429,6 +429,20 @@ begin
   CheckResolverException('identifier not found "T<>"',nIdentifierNotFound);
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintTcolonTFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  T = TObject;',
+  '  generic TAnt<T:T> = record v: word; end;',
+  'begin',
+  '']);
+  CheckResolverException(sTypeCycleFound,nTypeCycleFound);
+end;
+
 procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
 begin
   StartProgram(false);