fcl-passrc: specialize class interface

git-svn-id: trunk@42714 -

packages/fcl-passrc/src/pasresolveeval.pas

@@ -196,6 +196,9 @@ const
   nWrongNumberOfParametersForGenericType = 3130;
   nGenericsWithoutSpecializationAsType = 3131;
   nDeclOfXDiffersFromPrevAtY = 3132;
+  nTypeParamXIsMissingConstraintY = 3133;
+  nTypeParamXIsNotCompatibleWithY = 3134;
+  nTypeParamXMustSupportIntfY = 3135;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -339,6 +342,9 @@ resourcestring
   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';
+  sTypeParamXIsMissingConstraintY = 'Type parameter "%s" is missing constraint "%s"';
+  sTypeParamXIsNotCompatibleWithY = 'Type parameter "%s" is not compatible with type "%s"';
+  sTypeParamXMustSupportIntfY = 'Type parameter "%s" must support interface "%s"';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pasresolver.pp

@@ -1726,7 +1726,7 @@ type
     procedure AddGenericTemplateIdentifiers(GenericTemplateTypes: TFPList;
       Scope: TPasIdentifierScope);
     procedure AddSpecializedTemplateIdentifiers(GenericTemplateTypes: TFPList;
-      SpecializedTypes: TPasTypeArray; Scope: TPasIdentifierScope);
+      ParamTypes: TPasTypeArray; Scope: TPasIdentifierScope);
     function GetSpecializedType(El: TPasSpecializeType): TPasGenericType;
     function CheckSpecializeConstraints(El : TPasSpecializeType): boolean; virtual; // false = not fully specialized
     function CreateSpecializedType(El: TPasSpecializeType;
@@ -14486,16 +14486,16 @@ begin
 end;
 
 procedure TPasResolver.AddSpecializedTemplateIdentifiers(
-  GenericTemplateTypes: TFPList; SpecializedTypes: TPasTypeArray;
+  GenericTemplateTypes: TFPList; ParamTypes: TPasTypeArray;
   Scope: TPasIdentifierScope);
 var
   i: Integer;
   TemplType: TPasGenericTemplateType;
 begin
-  for i:=0 to length(SpecializedTypes)-1 do
+  for i:=0 to length(ParamTypes)-1 do
     begin
     TemplType:=TPasGenericTemplateType(GenericTemplateTypes[i]);
-    AddIdentifier(Scope,TemplType.Name,SpecializedTypes[i],pikSimple);
+    AddIdentifier(Scope,TemplType.Name,ParamTypes[i],pikSimple);
     end;
 end;
 
@@ -14534,8 +14534,8 @@ begin
 
   if not CheckSpecializeConstraints(El) then
     begin
-    // not fully specialized -> use generic type
-    // e.g. the TAnc<T> in "type TGen<T> = class(TAnc<T>)"
+    // El is actually the GenericType
+    // e.g. "type A<T> = class v: A<T> end;"
     exit(GenericType);
     end;
 
@@ -14591,48 +14591,94 @@ end;
 
 function TPasResolver.CheckSpecializeConstraints(El: TPasSpecializeType
   ): boolean;
-var
-  Params, GenericTemplateList: TFPList;
-  i, j: Integer;
-  P, ParentEl: TPasElement;
-  ParamType, DestType: TPasType;
-  ResolvedEl, ResolvedConstraint: TPasResolverResult;
-  GenTempl: TPasGenericTemplateType;
-  ConExpr: TPasExpr;
-  ConstraintClass: TPasClassType;
-  ConToken: TToken;
-begin
-  Result:=false;
-  Params:=El.Params;
-  DestType:=El.DestType;
-  if not (DestType is TPasGenericType) then
-    RaiseMsg(20190726193025,nXExpectedButYFound,sXExpectedButYFound,['generic type',DestType.Name],El);
-  GenericTemplateList:=TPasGenericType(DestType).GenericTemplateTypes;
-  if GenericTemplateList=nil then
-    RaiseMsg(20190726193048,nXExpectedButYFound,sXExpectedButYFound,['generic templates',DestType.Name],El);
-  if GenericTemplateList.Count<>Params.Count then
-    RaiseMsg(20190726193107,nXExpectedButYFound,sXExpectedButYFound,['type with '+IntToStr(Params.Count)+' generic templates',DestType.Name],El);
 
-  // check constraints
-  Result:=true;
-  for i:=0 to Params.Count-1 do
-    begin
-    P:=TPasElement(Params[i]);
-    ComputeElement(P,ResolvedEl,[rcType]);
-    if not (ResolvedEl.IdentEl is TPasType) then
-      RaiseMsg(20190725195434,nXExpectedButYFound,sXExpectedButYFound,['type',GetResolverResultDescription(ResolvedEl)],P);
-    ParamType:=TPasType(ResolvedEl.IdentEl);
-    if ParamType is TPasGenericTemplateType then
+  procedure CheckTemplateFitsTemplate(ParamTemplType,
+    GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
+  var
+    ParamConstraints: TPasExprArray;
+    j, k: Integer;
+    ConExpr, ParamConstraintExpr: TPasExpr;
+    ConToken: TToken;
+    ResolvedConstraint, ResolvedParamCon: TPasResolverResult;
+    ConstraintClass, ParamClassType: TPasClassType;
+  begin
+    // specialize via template type (not fully specialized)
+    ParamConstraints:=ParamTemplType.Constraints;
+    for j:=0 to length(GenTempl.Constraints)-1 do
       begin
-      // not fully specialized
-      {$IFDEF VerbosePasResolver}
-      writeln('TPasResolver.CheckSpecializeConstraints ',GetObjName(El),' i=',i,' P=',GetObjName(P),' ParamType=',GetObjName(ParamType));
-      {$ENDIF}
-      Result:=false;
-      // ToDo: check if both constraints fit
-      continue;
+      ConExpr:=GenTempl.Constraints[j];
+      ConToken:=GetGenericConstraintKeyword(ConExpr);
+      if ConToken<>tkEOF then
+        begin
+        // constraint is keyword
+        // -> check if keyword is in ParamConstraints
+        k:=length(ParamConstraints)-1;
+        while (k>=0) and (GetGenericConstraintKeyword(ParamConstraints[k])<>ConToken) do
+          dec(k);
+        if k<0 then
+          RaiseMsg(20190816230021,nTypeParamXIsMissingConstraintY,
+            sTypeParamXIsMissingConstraintY,[ParamTemplType.Name,TokenInfos[ConToken]],ErrorPos);
+        end
+      else
+        begin
+        // constraint is identifier
+        ComputeElement(ConExpr,ResolvedConstraint,[rcType]);
+        if ResolvedConstraint.IdentEl=nil then
+          RaiseMsg(20190816231846,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],ConExpr);
+        if not (ResolvedConstraint.LoTypeEl is TPasClassType) then
+          RaiseMsg(20190816231849,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],ConExpr);
+        ConstraintClass:=TPasClassType(ResolvedConstraint.LoTypeEl);
+        // constraint is class/interface type
+        // -> check if one of ParamConstraints fits the constraint type
+        // i.e. ParamConstraints must be more strict than target constraints
+        k:=length(ParamConstraints)-1;
+        while k>=0 do
+          begin
+          ParamConstraintExpr:=ParamConstraints[k];
+          ConToken:=GetGenericConstraintKeyword(ParamConstraintExpr);
+          if ConToken=tkEOF then
+            begin
+            ComputeElement(ParamConstraintExpr,ResolvedParamCon,[rcType]);
+            if not (ResolvedParamCon.IdentEl is TPasClassType) then
+              RaiseMsg(20190816232459,nXExpectedButYFound,sXExpectedButYFound,['type',GetResolverResultDescription(ResolvedParamCon)],ParamConstraintExpr);
+            ParamClassType:=TPasClassType(ResolvedParamCon.IdentEl);
+            if (ConstraintClass.ObjKind=okInterface)
+                and (ParamClassType.ObjKind=okClass) then
+              begin
+              if GetClassImplementsIntf(ParamClassType,ConstraintClass)<>nil then
+                break;
+              end
+            else
+              begin
+              if CheckClassIsClass(ParamClassType,ConstraintClass)<cIncompatible then
+                break;
+              end;
+            end;
+          dec(k);
+          end;
+        if k<0 then
+          begin
+          if ConstraintClass.ObjKind=okInterface then
+            RaiseMsg(20190816233102,nTypeParamXMustSupportIntfY,
+              sTypeParamXMustSupportIntfY,[ParamTemplType.Name,GetTypeDescription(ConstraintClass)],ErrorPos)
+          else
+            RaiseMsg(20190816230021,nTypeParamXIsNotCompatibleWithY,
+              sTypeParamXIsNotCompatibleWithY,[ParamTemplType.Name,GetTypeDescription(ConstraintClass)],ErrorPos);
+          end;
+        end;
       end;
-    GenTempl:=TPasGenericTemplateType(GenericTemplateList[i]);
+  end;
+
+  procedure CheckTypeFitsTemplate(ParamType: TPasType;
+    GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
+  var
+    j: Integer;
+    ConExpr: TPasExpr;
+    ConToken: TToken;
+    ResolvedConstraint: TPasResolverResult;
+    ConstraintClass: TPasClassType;
+  begin
+    // check if the specialized ParamType fits the constraints
     for j:=0 to length(GenTempl.Constraints)-1 do
       begin
       ConExpr:=GenTempl.Constraints[j];
@@ -14641,22 +14687,22 @@ begin
       tkrecord:
         begin
         if not (ParamType is TPasRecordType) then
-          RaiseXExpectedButTypeYFound(20190725200015,'record type',ParamType,P);
+          RaiseXExpectedButTypeYFound(20190725200015,'record type',ParamType,ErrorPos);
         continue;
         end;
       tkclass,tkconstructor:
         begin
         if not (ParamType is TPasClassType) then
-          RaiseXExpectedButTypeYFound(20190726133231,'class type',ParamType,P);
+          RaiseXExpectedButTypeYFound(20190726133231,'class type',ParamType,ErrorPos);
         if TPasClassType(ParamType).ObjKind<>okClass then
-          RaiseXExpectedButTypeYFound(20190726133232,'class type',ParamType,P);
+          RaiseXExpectedButTypeYFound(20190726133232,'class type',ParamType,ErrorPos);
         if TPasClassType(ParamType).IsExternal then
-          RaiseXExpectedButTypeYFound(20190726133233,'non external class type',ParamType,P);
+          RaiseXExpectedButTypeYFound(20190726133233,'non external class type',ParamType,ErrorPos);
         if ConToken=tkconstructor then
           begin
           // check if ParamType has the default constructor
           // ToDo
-          RaiseMsg(20190726133722,nXIsNotSupported,sXIsNotSupported,['constraint keyword construcor'],P);
+          RaiseMsg(20190726133722,nXIsNotSupported,sXIsNotSupported,['constraint keyword construcor'],ConExpr);
           end;
         continue;
         end;
@@ -14666,45 +14712,77 @@ begin
         // Param must be a class
         ComputeElement(ConExpr,ResolvedConstraint,[rcType]);
         if ResolvedConstraint.IdentEl=nil then
-          RaiseMsg(20190726134037,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],P);
+          RaiseMsg(20190726134037,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],ConExpr);
         if not (ResolvedConstraint.LoTypeEl is TPasClassType) then
-          RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],P);
+          RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],ConExpr);
         ConstraintClass:=TPasClassType(ResolvedConstraint.LoTypeEl);
         if not (ParamType is TPasClassType) then
-          RaiseIncompatibleType(20190726135859,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
+          RaiseIncompatibleType(20190726135859,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,ErrorPos);
         case ConstraintClass.ObjKind of
         okClass:
           // Param must be a ConstraintClass
           if CheckClassIsClass(ParamType,ConstraintClass)=cIncompatible then
-            RaiseIncompatibleType(20190726135309,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
+            RaiseIncompatibleType(20190726135309,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,ErrorPos);
         okInterface:
           // ParamType must implement ConstraintClass
           if GetClassImplementsIntf(TPasClassType(ParamType),ConstraintClass)=nil then
-            RaiseIncompatibleType(20190726135458,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
+            RaiseIncompatibleType(20190726135458,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,ErrorPos);
         else
-          RaiseIncompatibleType(20190726135310,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,P);
+          RaiseIncompatibleType(20190726135310,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,ErrorPos);
         end;
         end;
-      end; // end case
+      end;// case-end
+      end;// for-end
+  end;
 
-      end; // end for
-    end;
+var
+  Params, GenericTemplateList: TFPList;
+  i: Integer;
+  P, ErrorPos: TPasElement;
+  ParamType, DestType: TPasType;
+  ResolvedEl: TPasResolverResult;
+  GenTempl: TPasGenericTemplateType;
+begin
+  Result:=false;
+  Params:=El.Params;
+  DestType:=El.DestType;
+  if not (DestType is TPasGenericType) then
+    RaiseMsg(20190726193025,nXExpectedButYFound,sXExpectedButYFound,['generic type',DestType.Name],El);
+  GenericTemplateList:=TPasGenericType(DestType).GenericTemplateTypes;
+  if GenericTemplateList=nil then
+    RaiseMsg(20190726193048,nXExpectedButYFound,sXExpectedButYFound,['generic templates',DestType.Name],El);
+  if GenericTemplateList.Count<>Params.Count then
+    RaiseMsg(20190726193107,nXExpectedButYFound,sXExpectedButYFound,['type with '+IntToStr(Params.Count)+' generic templates',DestType.Name],El);
 
-  if Result then
+  // check constraints
+  for i:=0 to Params.Count-1 do
     begin
-    // check ParentEl types are specialized
-    ParentEl:=DestType.Parent;
-    while ParentEl<>nil do
+    GenTempl:=TPasGenericTemplateType(GenericTemplateList[i]);
+    P:=TPasElement(Params[i]);
+    if P.Parent=El then
+      ErrorPos:=P
+    else
+      ErrorPos:=El;
+    // check if P fits into GenTempl
+    ComputeElement(P,ResolvedEl,[rcType]);
+    if not (ResolvedEl.IdentEl is TPasType) then
+      RaiseMsg(20190725195434,nXExpectedButYFound,sXExpectedButYFound,['type',GetResolverResultDescription(ResolvedEl)],P);
+    ParamType:=ResolvedEl.LoTypeEl;
+    if ParamType=GenTempl then
+      // circle
+      // e.g. type A<S,T> = class
+      //          v: A<S,T>; // circle, do not specialize
+      //          u: A<S,word>; // specialize
+      //        end;
+    else if ParamType is TPasGenericTemplateType then
+      begin
+      CheckTemplateFitsTemplate(TPasGenericTemplateType(ParamType),GenTempl,ErrorPos);
+      Result:=true;
+      end
+    else
       begin
-      if (ParentEl is TPasGenericType)
-          and (GetTypeParameterCount(TPasGenericType(ParentEl))>0) then
-        begin
-        {$IFDEF VerbosePasResolver}
-        //writeln('TPasResolver.CheckSpecializeConstraints El=',GetObjName(El),' not specialized Parent=',GetObjName(ParentEl));
-        {$ENDIF}
-        exit(false); // parent is not specialized
-        end;
-      ParentEl:=ParentEl.Parent;
+      CheckTypeFitsTemplate(ParamType,GenTempl,ErrorPos);
+      Result:=true;
       end;
     end;
 end;

packages/fcl-passrc/src/pparser.pp

@@ -3750,7 +3750,7 @@ function TPasParser.AddUseUnit(ASection: TPasSection;
   const NamePos: TPasSourcePos; AUnitName: string; NameExpr: TPasExpr;
   InFileExpr: TPrimitiveExpr): TPasUsesUnit;
 
-  procedure CheckDuplicateInUsesList(AUnitName : string; UsesClause: TPasUsesClause);
+  procedure CheckDuplicateInUsesList(UsesClause: TPasUsesClause);
   var
     i: Integer;
   begin
@@ -3760,6 +3760,16 @@ function TPasParser.AddUseUnit(ASection: TPasSection;
         ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
   end;
 
+  procedure CheckDuplicateInUsesList(UnitRef: TPasElement; UsesClause: TPasUsesClause);
+  var
+    i: Integer;
+  begin
+    if UsesClause=nil then exit;
+    for i:=0 to length(UsesClause)-1 do
+      if UsesClause[i].Module=UnitRef then
+        ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
+  end;
+
 var
   UnitRef: TPasElement;
   UsesUnit: TPasUsesUnit;
@@ -3777,16 +3787,23 @@ begin
         exit; // for compatibility ignore implicit use of system in system
       ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
       end;
-    CheckDuplicateInUsesList(AUnitName,ASection.UsesClause);
-    if ASection.ClassType=TImplementationSection then
-      CheckDuplicateInUsesList(AUnitName,CurModule.InterfaceSection.UsesClause);
 
     UnitRef := Engine.FindModule(AUnitName,NameExpr,InFileExpr);
     if Assigned(UnitRef) then
-      UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF}
+      begin
+      UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF};
+      CheckDuplicateInUsesList(UnitRef,ASection.UsesClause);
+      if ASection.ClassType=TImplementationSection then
+        CheckDuplicateInUsesList(UnitRef,CurModule.InterfaceSection.UsesClause);
+      end
     else
+      begin
+      CheckDuplicateInUsesList(ASection.UsesClause);
+      if ASection.ClassType=TImplementationSection then
+        CheckDuplicateInUsesList(CurModule.InterfaceSection.UsesClause);
       UnitRef := TPasUnresolvedUnitRef(CreateElement(TPasUnresolvedUnitRef,
         AUnitName, ASection, NamePos));
+      end;
 
     UsesUnit:=TPasUsesUnit(CreateElement(TPasUsesUnit,AUnitName,ASection,NamePos));
     Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef,UsesUnit);
@@ -4315,12 +4332,14 @@ begin
     NextToken;
     Case CurToken of
       tkObject,
-      tkClass :
+      tkClass,
+      tkinterface:
         begin
-        if CurToken=tkobject then
-          AObjKind:=okObject
-        else
-          AObjKind:=okClass;
+        case CurToken of
+        tkobject: AObjKind:=okObject;
+        tkinterface: AObjKind:=okInterface;
+        else AObjKind:=okClass;
+        end;
         NextToken;
         if (AObjKind = okClass) and (CurToken = tkOf) then
           ParseExcExpectedIdentifier;
@@ -4328,6 +4347,9 @@ begin
         ClassEl := TPasClassType(CreateElement(TPasClassType,
           TypeName, Parent, visDefault, NamePos, TypeParams));
         ClassEl.ObjKind:=AObjKind;
+        if AObjKind=okInterface then
+          if SameText(Scanner.CurrentValueSwitch[vsInterfaces],'CORBA') then
+            ClassEl.InterfaceType:=citCorba;
         if AddToParent and (Parent is TPasDeclarations) then
           TPasDeclarations(Parent).Classes.Add(ClassEl);
         ClassEl.IsExternal:=(AExternalName<>'');

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -31,6 +31,8 @@ type
     // ToDo: constraint T:Unit2.TBird
     // ToDo: constraint T:Unit2.TGen<word>
     procedure TestGen_TemplNameEqTypeNameFail;
+    procedure TestGen_ConstraintInheritedMissingRecordFail;
+    procedure TestGen_ConstraintInheritedMissingClassTypeFail;
 
     // generic record
     procedure TestGen_RecordLocalNameDuplicateFail;
@@ -47,10 +49,12 @@ type
     procedure TestGen_ClassDelphi;
     procedure TestGen_ClassForward;
     procedure TestGen_ClassForwardConstraints;
-    procedure TestGen_ClassForwardConstraintNameMismatchFail;
-    procedure TestGen_ClassForwardConstraintKeywordMismatchFail;
-    procedure TestGen_ClassForwardConstraintTypeMismatchFail;
+    procedure TestGen_ClassForwardConstraintNameMismatch;
+    procedure TestGen_ClassForwardConstraintKeywordMismatch;
+    procedure TestGen_ClassForwardConstraintTypeMismatch;
+    procedure TestGen_ClassForward_Circle;
     procedure TestGen_Class_Method;
+    // ToDo: procedure TestGen_Class_MethodOverride;
     procedure TestGen_Class_SpecializeSelfInside;
     // ToDo: generic class overload <T> <S,T>
     procedure TestGen_Class_GenAncestor;
@@ -59,14 +63,16 @@ type
     // ToDo: UnitA.impl uses UnitB.intf uses UnitA.intf, UnitB has specialize of UnitA
     procedure TestGen_Class_NestedType;
     procedure TestGen_Class_NestedRecord;
-    procedure TestGen_Class_NestedClass; // ToDo
+    procedure TestGen_Class_NestedClass;
     procedure TestGen_Class_Enums_NotPropagating;
     procedure TestGen_Class_List;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
 
-    // ToDo: generic interface
+    // generic interface
+    procedure TestGen_ClassInterface;
+    procedure TestGen_ClassInterface_Method;
 
     // generic array
     procedure TestGen_Array;
@@ -265,6 +271,39 @@ begin
     nDuplicateIdentifier);
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingRecordFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T: record> = class v: T; end;',
+  '  generic TEagle<U> = class(TBird<U>)',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Type parameter "U" is missing constraint "record"',
+    nTypeParamXIsMissingConstraintY);
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingClassTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  generic TBird<T: TAnt> = class v: T; end;',
+  '  generic TEagle<U> = class(TBird<U>)',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Type parameter "U" is not compatible with type "TAnt"',
+    nTypeParamXIsNotCompatibleWithY);
+end;
+
 procedure TTestResolveGenerics.TestGen_RecordLocalNameDuplicateFail;
 begin
   StartProgram(false);
@@ -469,7 +508,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGen_ClassForwardConstraintNameMismatchFail;
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraintNameMismatch;
 begin
   StartProgram(false);
   Add([
@@ -486,8 +525,7 @@ begin
     nDeclOfXDiffersFromPrevAtY);
 end;
 
-procedure TTestResolveGenerics.
-  TestGen_ClassForwardConstraintKeywordMismatchFail;
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraintKeywordMismatch;
 begin
   StartProgram(false);
   Add([
@@ -504,7 +542,7 @@ begin
     nDeclOfXDiffersFromPrevAtY);
 end;
 
-procedure TTestResolveGenerics.TestGen_ClassForwardConstraintTypeMismatchFail;
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraintTypeMismatch;
 begin
   StartProgram(false);
   Add([
@@ -523,6 +561,40 @@ begin
     nDeclOfXDiffersFromPrevAtY);
 end;
 
+procedure TTestResolveGenerics.TestGen_ClassForward_Circle;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TAnt<T> = class;',
+  '  generic TFish<U> = class',
+  '    private type AliasU = U;',
+  '    var a: TAnt<AliasU>;',
+  '        Size: AliasU;',
+  '  end;',
+  '  generic TAnt<T> = class',
+  '    private type AliasT = T;',
+  '    var f: TFish<AliasT>;',
+  '        Speed: AliasT;',
+  '  end;',
+  'var',
+  '  WordFish: specialize TFish<word>;',
+  '  BoolAnt: specialize TAnt<boolean>;',
+  '  w: word;',
+  '  b: boolean;',
+  'begin',
+  '  WordFish.Size:=w;',
+  '  WordFish.a.Speed:=w;',
+  '  WordFish.a.f.Size:=w;',
+  '  BoolAnt.Speed:=b;',
+  '  BoolAnt.f.Size:=b;',
+  '  BoolAnt.f.a.Speed:=b;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_Method;
 begin
   StartProgram(false);
@@ -795,6 +867,48 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ClassInterface;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {$interfaces corba}',
+  '  generic ICorbaIntf<T> = interface',
+  '    procedure Fly(a: T);',
+  '  end;',
+  '  {$interfaces com}',
+  '  IUnknown = interface',
+  '  end;',
+  '  IInterface = IUnknown;',
+  '  generic IComIntf<T> = interface',
+  '    procedure Run(b: T);',
+  '  end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassInterface_Method;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {$interfaces corba}',
+  '  generic IBird<T> = interface',
+  '    procedure Fly(a: T);',
+  '  end;',
+  '  TObject = class end;',
+  '  generic TBird<U> = class(IBird<U>)',
+  '    procedure Fly(a: U);',
+  '  end;',
+  'procedure TBird.Fly(a: U);',
+  'begin',
+  'end;',
+  'var b: specialize IBird<word>;',
+  'begin',
+  '  b.Fly(3);']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_Array;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcresolver.pas

@@ -360,6 +360,7 @@ type
     Procedure TestUnitUseIntf;
     Procedure TestUnitUseImplFail;
     Procedure TestUnit_DuplicateUsesFail;
+    Procedure TestUnit_DuplicateUsesIntfImplFail;
     Procedure TestUnit_NestedFail;
     Procedure TestUnitUseDotted;
     Procedure TestUnit_ProgramDefaultNamespace;
@@ -5674,6 +5675,28 @@ begin
     nParserDuplicateIdentifier);
 end;
 
+procedure TTestResolver.TestUnit_DuplicateUsesIntfImplFail;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'type number = longint;']),
+    LinesToStr([
+    '']));
+
+  StartUnit(true);
+  Add([
+  'interface',
+  'uses unit2;',
+  'var j: number;',
+  'implementation',
+  'uses unit2;',
+  'initialization',
+  '  if number(3) then ;',
+  '']);
+  CheckParserException('Duplicate identifier "unit2" at token ";" in file afile.pp at line 6 column 11',
+    nParserDuplicateIdentifier);
+end;
+
 procedure TTestResolver.TestUnit_NestedFail;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',