fcl-passrc: parser: check specialize keyword in mode objfpc

git-svn-id: trunk@42889 -

packages/fcl-passrc/src/pasresolver.pp

@@ -929,6 +929,13 @@ type
     destructor Destroy; override;
   end;
 
+  { TPasGenericParamsScope - used during parsing TPasGenericTemplateType(s) }
+
+  TPasGenericParamsScope = Class(TPasIdentifierScope)
+  public
+    GenericType: TPasGenericType;
+  end;
+
   TPSGenericStep = (
     psgsNone,
     psgsInterfaceParsed,
@@ -973,15 +980,6 @@ type
   TPasRecordScope = Class(TPasClassOrRecordScope)
   end;
 
-  { TPasClassHeaderScope -
-     scope for resolving templates during parsing ancestor+interfaces.
-     Note that "Element" is the first TPasGenericTemplateType. }
-
-  TPasClassHeaderScope = class(TPasIdentifierScope)
-  public
-    GenericType: TPasGenericType;
-  end;
-
   TPasClassScopeFlag = (
     pcsfAncestorResolved,
     pcsfSealed,
@@ -1552,6 +1550,7 @@ type
     procedure AddProcedureBody(El: TProcedureBody); virtual;
     procedure AddArgument(El: TPasArgument); virtual;
     procedure AddFunctionResult(El: TPasResultElement); virtual;
+    procedure AddGenericTemplateType(El: TPasGenericTemplateType); virtual;
     procedure AddExceptOn(El: TPasImplExceptOn); virtual;
     procedure AddWithDo(El: TPasImplWithDo); virtual;
     procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
@@ -2018,6 +2017,7 @@ type
     procedure GroupScope_AddTypeAndAncestors(Scope: TPasGroupScope; TypeEl: TPasType; WithTopHelpers: boolean = true);
     procedure PopScope;
     procedure PopWithScope(El: TPasImplWithDo);
+    procedure PopGenericParamScope(El: TPasGenericType); virtual;
     procedure PushScope(Scope: TPasScope); overload;
     function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
     function PushGroupScope(aType: TPasType): TPasGroupScope;
@@ -6059,8 +6059,8 @@ begin
   else
     ; // e.g. class forward
 
-  if TopScope is TPasClassHeaderScope then
-    PopScope;
+  if TopScope is TPasGenericParamsScope then
+    PopGenericParamScope(El);
 
   if not El.IsForward then
     begin
@@ -6219,6 +6219,14 @@ begin
 end;
 
 procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
+
+  procedure RaiseCannotBeTogether(const Id: TMaxPrecInt; const X,Y: string;
+    ErrorEl: TPasElement);
+  begin
+    RaiseMsg(Id,nConstraintXAndConstraintYCannotBeTogether,
+      sConstraintXAndConstraintYCannotBeTogether,[X,Y],ErrorEl);
+  end;
+
 var
   i: Integer;
   Expr: TPasExpr;
@@ -6247,11 +6255,9 @@ begin
         RaiseMsg(20190720202412,nConstraintXSpecifiedMoreThanOnce,
           sConstraintXSpecifiedMoreThanOnce,['class'],Expr);
       if IsRecord then
-        RaiseMsg(20190720202516,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,['record','class'],Expr);
+        RaiseCannotBeTogether(20190720202516,'record','class',Expr);
       if LastType<>nil then
-        RaiseMsg(20190720205708,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'class'],Expr);
+        RaiseCannotBeTogether(20190720205708,LastType.Name,'class',Expr);
       IsClass:=true;
       end;
     tkrecord:
@@ -6260,14 +6266,11 @@ begin
         RaiseMsg(20190720203028,nConstraintXSpecifiedMoreThanOnce,
           sConstraintXSpecifiedMoreThanOnce,['record'],Expr);
       if IsClass then
-        RaiseMsg(20190720203039,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,['class','record'],Expr);
+        RaiseCannotBeTogether(20190720203039,'class','record',Expr);
       if IsConstructor then
-        RaiseMsg(20190720203056,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,['constructor','record'],Expr);
+        RaiseCannotBeTogether(20190720203056,'constructor','record',Expr);
       if LastType<>nil then
-        RaiseMsg(20190720205938,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'record'],Expr);
+        RaiseCannotBeTogether(20190720205938,LastType.Name,'record',Expr);
       IsRecord:=true;
       end;
     tkconstructor:
@@ -6276,11 +6279,9 @@ begin
         RaiseMsg(20190720203123,nConstraintXSpecifiedMoreThanOnce,
           sConstraintXSpecifiedMoreThanOnce,['constructor'],Expr);
       if IsRecord then
-        RaiseMsg(20190720203148,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,['record','constructor'],Expr);
+        RaiseCannotBeTogether(20190720203148,'record','constructor',Expr);
       if LastType<>nil then
-        RaiseMsg(20190720210005,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,'constructor'],Expr);
+        RaiseCannotBeTogether(20190720210005,LastType.Name,'constructor',Expr);
       IsConstructor:=true;
       end;
     else
@@ -6288,52 +6289,61 @@ 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
+      if ResolvedEl.BaseType<>btContext then
         RaiseMsg(20190720204604,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
           [GetResolverResultDescription(ResolvedEl)],Expr);
-        end;
-      MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
+      if ResolvedEl.IdentEl=El then
+        RaiseMsg(20190831211541,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
+          [El.Name],Expr);
       if IsRecord then
-        RaiseMsg(20190720210130,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,['record',MemberType.Name],Expr);
+        RaiseCannotBeTogether(20190720210130,'record',ResolvedEl.HiTypeEl.Name,Expr);
       if IsClass then
-        RaiseMsg(20190720210202,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,['class',MemberType.Name],Expr);
+        RaiseCannotBeTogether(20190720210202,'class',ResolvedEl.HiTypeEl.Name,Expr);
       if IsConstructor then
-        RaiseMsg(20190720210244,nConstraintXAndConstraintYCannotBeTogether,
-          sConstraintXAndConstraintYCannotBeTogether,['constructor',MemberType.Name],Expr);
-      if MemberType is TPasClassType then
+        RaiseCannotBeTogether(20190720210244,'constructor',ResolvedEl.HiTypeEl.Name,Expr);
+
+      if ResolvedEl.IdentEl is TPasGenericTemplateType then
         begin
-        aClass:=TPasClassType(MemberType);
-        case aClass.ObjKind of
-        okClass:
+        // ok
+        if length(El.Constraints)>1 then
+          RaiseMsg(20190831213645,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
+            [GetResolverResultDescription(ResolvedEl)],Expr);
+        end
+      else if ResolvedEl.IdentEl is TPasMembersType then
+        begin
+        MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
+        if MemberType is TPasClassType then
           begin
-          // there can be at most one classtype constraint
-          if LastType<>nil then
-            RaiseMsg(20190720210351,nConstraintXAndConstraintYCannotBeTogether,
-              sConstraintXAndConstraintYCannotBeTogether,[LastType.Name,MemberType.Name],Expr);
+          aClass:=TPasClassType(MemberType);
+          case aClass.ObjKind of
+          okClass:
+            begin
+            // there can be at most one classtype constraint
+            if LastType<>nil then
+              RaiseCannotBeTogether(20190720210351,LastType.Name,MemberType.Name,Expr);
+            end;
+          okInterface:
+            begin
+            // there can be multiple interfacetype constraint
+            if not (LastType is TPasClassType) then
+              RaiseCannotBeTogether(20190720211236,LastType.Name,MemberType.Name,Expr);
+            if TPasClassType(LastType).ObjKind<>okInterface then
+              RaiseCannotBeTogether(20190720211304,LastType.Name,MemberType.Name,Expr);
+            end
+          else
+            RaiseMsg(20190720210919,nXIsNotAValidConstraint,
+              sXIsNotAValidConstraint,[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,
+          RaiseMsg(20190720210809,nXIsNotAValidConstraint,
             sXIsNotAValidConstraint,[MemberType.Name],Expr);
-        end;
         end
       else
-        RaiseMsg(20190720210809,nXIsNotAValidConstraint,
-          sXIsNotAValidConstraint,[MemberType.Name],Expr);
-      LastType:=MemberType;
+        RaiseMsg(20190720204604,nXIsNotAValidConstraint,sXIsNotAValidConstraint,
+          [GetResolverResultDescription(ResolvedEl)],Expr);
+
+      LastType:=ResolvedEl.LoTypeEl;
       end;
     end;
     end;
@@ -8028,8 +8038,7 @@ begin
 
   if aClass.IsForward then
     begin
-    if TopScope is TPasClassHeaderScope then
-      PopScope;
+    PopGenericParamScope(aClass);
 
     // check for duplicate forwards
     C:=aClass.Parent.ClassType;
@@ -8282,8 +8291,8 @@ begin
     until El=nil;
     end;
 
-  if TopScope is TPasClassHeaderScope then
-    PopScope;
+  if TopScope is TPasGenericParamsScope then
+    PopGenericParamScope(aClass);
 
   // start scope for members
   {$IFDEF VerbosePasResolver}
@@ -10690,7 +10699,14 @@ var
 begin
   SpecType:=El.DestType;
   if SpecType.DestType<>nil then
+    begin
+    if El.Parent is TPasGenericTemplateType then
+      exit;
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.ResolveInlineSpecializeExpr ',GetObjPath(El));
+    {$ENDIF}
     RaiseNotYetImplemented(20190815092327,El,GetObjName(SpecType.DestType));
+    end;
 
   // resolve DestType
   Expr:=SpecType.Expr;
@@ -11150,17 +11166,18 @@ begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.AddArrayType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
   {$ENDIF}
+  if TypeParams<>nil then
+    begin
+    El.SetGenericTemplates(TypeParams);
+    TypeParams:=El.GenericTemplateTypes;
+    CheckGenericTemplateTypes(El);
+    end;
+  PopGenericParamScope(El);
+
   if El.Name<>'' then begin
     if not (TopScope is TPasIdentifierScope) then
       RaiseInvalidScopeForElement(20190812215622,El);
 
-    if TypeParams<>nil then
-      begin
-      El.SetGenericTemplates(TypeParams);
-      TypeParams:=El.GenericTemplateTypes;
-      CheckGenericTemplateTypes(El);
-      end;
-
     AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
 
     if TypeParams<>nil then
@@ -11179,15 +11196,16 @@ begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.AddRecordType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
   {$ENDIF}
-  if not (TopScope is TPasIdentifierScope) then
-    RaiseInvalidScopeForElement(20160922163508,El);
-
   if TypeParams<>nil then
     begin
     El.SetGenericTemplates(TypeParams);
     TypeParams:=El.GenericTemplateTypes;
     CheckGenericTemplateTypes(El);
     end;
+  PopGenericParamScope(El);
+
+  if not (TopScope is TPasIdentifierScope) then
+    RaiseInvalidScopeForElement(20160922163508,El);
 
   if El.Name<>'' then begin
     AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
@@ -11221,12 +11239,11 @@ var
   GenTemplCnt, i, j: Integer;
   DuplEl: TPasElement;
   ClassScope: TPasClassScope;
-  ForwGenTempl, ActGenTempl, TemplType: TPasGenericTemplateType;
+  ForwGenTempl, ActGenTempl: TPasGenericTemplateType;
   ForwConstraints, ActConstraints: TPasExprArray;
   ForwExpr, ActExpr: TPasExpr;
   ForwToken, ActToken: TToken;
   ForwConstraintResolved, ActConstraintResolved: TPasResolverResult;
-  ClassHeaderScope: TPasClassHeaderScope;
 begin
   // Beware: El.ObjKind is not yet set!
   {$IFDEF VerbosePasResolver}
@@ -11235,16 +11252,23 @@ begin
   if not (TopScope is TPasIdentifierScope) then
     RaiseInvalidScopeForElement(20160922163510,El);
   if TypeParams=nil then
-    GenTemplCnt:=0
+    begin
+    GenTemplCnt:=0;
+    if TopScope is TPasGenericParamsScope then
+      RaiseNotYetImplemented(20190831205006,El,GetObjName(TopScope));
+    CurScope:=TPasIdentifierScope(TopScope);
+    end
   else
     begin
+    if not (TopScope is TPasGenericParamsScope) then
+      RaiseInvalidScopeForElement(20190831205038,El,GetObjName(TopScope));
+    CurScope:=TPasIdentifierScope(Scopes[ScopeCount-2]);
     GenTemplCnt:=TypeParams.Count;
     El.SetGenericTemplates(TypeParams);
     TypeParams:=El.GenericTemplateTypes;
     CheckGenericTemplateTypes(El);
     end;
 
-  CurScope:=TPasIdentifierScope(TopScope);
   if CurScope is TPasGroupScope then
     LocalScope:=TPasGroupScope(CurScope).Scopes[0]
   else
@@ -11330,10 +11354,7 @@ begin
   if TypeParams<>nil then
     begin
     // Parsing the ancestor+interface list requires the type params.
-    TemplType:=TPasGenericTemplateType(TypeParams[0]);
-    ClassHeaderScope:=TPasClassHeaderScope(PushScope(TemplType,TPasClassHeaderScope));
-    ClassHeaderScope.GenericType:=El;
-    AddGenericTemplateIdentifiers(TypeParams,ClassHeaderScope);
+    // AddGenericTemplateIdentifiers not needed, already in TPasGenericParamsScope
     end;
 
   {$IFDEF VerbosePasResolver}
@@ -11470,15 +11491,16 @@ begin
     {$IFDEF VerbosePasResolver}
     writeln('TPasResolver.AddProcedureType ',GetObjName(El),' Parent=',GetObjName(El.Parent));
     {$ENDIF}
-    if not (TopScope is TPasIdentifierScope) then
-      RaiseInvalidScopeForElement(20190813193703,El);
-
     if TypeParams<>nil then
       begin
       El.SetGenericTemplates(TypeParams);
       TypeParams:=El.GenericTemplateTypes;
       CheckGenericTemplateTypes(El);
       end;
+    PopGenericParamScope(El);
+
+    if not (TopScope is TPasIdentifierScope) then
+      RaiseInvalidScopeForElement(20190813193703,El);
 
     AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
 
@@ -11557,7 +11579,7 @@ procedure TPasResolver.AddProcedure(El: TPasProcedure; TypeParams: TFPList);
       end;
     if Result=nil then
       RaiseMsg(20190818112356,nClassXNotFoundInThisModule,sClassXNotFoundInThisModule,
-               [ClassOrRecName],ErrorPos);
+               [ClassOrRecName+GetTypeParamCommas(TypeParamCnt)],ErrorPos);
     if TypeParamCnt=GetTypeParameterCount(Result) then
       exit; // fits perfectly
     if (not IsDelphi) and (TypeParamCnt=0) and (Found=1) then
@@ -11591,6 +11613,8 @@ begin
     // move type param elements to El
     El.SetNameParts(TypeParams);
     TypeParams:=El.NameParts;
+    if TopScope is TPasGenericParamsScope then
+      PopScope;
     end;
 
   CurScope:=TopScope;
@@ -11869,6 +11893,32 @@ begin
   AddIdentifier(TPasProcedureScope(CurScope),ResolverResultVar,El,pikSimple);
 end;
 
+procedure TPasResolver.AddGenericTemplateType(El: TPasGenericTemplateType);
+var
+  ParamScope: TPasGenericParamsScope;
+  OldIdentifier: TPasIdentifier;
+begin
+  if TopScope is TPasGenericParamsScope then
+    begin
+    ParamScope:=TPasGenericParamsScope(TopScope);
+    if ParamScope.Element.Parent<>El.Parent then
+      RaiseNotYetImplemented(20190831203132,El,GetObjName(ParamScope.Element));
+    end
+  else
+    begin
+    if El.CustomData<>nil then
+      RaiseNotYetImplemented(20190831202627,El,GetObjName(El.CustomData));
+    ParamScope:=TPasGenericParamsScope.Create;
+    AddResolveData(El,ParamScope,lkModule);
+    PushScope(ParamScope);
+    end;
+  OldIdentifier:=ParamScope.FindIdentifier(El.Name);
+  if OldIdentifier<>nil then
+    RaiseMsg(20190831202920,nDuplicateIdentifier,sDuplicateIdentifier,
+      [OldIdentifier.Identifier,GetElementSourcePosStr(OldIdentifier.Element)],El);
+  ParamScope.AddIdentifier(El.Name,El,pikSimple);
+end;
+
 procedure TPasResolver.AddExceptOn(El: TPasImplExceptOn);
 begin
   PushScope(El,TPasExceptOnScope);
@@ -14928,52 +14978,56 @@ function TPasResolver.CheckSpecializeConstraints(El: TPasSpecializeType
       end;
   end;
 
-  procedure CheckTypeFitsTemplate(ParamType: TPasType;
-    GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
+  procedure CheckTypeFitsConstraintExpr(ParamType: TPasType;
+    ConExpr: TPasExpr; ErrorPos: TPasElement);
   var
-    j: Integer;
-    ConExpr: TPasExpr;
     ConToken: TToken;
+    aClass, ConstraintClass: TPasClassType;
     ResolvedConstraint: TPasResolverResult;
-    ConstraintClass, aClass: TPasClassType;
+    GenTempl: TPasGenericTemplateType;
+    j: Integer;
   begin
-    // check if the specialized ParamType fits the constraints
-    for j:=0 to length(GenTempl.Constraints)-1 do
+    ConToken:=GetGenericConstraintKeyword(ConExpr);
+    case ConToken of
+    tkrecord:
       begin
-      ConExpr:=GenTempl.Constraints[j];
-      ConToken:=GetGenericConstraintKeyword(ConExpr);
-      case ConToken of
-      tkrecord:
-        begin
-        if not (ParamType is TPasRecordType) then
-          RaiseXExpectedButTypeYFound(20190725200015,'record type',ParamType,ErrorPos);
-        continue;
-        end;
-      tkclass,tkconstructor:
+      if not (ParamType is TPasRecordType) then
+        RaiseXExpectedButTypeYFound(20190725200015,'record type',ParamType,ErrorPos);
+      end;
+    tkclass,tkconstructor:
+      begin
+      if not (ParamType is TPasClassType) then
+        RaiseXExpectedButTypeYFound(20190726133231,'class type',ParamType,ErrorPos);
+      aClass:=TPasClassType(ParamType);
+      if aClass.ObjKind<>okClass then
+        RaiseXExpectedButTypeYFound(20190726133232,'class type',ParamType,ErrorPos);
+      if aClass.IsExternal then
+        RaiseXExpectedButTypeYFound(20190726133233,'non external class type',ParamType,ErrorPos);
+      if ConToken=tkconstructor then
         begin
-        if not (ParamType is TPasClassType) then
-          RaiseXExpectedButTypeYFound(20190726133231,'class type',ParamType,ErrorPos);
-        aClass:=TPasClassType(ParamType);
-        if aClass.ObjKind<>okClass then
-          RaiseXExpectedButTypeYFound(20190726133232,'class type',ParamType,ErrorPos);
-        if aClass.IsExternal then
-          RaiseXExpectedButTypeYFound(20190726133233,'non external class type',ParamType,ErrorPos);
-        if ConToken=tkconstructor then
-          begin
-          if FindDefaultConstructor(aClass)=nil then
-            RaiseXExpectedButTypeYFound(20190831000225,'class type with constructor create()',ParamType,ErrorPos);
-          end;
-        continue;
+        if FindDefaultConstructor(aClass)=nil then
+          RaiseXExpectedButTypeYFound(20190831000225,'class type with constructor create()',ParamType,ErrorPos);
         end;
-      else
+      end;
+    else
+      begin
+      // constraint can be a class type, interface type or a gen param type
+      // Param must be a class
+      ComputeElement(ConExpr,ResolvedConstraint,[rcType]);
+      if ResolvedConstraint.BaseType<>btContext then
+        RaiseMsg(20190831214107,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],ConExpr);
+      if ResolvedConstraint.IdentEl=nil then
+        RaiseMsg(20190726134037,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],ConExpr);
+      if ResolvedConstraint.LoTypeEl is TPasGenericTemplateType then
+        begin
+        GenTempl:=TPasGenericTemplateType(ResolvedConstraint.LoTypeEl);
+        if GenTempl=ConExpr.Parent then
+          RaiseNotYetImplemented(20190831213359,GenTempl);
+        for j:=0 to length(GenTempl.Constraints)-1 do
+          CheckTypeFitsConstraintExpr(ParamType,GenTempl.Constraints[j],ErrorPos);
+        end
+      else if ResolvedConstraint.LoTypeEl is TPasClassType then
         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)],ConExpr);
-        if not (ResolvedConstraint.LoTypeEl is TPasClassType) then
-          RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],ConExpr);
         ConstraintClass:=TPasClassType(ResolvedConstraint.LoTypeEl);
         if not (ParamType is TPasClassType) then
           RaiseIncompatibleType(20190726135859,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,ErrorPos);
@@ -14989,9 +15043,21 @@ function TPasResolver.CheckSpecializeConstraints(El: TPasSpecializeType
         else
           RaiseIncompatibleType(20190726135310,nIncompatibleTypesGotExpected,[''],ParamType,ConstraintClass,ErrorPos);
         end;
-        end;
-      end;// case-end
-      end;// for-end
+        end
+      else
+        RaiseMsg(20190726134223,nXIsNotAValidConstraint,sXIsNotAValidConstraint,[GetElementSourcePosStr(ConExpr)],ConExpr);
+      end;
+    end;// case-end
+  end;
+
+  procedure CheckTypeFitsTemplate(ParamType: TPasType;
+    GenTempl: TPasGenericTemplateType; ErrorPos: TPasElement);
+  var
+    j: Integer;
+  begin
+    // check if the specialized ParamType fits the constraints
+    for j:=0 to length(GenTempl.Constraints)-1 do
+      CheckTypeFitsConstraintExpr(ParamType,GenTempl.Constraints[j],ErrorPos);
   end;
 
 var
@@ -16410,7 +16476,7 @@ end;
 procedure TPasResolver.SpecializeClassType(GenEl, SpecEl: TPasClassType;
   SpecializedItem: TPSSpecializedItem);
 var
-  HeaderScope: TPasClassHeaderScope;
+  HeaderScope: TPasGenericParamsScope;
   TemplType: TPasGenericTemplateType;
   GenericTemplateTypes: TFPList;
   GenScope: TPasClassScope;
@@ -16436,7 +16502,7 @@ begin
     begin
     // ancestor can be specialized types. For example: = class(TAncestor<T>)
     // -> create a scope with the specialized parameters
-    HeaderScope:=TPasClassHeaderScope.Create;
+    HeaderScope:=TPasGenericParamsScope.Create;
     SpecializedItem.HeaderScope:=HeaderScope;
     TemplType:=TPasGenericTemplateType(GenericTemplateTypes[0]);
     HeaderScope.Element:=TemplType;
@@ -18736,8 +18802,7 @@ begin
         or (AClass=TPasFunctionType) then
       AddProcedureType(TPasProcedureType(El),TypeParams)
     else if AClass=TPasGenericTemplateType then
-      // TPasParser first collects template types and later adds them as a list
-      // they are not real types
+      AddGenericTemplateType(TPasGenericTemplateType(El))
     else if AClass=TPasStringType then
       begin
       AddType(TPasType(El));
@@ -20212,6 +20277,26 @@ begin
   PopScope;
 end;
 
+procedure TPasResolver.PopGenericParamScope(El: TPasGenericType);
+var
+  TemplType: TPasGenericTemplateType;
+begin
+  if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
+    begin
+    TemplType:=TPasGenericTemplateType(El.GenericTemplateTypes[0]);
+    if not (TopScope is TPasGenericParamsScope) then
+      RaiseNotYetImplemented(20190831204109,El,GetObjName(TopScope));
+    if TopScope.Element<>TemplType then
+      RaiseNotYetImplemented(20190831204134,El,GetObjName(TopScope.Element));
+    PopScope;
+    end
+  else
+    begin
+    if TopScope is TPasGenericParamsScope then
+      RaiseNotYetImplemented(20190831204213,El,GetObjName(TopScope.Element));
+    end;
+end;
+
 procedure TPasResolver.PushScope(Scope: TPasScope);
 begin
   if Scope=nil then
@@ -20347,20 +20432,17 @@ end;
 function TPasResolver.PushTemplateDotScope(TemplType: TPasGenericTemplateType;
   ErrorEl: TPasElement): TPasDotBaseScope;
 
-var
-  i: Integer;
-  Expr: TPasExpr;
-  ExprToken: TToken;
-  ResolvedEl: TPasResolverResult;
-  MemberType: TPasMembersType;
-  aClass: TPasClassType;
-  aConstructor: TPasConstructor;
-  DotClassScope: TPasDotClassScope;
-begin
-  Result:=nil;
-  for i:=0 to length(TemplType.Constraints)-1 do
-    begin
-    Expr:=TemplType.Constraints[i];
+  procedure PushConstraintExprScope(Expr: TPasExpr);
+  var
+    ExprToken: TToken;
+    ResolvedEl: TPasResolverResult;
+    DotClassScope: TPasDotClassScope;
+    MemberType: TPasMembersType;
+    GenTempl: TPasGenericTemplateType;
+    aClass: TPasClassType;
+    aConstructor: TPasConstructor;
+    i: Integer;
+  begin
     ExprToken:=GetGenericConstraintKeyword(Expr);
     case ExprToken of
     tkrecord: ;
@@ -20380,23 +20462,44 @@ begin
       end;
     else
       ComputeElement(Expr,ResolvedEl,[rcType]);
-      if (ResolvedEl.BaseType<>btContext)
-          or not (ResolvedEl.IdentEl is TPasMembersType) then
+      if ResolvedEl.BaseType<>btContext then
         RaiseNotYetImplemented(20190831001450,Expr);
-      MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
-      if Result=nil then
-        begin
-        DotClassScope:=TPasDotClassScope.Create;
-        Result:=DotClassScope;
-        PushScope(Result);
-        DotClassScope.Owner:=Self;
-        DotClassScope.ClassRecScope:=MemberType.CustomData as TPasClassScope;
-        Result.GroupScope:=CreateGroupScope(MemberType,false);
+      if ResolvedEl.IdentEl=nil then
+        RaiseNotYetImplemented(20190831214135,Expr);
+      if ResolvedEl.LoTypeEl is TPasGenericTemplateType then
+        begin
+        GenTempl:=TPasGenericTemplateType(ResolvedEl.LoTypeEl);
+        if Expr.HasParent(GenTempl) then
+          RaiseNotYetImplemented(20190831214258,Expr);
+        for i:=0 to length(GenTempl.Constraints)-1 do
+          PushConstraintExprScope(GenTempl.Constraints[i]);
+        end
+      else if ResolvedEl.LoTypeEl is TPasMembersType then
+        begin
+        MemberType:=TPasMembersType(ResolvedEl.LoTypeEl);
+        if Result=nil then
+          begin
+          DotClassScope:=TPasDotClassScope.Create;
+          Result:=DotClassScope;
+          PushScope(Result);
+          DotClassScope.Owner:=Self;
+          DotClassScope.ClassRecScope:=MemberType.CustomData as TPasClassScope;
+          Result.GroupScope:=CreateGroupScope(MemberType,false);
+          end
+        else
+          GroupScope_AddTypeAndAncestors(Result.GroupScope,MemberType,false);
         end
       else
-        GroupScope_AddTypeAndAncestors(Result.GroupScope,MemberType,false);
-    end;
+        RaiseNotYetImplemented(20190831001450,Expr);
     end;
+  end;
+
+var
+  i: Integer;
+begin
+  Result:=nil;
+  for i:=0 to length(TemplType.Constraints)-1 do
+    PushConstraintExprScope(TemplType.Constraints[i]);
 end;
 
 function TPasResolver.PushDotScope(TypeEl: TPasType): TPasDotBaseScope;

packages/fcl-passrc/src/pastree.pp

@@ -1951,6 +1951,7 @@ begin
   l:=Length(Constraints);
   SetLength(Constraints,l+1);
   Constraints[l]:=Expr;
+  Expr.Parent:=Self;
 end;
 
 {$IFDEF HasPTDumpStack}

packages/fcl-passrc/src/pparser.pp

@@ -319,7 +319,7 @@ type
     procedure ParseClassFields(AType: TPasClassType; const AVisibility: TPasMemberVisibility; IsClassField : Boolean);
     procedure ParseClassMembers(AType: TPasClassType);
     procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
-    procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
+    procedure ReadGenericArguments(List: TFPList; Parent: TPasElement);
     procedure ReadSpecializeArguments(Spec: TPasSpecializeType);
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
     function CheckProcedureArgs(Parent: TPasElement;
@@ -1683,8 +1683,11 @@ begin
     if CurToken=tkLessThan then
       begin
       // specialize
-      Result:=ParseSpecializeType(Parent,'',Name,Expr);
-      NextToken;
+      if IsSpecialize or (msDelphi in CurrentModeswitches) then
+        begin
+        Result:=ParseSpecializeType(Parent,'',Name,Expr);
+        NextToken;
+        end;
       end
     else if IsSpecialize then
       CheckToken(tkLessThan)
@@ -1697,8 +1700,14 @@ begin
       end;
     ok:=true;
   finally
-    if (not ok) and (Result<>nil) then
-      Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+    if not ok then
+      begin
+      if Result<>nil then
+        Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+      ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
+      end
+    else if (not NeedExpr) and (Expr<>nil) then
+      ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
   end;
 end;
 
@@ -2331,7 +2340,10 @@ begin
     tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkIdentifier:
       begin
-      CanSpecialize:=aCan;
+      if msDelphi in CurrentModeswitches then
+        CanSpecialize:=aCan
+      else
+        CanSpecialize:=aCannot;
       aName:=CurTokenText;
       if (CompareText(aName,'self')=0) and not (tkself in Scanner.NonTokens) then
         Last:=CreateSelfExpr(AParent)
@@ -4100,6 +4112,8 @@ Var
   T : TPasGenericTemplateType;
   Expr: TPasExpr;
   TypeEl: TPasType;
+  SrcPos: TPasSourcePos;
+  ISE: TInlineSpecializeExpr;
 begin
   ExpectToken(tkLessThan);
   repeat
@@ -4111,24 +4125,37 @@ begin
       repeat
         NextToken;
         // comma separated list: identifier, class, record, constructor
-        if CurToken in [tkclass,tkrecord,tkconstructor] then
+        case CurToken of
+        tkclass,tkrecord,tkconstructor:
           begin
           if T.TypeConstraint='' then
             T.TypeConstraint:=CurTokenString;
           Expr:=CreatePrimitiveExpr(T,pekIdent,CurTokenText);
           NextToken;
-          end
-        else if CurToken=tkIdentifier then
+          end;
+        tkIdentifier,tkspecialize:
           begin
-          TypeEl:=ParseTypeReference(Parent,true,Expr);
+          SrcPos:=CurSourcePos;
+          TypeEl:=ParseTypeReference(T,true,Expr);
           if TypeEl<>nil then
             begin
             T.TypeConstraint:=TypeEl.Name;
-            TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+            if TypeEl is TPasSpecializeType then
+              begin
+              ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',T,SrcPos));
+              ISE.DestType:=TPasSpecializeType(TypeEl);
+              TypeEl.Parent:=ISE;
+              Expr:=ISE;
+              end
+            else if TypeEl.Parent=T then
+              ParseExc(nParserExpectTokenError,SParserExpectTokenError,['20190831211205:'+TypeEl.ClassName])
+            else
+              TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
             end;
-          end
+          end;
         else
           CheckToken(tkIdentifier);
+        end;
         T.AddConstraint(Expr);
       until CurToken<>tkComma;
     Engine.FinishScope(stTypeDef,T);

packages/fcl-passrc/tests/tcgenerics.pp

@@ -273,9 +273,13 @@ end;
 procedure TTestGenerics.TestInlineSpecializeInStatement;
 begin
   Add([
+  '{$mode objfpc}',
   'begin',
+  '  vec:=specialize TVector<double>.create;',
   '  t:=specialize a<b>;',
-  '  t:=a.specialize b<c>;',
+  //'  t:=specialize a<b.specialize c<d,e.f>>;',
+  //'  t:=a.specialize b<c>;',
+  '  t:=specialize a<b>.c;',
   '']);
   ParseModule;
 end;
@@ -283,6 +287,7 @@ end;
 procedure TTestGenerics.TestInlineSpecializeInStatementDelphi;
 begin
   Add([
+  '{$mode delphi}',
   'begin',
   '  vec:=TVector<double>.create;',
   '  b:=a<b;',

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -31,12 +31,15 @@ type
     procedure TestGen_ConstraintConstructor;
     // ToDo: constraint T:Unit2.TBird
     // ToDo: constraint T:Unit2.TGen<word>
+    procedure TestGen_ConstraintSpecialize;
+    procedure TestGen_ConstraintTSpecializeT; // ToDo
     procedure TestGen_TemplNameEqTypeNameFail;
     procedure TestGen_ConstraintInheritedMissingRecordFail;
     procedure TestGen_ConstraintInheritedMissingClassTypeFail;
     procedure TestGen_ConstraintMultiParam;
     procedure TestGen_ConstraintMultiParamClassMismatch;
     procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
+    procedure TestGen_ConstraintClassType_ForInT; // ToDo
 
     // generic record
     procedure TestGen_RecordLocalNameDuplicateFail;
@@ -304,6 +307,55 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintSpecialize;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TAnt<S> = class m: S; end;',
+  '  generic TBird<T:specialize TAnt<word>> = class',
+  '    o: T;',
+  '  end;',
+  '  TFireAnt = class(specialize TAnt<word>) end;',
+  'var',
+  '  a: specialize TBird<TFireAnt>;',
+  '  f: TFireAnt;',
+  'begin',
+  '  a.o:=f;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeT;
+begin
+  exit; // ToDo
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TAnt<S> = class m: S; end;',
+  '  generic TBird<X; Y:specialize TAnt<X>> = class',
+  '    o: Y;',
+  '  end;',
+  //'  generic TEagle<X; Y:X> = class',
+  //'    e: Y;',
+  //'  end;',
+  //'  generic TFireAnt<F> = class(specialize TAnt<F>) end;',
+  'var',
+  '  b: specialize TBird<word, specialize TAnt<word>>;',
+  //'  a: specialize TAnt<word>;',
+  //'  f: specialize TEagle<specialize TAnt<boolean>, specialize TFireAnt<boolean>>;',
+  //'  fb: specialize TFireAnt<boolean>;',
+  'begin',
+  //'  b.o:=a;',
+  //'  f.e:=fb;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
 begin
   StartProgram(false);
@@ -326,7 +378,7 @@ begin
   'type',
   '  TObject = class end;',
   '  generic TBird<T: record> = class v: T; end;',
-  '  generic TEagle<U> = class(TBird<U>)',
+  '  generic TEagle<U> = class(specialize TBird<U>)',
   '  end;',
   'begin',
   '']);
@@ -343,7 +395,7 @@ begin
   '  TObject = class end;',
   '  TAnt = class end;',
   '  generic TBird<T: TAnt> = class v: T; end;',
-  '  generic TEagle<U> = class(TBird<U>)',
+  '  generic TEagle<U> = class(specialize TBird<U>)',
   '  end;',
   'begin',
   '']);
@@ -408,7 +460,7 @@ begin
   '    procedure Fly;',
   '  end;',
   '  TFireAnt = class(TRedAnt);',
-  '  generic TEagle<U: TRedAnt> = class(TBird<U>) end;',
+  '  generic TEagle<U: TRedAnt> = class(specialize TBird<U>) end;',
   '  TRedEagle = specialize TEagle<TRedAnt>;',
   'procedure TBird.Fly;',
   'var f: TFireAnt;',
@@ -425,6 +477,51 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintClassType_ForInT;
+begin
+  exit; // ToDo
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TEnumerator<TItem> = class',
+  '    FCurrent: TItem;',
+  '    property Current: TItem read FCurrent;',
+  '    function MoveNext: boolean;',
+  '  end;',
+  '  generic TAnt<U> = class',
+  '    function GetEnumerator: specialize TEnumerator<U>;',
+  '  end;',
+  '  generic TRedAnt<S> = class(specialize TAnt<S>);',
+  '  generic TBird<S; T: specialize TRedAnt<S>> = class',
+  '    m: T;',
+  '    function GetEnumerator: specialize TEnumerator<T>;',
+  '  end;',
+  '  TFireAnt = class(specialize TRedAnt<word>);',
+  '  generic TEagle<U> = class(specialize TBird<U,TFireAnt>)',
+  '  end;',
+  '  TRedEagle = specialize TEagle<word>;',
+  'function TEnumerator.MoveNext: boolean;',
+  'begin',
+  'end;',
+  'function TAnt.GetEnumerator: specialize TEnumerator<U>;',
+  'begin',
+  'end;',
+  'function TBird.GetEnumerator: specialize TEnumerator<S>;',
+  'begin',
+  'end;',
+  'var',
+  '  r: TRedEagle;',
+  '  w: word;',
+  '  f: TFireAnt;',
+  'begin',
+  '  for w in r.m do ;',
+  '  for f in r do ;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_RecordLocalNameDuplicateFail;
 begin
   StartProgram(false);
@@ -905,7 +1002,7 @@ begin
   '  generic TBird<T> = class',
   '    i: T;',
   '  end;',
-  '  generic TEagle<T> = class(TBird<T>)',
+  '  generic TEagle<T> = class(specialize TBird<T>)',
   '    j: T;',
   '  end;',
   'var',
@@ -923,7 +1020,7 @@ begin
   '{$mode objfpc}',
   'type',
   '  TObject = class end;',
-  '  generic TBird<T> = class(TBird<word>)',
+  '  generic TBird<T> = class(specialize TBird<word>)',
   '    e: T;',
   '  end;',
   'var',
@@ -1057,7 +1154,7 @@ begin
   '  TObject = class',
   '  end;',
   '  generic TAnimal<T> = class end;',
-  '  generic TBird<T> = class(TAnimal<T>)',
+  '  generic TBird<T> = class(specialize TAnimal<T>)',
   '    function GetObj: TObject;',
   '    procedure Fly(Obj: TObject); virtual; abstract;',
   '  end;',
@@ -1223,7 +1320,7 @@ begin
   '    procedure Fly(a: T);',
   '  end;',
   '  TObject = class end;',
-  '  generic TBird<U> = class(IBird<U>)',
+  '  generic TBird<U> = class(specialize IBird<U>)',
   '    procedure Fly(a: U);',
   '  end;',
   'procedure TBird.Fly(a: U);',
@@ -1444,25 +1541,25 @@ begin
   '  end;',
   'constructor TBird.Create;',
   'var',
-  '  a: TAnt<T>;',
-  '  b: TAnt<word>;',
+  '  a: specialize TAnt<T>;',
+  '  b: specialize TAnt<word>;',
   'begin',
-  '  a:=TAnt<T>.create;',
-  '  b:=TAnt<word>.create;',
+  '  a:=specialize TAnt<T>.create;',
+  '  b:=specialize TAnt<word>.create;',
   'end;',
   'constructor TAnt.Create;',
   'var',
-  '  i: TBird<U>;',
-  '  j: TBird<word>;',
-  '  k: TAnt<U>;',
+  '  i: specialize TBird<U>;',
+  '  j: specialize TBird<word>;',
+  '  k: specialize TAnt<U>;',
   'begin',
-  '  i:=TBird<U>.create;',
-  '  j:=TBird<word>.create;',
-  '  k:=TAnt<U>.create;',
+  '  i:=specialize TBird<U>.create;',
+  '  j:=specialize TBird<word>.create;',
+  '  k:=specialize TAnt<U>.create;',
   'end;',
-  'var a: TAnt<word>;',
+  'var a: specialize TAnt<word>;',
   'begin',
-  '  a:=TAnt<word>.create;',
+  '  a:=specialize TAnt<word>.create;',
   '']);
   ParseProgram;
 end;