Browse Source

fcl-passrc: check forward generic class constraints match

git-svn-id: trunk@42688 -
Mattias Gaertner 6 years ago
parent
commit
b4b6efc5a0

+ 2 - 0
packages/fcl-passrc/src/pasresolveeval.pas

@@ -195,6 +195,7 @@ const
   nXIsNotAValidConstraint = 3129;
   nWrongNumberOfParametersForGenericType = 3130;
   nGenericsWithoutSpecializationAsType = 3131;
+  nDeclOfXDiffersFromPrevAtY = 3132;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -337,6 +338,7 @@ resourcestring
   sXIsNotAValidConstraint = '"%s" is not a valid constraint';
   sWrongNumberOfParametersForGenericType = 'wrong number of parameters for generic type %s';
   sGenericsWithoutSpecializationAsType = 'Generics without specialization cannot be used as a type for a %s';
+  sDeclOfXDiffersFromPrevAtY = 'Declaration of "%s" differs from previous declaration at %s';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

+ 200 - 140
packages/fcl-passrc/src/pasresolver.pp

@@ -2205,6 +2205,7 @@ type
     function IsArrayOperatorAdd(Expr: TPasExpr): boolean;
     function IsTypeCast(Params: TParamsExpr): boolean;
     function GetTypeParameterCount(aType: TPasGenericType): integer;
+    function GetGenericConstraintKeyword(El: TPasExpr): TToken;
     function IsGenericTemplType(const ResolvedEl: TPasResolverResult): boolean;
     function IsInterfaceType(const ResolvedEl: TPasResolverResult;
       IntfType: TPasClassInterfaceType): boolean; overload;
@@ -6189,12 +6190,12 @@ procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
 var
   i: Integer;
   Expr: TPasExpr;
-  Value: String;
   IsClass, IsRecord, IsConstructor: Boolean;
   LastType: TPasType;
   ResolvedEl: TPasResolverResult;
   MemberType: TPasMembersType;
   aClass: TPasClassType;
+  ExprToken: TToken;
 begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.FinishGenericTemplateType ',GetObjName(El),' El.Parent=',GetObjName(El.Parent),' Constraints=',length(El.Constraints));
@@ -6206,106 +6207,103 @@ begin
   for i:=0 to length(El.Constraints)-1 do
     begin
     Expr:=El.Constraints[i];
-    if (Expr.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
-      begin
-      Value:=TPrimitiveExpr(Expr).Value;
-      if SameText(Value,'class') then
-        begin
-        if IsClass then
-          RaiseMsg(20190720202412,nConstraintXSpecifiedMoreThanOnce,
-            sConstraintXSpecifiedMoreThanOnce,['class'],Expr);
-        if IsRecord then
-          RaiseMsg(20190720202516,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,['record','class'],Expr);
-        if LastType<>nil then
-          RaiseMsg(20190720205708,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'class'],Expr);
-        IsClass:=true;
-        end
-      else if SameText(Value,'record') then
-        begin
-        if IsRecord then
-          RaiseMsg(20190720203028,nConstraintXSpecifiedMoreThanOnce,
-            sConstraintXSpecifiedMoreThanOnce,['record'],Expr);
-        if IsClass then
-          RaiseMsg(20190720203039,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,['class','record'],Expr);
-        if IsConstructor then
-          RaiseMsg(20190720203056,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,['constructor','record'],Expr);
-        if LastType<>nil then
-          RaiseMsg(20190720205938,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'record'],Expr);
-        IsRecord:=true;
-        end
-      else if SameText(Value,'constructor') then
-        begin
-        if IsConstructor then
-          RaiseMsg(20190720203123,nConstraintXSpecifiedMoreThanOnce,
-            sConstraintXSpecifiedMoreThanOnce,['constructor'],Expr);
-        if IsRecord then
-          RaiseMsg(20190720203148,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,['record','constructor'],Expr);
-        if LastType<>nil then
-          RaiseMsg(20190720210005,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'constructor'],Expr);
-        IsConstructor:=true;
-        end
-      else
+    ExprToken:=GetGenericConstraintKeyword(Expr);
+    case ExprToken of
+    tkclass:
+      begin
+      if IsClass then
+        RaiseMsg(20190720202412,nConstraintXSpecifiedMoreThanOnce,
+          sConstraintXSpecifiedMoreThanOnce,['class'],Expr);
+      if IsRecord then
+        RaiseMsg(20190720202516,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,['record','class'],Expr);
+      if LastType<>nil then
+        RaiseMsg(20190720205708,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'class'],Expr);
+      IsClass:=true;
+      end;
+    tkrecord:
+      begin
+      if IsRecord then
+        RaiseMsg(20190720203028,nConstraintXSpecifiedMoreThanOnce,
+          sConstraintXSpecifiedMoreThanOnce,['record'],Expr);
+      if IsClass then
+        RaiseMsg(20190720203039,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,['class','record'],Expr);
+      if IsConstructor then
+        RaiseMsg(20190720203056,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,['constructor','record'],Expr);
+      if LastType<>nil then
+        RaiseMsg(20190720205938,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'record'],Expr);
+      IsRecord:=true;
+      end;
+    tkconstructor:
+      begin
+      if IsConstructor then
+        RaiseMsg(20190720203123,nConstraintXSpecifiedMoreThanOnce,
+          sConstraintXSpecifiedMoreThanOnce,['constructor'],Expr);
+      if IsRecord then
+        RaiseMsg(20190720203148,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,['record','constructor'],Expr);
+      if LastType<>nil then
+        RaiseMsg(20190720210005,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'constructor'],Expr);
+      IsConstructor:=true;
+      end;
+    else
+      begin
+      // type identifier: class, record or interface
+      ResolveExpr(Expr,rraNone);
+      ComputeElement(Expr,ResolvedEl,[rcType]);
+      if (ResolvedEl.BaseType<>btContext)
+          or not (ResolvedEl.IdentEl is TPasMembersType) then
         begin
-        // type identifier: class, record or interface
-        ResolveNameExpr(Expr,Value,rraNone);
-        ComputeElement(Expr,ResolvedEl,[rcType]);
-        if (ResolvedEl.BaseType<>btContext)
-            or not (ResolvedEl.IdentEl is TPasMembersType) then
+        RaiseMsg(20190720204604,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
+          [GetResolverResultDescription(ResolvedEl)],Expr);
+        end;
+      MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
+      if IsRecord then
+        RaiseMsg(20190720210130,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,['record',MemberType.Name],Expr);
+      if IsClass then
+        RaiseMsg(20190720210202,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,['class',MemberType.Name],Expr);
+      if IsConstructor then
+        RaiseMsg(20190720210244,nConstraintXAndConstraintYCannotBeTogether,
+          sConstraintXAndConstraintYCannotBeTogether,['constructor',MemberType.Name],Expr);
+      if MemberType is TPasClassType then
+        begin
+        aClass:=TPasClassType(MemberType);
+        case aClass.ObjKind of
+        okClass:
           begin
-          RaiseMsg(20190720204604,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
-            [Value],Expr);
+          // there can be at most one classtype constraint
+          if LastType<>nil then
+            RaiseMsg(20190720210351,nConstraintXAndConstraintYCannotBeTogether,
+              sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
           end;
-        MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
-        if IsRecord then
-          RaiseMsg(20190720210130,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,['record',MemberType.Name],Expr);
-        if IsClass then
-          RaiseMsg(20190720210202,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,['class',MemberType.Name],Expr);
-        if IsConstructor then
-          RaiseMsg(20190720210244,nConstraintXAndConstraintYCannotBeTogether,
-            sConstraintXAndConstraintYCannotBeTogether,['constructor',MemberType.Name],Expr);
-        if MemberType is TPasClassType then
+        okInterface:
           begin
-          aClass:=TPasClassType(MemberType);
-          case aClass.ObjKind of
-          okClass:
-            begin
-            // there can be at most one classtype constraint
-            if LastType<>nil then
-              RaiseMsg(20190720210351,nConstraintXAndConstraintYCannotBeTogether,
-                sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
-            end;
-          okInterface:
-            begin
-            // there can be multiple interfacetype constraint
-            if not (LastType is TPasClassType) then
-              RaiseMsg(20190720211236,nConstraintXAndConstraintYCannotBeTogether,
-                sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
-            if TPasClassType(LastType).ObjKind<>okInterface then
-              RaiseMsg(20190720211304,nConstraintXAndConstraintYCannotBeTogether,
-                sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
-            end
-          else
-            RaiseMsg(20190720210919,nXIsNotAValidConstraint,
-              sXIsNotAValidConstraint,[MemberType.Name],Expr);
-          end;
+          // there can be multiple interfacetype constraint
+          if not (LastType is TPasClassType) then
+            RaiseMsg(20190720211236,nConstraintXAndConstraintYCannotBeTogether,
+              sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
+          if TPasClassType(LastType).ObjKind<>okInterface then
+            RaiseMsg(20190720211304,nConstraintXAndConstraintYCannotBeTogether,
+              sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
           end
         else
-          RaiseMsg(20190720210809,nXIsNotAValidConstraint,
+          RaiseMsg(20190720210919,nXIsNotAValidConstraint,
             sXIsNotAValidConstraint,[MemberType.Name],Expr);
-        LastType:=MemberType;
         end;
-      end
-    else
-      RaiseMsg(20190720203419,nParserSyntaxError,SParserSyntaxError,[],Expr);
+        end
+      else
+        RaiseMsg(20190720210809,nXIsNotAValidConstraint,
+          sXIsNotAValidConstraint,[MemberType.Name],Expr);
+      LastType:=MemberType;
+      end;
+    end;
     end;
 end;
 
@@ -11105,9 +11103,14 @@ var
   Duplicate: TPasIdentifier;
   ForwardDecl: TPasClassType;
   CurScope, LocalScope: TPasIdentifierScope;
-  GenTemplCnt: Integer;
+  GenTemplCnt, i, j: Integer;
   DuplEl: TPasElement;
   ClassScope: TPasClassScope;
+  ForwGenTempl, ActGenTempl: TPasGenericTemplateType;
+  ForwConstraints, ActConstraints: TPasExprArray;
+  ForwExpr, ActExpr: TPasExpr;
+  ForwToken, ActToken: TToken;
+  ForwConstraintResolved, ActConstraintResolved: TPasResolverResult;
 begin
   // Beware: El.ObjKind is not yet set!
   {$IFDEF VerbosePasResolver}
@@ -11149,6 +11152,42 @@ begin
     {$IFDEF VerbosePasResolver}
     writeln('  Resolving Forward=',GetObjName(ForwardDecl),' ',GetElementSourcePosStr(ForwardDecl));
     {$ENDIF}
+    if GenTemplCnt>0 then
+      begin
+      // check generic constraints match exactly
+      for i:=0 to GenTemplCnt-1 do
+        begin
+        ForwGenTempl:=TPasGenericTemplateType(ForwardDecl.GenericTemplateTypes[i]);
+        ActGenTempl:=TPasGenericTemplateType(TypeParams[i]);
+        if not SameText(ForwGenTempl.Name,ActGenTempl.Name) then
+          RaiseMsg(20190814114811,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
+            [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwGenTempl)],ActGenTempl);
+        ForwConstraints:=ForwGenTempl.Constraints;
+        ActConstraints:=ActGenTempl.Constraints;
+        if length(ForwConstraints)<>length(ActConstraints) then
+          RaiseMsg(20190814121031,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
+            [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwGenTempl)],ActGenTempl);
+        for j:=0 to length(ForwConstraints)-1 do
+          begin
+          ForwExpr:=ForwConstraints[j];
+          ActExpr:=ActConstraints[j];
+          ForwToken:=GetGenericConstraintKeyword(ForwExpr);
+          ActToken:=GetGenericConstraintKeyword(ActExpr);
+          if ForwToken<>ActToken then
+            RaiseMsg(20190814121139,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
+              [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwExpr)],ActExpr);
+          if ForwToken=tkEOF then
+            begin
+            ComputeElement(ForwExpr,ForwConstraintResolved,[rcType]);
+            ComputeElement(ActExpr,ActConstraintResolved,[rcType]);
+            if not CheckElTypeCompatibility(ForwConstraintResolved.LoTypeEl,ActConstraintResolved.LoTypeEl,prraNone) then
+              RaiseMsg(20190814121509,nDeclOfXDiffersFromPrevAtY,sDeclOfXDiffersFromPrevAtY,
+                [GetTypeDescription(ActGenTempl),GetElementSourcePosStr(ForwExpr)],ActExpr);
+            end;
+          end;
+        end;
+      end;
+
     if ForwardDecl.CustomData<>nil then
       begin
       // move the classscope to the real declaration
@@ -14473,8 +14512,15 @@ begin
     begin
     Item:=TPSSpecializedItem(SpecializedTypes[i]);
     j:=length(Item.Params)-1;
-    while (j>=0) and IsSameType(Item.Params[j],ParamsResolved[j],prraNone) do
+    while j>=0 do
+      begin
+      if not IsSameType(Item.Params[j],ParamsResolved[j],prraNone) then
+        begin
+        if not CheckElTypeCompatibility(Item.Params[j],ParamsResolved[j],prraNone) then
+          break;
+        end;
       dec(j);
+      end;
     if j<0 then
       break;
     Item:=nil;
@@ -14506,8 +14552,8 @@ var
   ResolvedEl, ResolvedConstraint: TPasResolverResult;
   GenTempl: TPasGenericTemplateType;
   ConExpr: TPasExpr;
-  Value: String;
   ConstraintClass: TPasClassType;
+  ConToken: TToken;
 begin
   Result:=false;
   Params:=El.Params;
@@ -14543,55 +14589,58 @@ begin
     for j:=0 to length(GenTempl.Constraints)-1 do
       begin
       ConExpr:=GenTempl.Constraints[j];
-      if (ConExpr.Kind=pekIdent) then
+      ConToken:=GetGenericConstraintKeyword(ConExpr);
+      case ConToken of
+      tkrecord:
         begin
-        Value:=TPrimitiveExpr(ConExpr).Value;
-        if SameText(Value,'record') then
-          begin
-          if not (ParamType is TPasRecordType) then
-            RaiseXExpectedButTypeYFound(20190725200015,'record type',ParamType,P);
-          continue;
-          end
-        else if SameText(Value,'class') or SameText(Value,'constructor') then
+        if not (ParamType is TPasRecordType) then
+          RaiseXExpectedButTypeYFound(20190725200015,'record type',ParamType,P);
+        continue;
+        end;
+      tkclass,tkconstructor:
+        begin
+        if not (ParamType is TPasClassType) then
+          RaiseXExpectedButTypeYFound(20190726133231,'class type',ParamType,P);
+        if TPasClassType(ParamType).ObjKind<>okClass then
+          RaiseXExpectedButTypeYFound(20190726133232,'class type',ParamType,P);
+        if TPasClassType(ParamType).IsExternal then
+          RaiseXExpectedButTypeYFound(20190726133233,'non external class type',ParamType,P);
+        if ConToken=tkconstructor then
           begin
-          if not (ParamType is TPasClassType) then
-            RaiseXExpectedButTypeYFound(20190726133231,'class type',ParamType,P);
-          if TPasClassType(ParamType).ObjKind<>okClass then
-            RaiseXExpectedButTypeYFound(20190726133232,'class type',ParamType,P);
-          if TPasClassType(ParamType).IsExternal then
-            RaiseXExpectedButTypeYFound(20190726133233,'non external class type',ParamType,P);
-          if SameText(Value,'constructor') then
-            begin
-            // check if ParamType has the default constructor
-            // ToDo
-            RaiseMsg(20190726133722,nXIsNotSupported,sXIsNotSupported,['constraint keyword construcor'],P);
-            end;
-          continue;
+          // check if ParamType has the default constructor
+          // ToDo
+          RaiseMsg(20190726133722,nXIsNotSupported,sXIsNotSupported,['constraint keyword construcor'],P);
           end;
+        continue;
         end;
-      // constraint can be a class type or interface type
-      // Param must be a class
-      ComputeElement(ConExpr,ResolvedConstraint,[rcType]);
-      if ResolvedConstraint.IdentEl=nil then
-        RaiseMsg(20190726134037,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],P);
-      if not (ResolvedConstraint.LoTypeEl is TPasClassType) then
-        RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],P);
-      ConstraintClass:=TPasClassType(ResolvedConstraint.LoTypeEl);
-      if not (ParamType is TPasClassType) then
-        RaiseIncompatibleType(20190726135859,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
-      case ConstraintClass.ObjKind of
-      okClass:
-        // Param must be a ConstraintClass
-        if CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible then
-          RaiseIncompatibleType(20190726135309,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
-      okInterface:
-        // ParamType must implement ConstraintClass
-        if GetClassImplementsIntf(TPasClassType(ParamType),ConstraintClass)=nil then
-          RaiseIncompatibleType(20190726135458,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
       else
-        RaiseIncompatibleType(20190726135310,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
-      end;
-      end;
+        begin
+        // constraint can be a class type or interface type
+        // Param must be a class
+        ComputeElement(ConExpr,ResolvedConstraint,[rcType]);
+        if ResolvedConstraint.IdentEl=nil then
+          RaiseMsg(20190726134037,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],P);
+        if not (ResolvedConstraint.LoTypeEl is TPasClassType) then
+          RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],P);
+        ConstraintClass:=TPasClassType(ResolvedConstraint.LoTypeEl);
+        if not (ParamType is TPasClassType) then
+          RaiseIncompatibleType(20190726135859,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
+        case ConstraintClass.ObjKind of
+        okClass:
+          // Param must be a ConstraintClass
+          if CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible then
+            RaiseIncompatibleType(20190726135309,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
+        okInterface:
+          // ParamType must implement ConstraintClass
+          if GetClassImplementsIntf(TPasClassType(ParamType),ConstraintClass)=nil then
+            RaiseIncompatibleType(20190726135458,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
+        else
+          RaiseIncompatibleType(20190726135310,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
+        end;
+        end;
+      end; // end case
+
+      end; // end for
     end;
 
   if Result then
@@ -25189,6 +25238,17 @@ begin
   Result:=aType.GenericTemplateTypes.Count;
 end;
 
+function TPasResolver.GetGenericConstraintKeyword(El: TPasExpr): TToken;
+begin
+  if (El=nil) or (El.Kind<>pekIdent) then exit(tkEOF);
+  case lowercase(TPrimitiveExpr(El).Value) of
+  'record': Result:=tkrecord;
+  'class': Result:=tkclass;
+  'constructor': Result:=tkconstructor;
+  else Result:=tkEOF;
+  end;
+end;
+
 function TPasResolver.IsInterfaceType(const ResolvedEl: TPasResolverResult;
   IntfType: TPasClassInterfaceType): boolean;
 begin

+ 1 - 0
packages/fcl-passrc/src/pparser.pp

@@ -6247,6 +6247,7 @@ begin
             // simple statement (function call)
             El:=TPasImplSimple(CreateElement(TPasImplSimple,'',CurBlock,SrcPos));
             TPasImplSimple(El).Expr:=Left;
+            Left.Parent:=El;
             Left:=nil;
             AddStatement(El);
             El:=nil;

+ 130 - 6
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -39,17 +39,18 @@ type
     procedure TestGen_RecordNestedSpecialized;
     procedure TestGen_Record_SpecializeSelfInsideFail;
     procedure TestGen_RecordAnoArray;
-    // ToDo: procedure TestGen_SpecializeArg_ArrayOf;  type TBird = specialize<array of word>
     // ToDo: unitname.specialize TBird<word>.specialize
 
     // generic class
     procedure TestGen_Class;
     procedure TestGen_ClassDelphi;
     procedure TestGen_ClassForward;
+    procedure TestGen_ClassForwardConstraints;
+    procedure TestGen_ClassForwardConstraintNameMismatchFail;
+    procedure TestGen_ClassForwardConstraintKeywordMismatchFail;
+    procedure TestGen_ClassForwardConstraintTypeMismatchFail;
     procedure TestGen_Class_Method;
     procedure TestGen_Class_SpecializeSelfInside;
-    // ToDo: generic class forward (constraints must be repeated)
-    // ToDo: generic class forward  constraints mismatch fail
     // ToDo: generic class overload <T> <S,T>
     procedure TestGen_Class_GenAncestor;
     procedure TestGen_Class_AncestorSelfFail;
@@ -59,6 +60,7 @@ type
     procedure TestGen_NestedType;
     // ToDo: procedure TestGen_NestedDottedType;
     procedure TestGen_Class_Enums_NotPropagating;
+    procedure TestGen_Class_List;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
@@ -165,7 +167,7 @@ begin
   'end;',
   'begin',
   '']);
-  CheckResolverException('"string" is not a valid constraint',
+  CheckResolverException('"String" is not a valid constraint',
     nXIsNotAValidConstraint);
 end;
 
@@ -242,7 +244,7 @@ begin
   '  generic TBird<T:TArr> = record v: T; end;',
   'begin',
   '']);
-  CheckResolverException('"TArr" is not a valid constraint',
+  CheckResolverException('"array of Word" is not a valid constraint',
     nXIsNotAValidConstraint);
 end;
 
@@ -348,8 +350,11 @@ begin
   '{$mode objfpc}',
   'type',
   '  generic TBird<T> = record v: T; end;',
-  'var b: specialize TBird<array of word>;',
+  'var',
+  '  a: specialize TBird<array of word>;',
+  '  b: specialize TBird<array of word>;',
   'begin',
+  '  a:=b;',
   '']);
   ParseProgram;
 end;
@@ -420,6 +425,86 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraints;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  generic TBird<T: class; U; V: TAnt> = class;',
+  '  TRec = record',
+  '    b: specialize TBird<TAnt,word,TAnt>;',
+  '  end;',
+  '  generic TBird<T: class; U; V: TAnt> = class',
+  '    i: U;',
+  '    r: TRec;',
+  '  end;',
+  'var',
+  '  s: TRec;',
+  '  w: word;',
+  'begin',
+  '  s.b.i:=w;',
+  '  s.b.r:=s;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraintNameMismatchFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class;',
+  '  generic TBird<U> = class',
+  '    i: U;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "U" differs from previous declaration at afile.pp(5,18)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
+procedure TTestResolveGenerics.
+  TestGen_ClassForwardConstraintKeywordMismatchFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T: class, constructor> = class;',
+  '  generic TBird<U: class> = class',
+  '    i: U;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "U" differs from previous declaration at afile.pp(5,18)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraintTypeMismatchFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  TFish = class end;',
+  '  generic TBird<T: TAnt> = class;',
+  '  generic TBird<T: TFish> = class',
+  '    i: U;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,20)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_Method;
 begin
   StartProgram(false);
@@ -544,6 +629,45 @@ begin
   CheckResolverException('identifier not found "red"',nIdentifierNotFound);
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_List;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TList<T> = class',
+  '  strict private',
+  '    FItems: array of T;',
+  '    function GetItems(Index: longint): T;',
+  '    procedure SetItems(Index: longint; Value: T);',
+  '  public',
+  '    procedure Alter(w: T);',
+  '    property Items[Index: longint]: T read GetItems write SetItems; default;',
+  '  end;',
+  '  TWordList = specialize TList<word>;',
+  'function TList.GetItems(Index: longint): T;',
+  'begin',
+  '  Result:=FItems[Index];',
+  'end;',
+  'procedure TList.SetItems(Index: longint; Value: T);',
+  'begin',
+  '  FItems[Index]:=Value;',
+  'end;',
+  'procedure TList.Alter(w: T);',
+  'begin',
+  '  SetLength(FItems,length(FItems)+1);',
+  '  Insert(w,FItems,2);',
+  '  Delete(FItems,2,3);',
+  'end;',
+  'var l: TWordList;',
+  '  w: word;',
+  'begin',
+  '  l[1]:=w;',
+  '  w:=l[2];']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);