fcl-passrc: fixed parsing objfpc inline specialize

git-svn-id: trunk@42251 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1525,6 +1525,7 @@ type
     procedure FinishClassOfType(El: TPasClassOfType); virtual;
     procedure FinishPointerType(El: TPasPointerType); virtual;
     procedure FinishArrayType(El: TPasArrayType); virtual;
+    procedure FinishGenericTemplateType(El: TPasGenericTemplateType); virtual;
     procedure FinishResourcestring(El: TPasResString); virtual;
     procedure FinishProcedure(aProc: TPasProcedure); virtual;
     procedure FinishProcedureType(El: TPasProcedureType); virtual;
@@ -5397,7 +5398,9 @@ begin
     EmitTypeHints(El,TPasAliasType(El).DestType);
     end
   else if (C=TPasPointerType) then
-    EmitTypeHints(El,TPasPointerType(El).DestType);
+    EmitTypeHints(El,TPasPointerType(El).DestType)
+  else if C=TPasGenericTemplateType then
+    FinishGenericTemplateType(TPasGenericTemplateType(El));
 end;
 
 procedure TPasResolver.FinishEnumType(El: TPasEnumType);
@@ -5801,6 +5804,24 @@ begin
     end;
 end;
 
+procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
+var
+  i: Integer;
+  Expr: TPasExpr;
+  Value: String;
+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
+        ; // ToDo
+      end;
+    end;
+end;
+
 procedure TPasResolver.FinishResourcestring(El: TPasResString);
 var
   ResolvedEl: TPasResolverResult;
@@ -15852,6 +15873,7 @@ begin
       // resolved when finished
     else if AClass=TPasImplCommand then
     else if AClass=TPasAttributes then
+    else if AClass=TPasGenericTemplateType then
     else if AClass=TPasUnresolvedUnitRef then
       RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
     else

packages/fcl-passrc/src/pastree.pp

@@ -58,6 +58,7 @@ resourcestring
   SPasTreeClassType = 'class';
   SPasTreeInterfaceType = 'interface';
   SPasTreeSpecializedType = 'specialized class type';
+  SPasTreeSpecializedExpr = 'specialize expr';
   SPasClassHelperType = 'class helper type';
   SPasRecordHelperType = 'record helper type';
   SPasTypeHelperType = 'type helper type';
@@ -564,28 +565,27 @@ type
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full: boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
     procedure AddParam(El: TPasElement);
   public
     Params: TFPList; // list of TPasType or TPasExpr
   end;
 
-  { TInlineTypeExpr - base class TInlineSpecializeExpr }
+  { TInlineSpecializeExpr - A<B,C> }
 
-  TInlineTypeExpr = class(TPasExpr)
+  TInlineSpecializeExpr = class(TPasExpr)
   public
+    constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : Boolean): string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
-    procedure ClearTypeReferences(aType: TPasElement); override;
+    procedure AddParam(El: TPasElement);
   public
-    DestType: TPasType; // TPasSpecializeType
+    NameExpr: TPasExpr; // TPrimitiveExpr
-  end;
+    Params: TFPList; // list of TPasType or TPasExpr
-
-  { TInlineSpecializeExpr - A<B,C> }
-
-  TInlineSpecializeExpr = class(TInlineTypeExpr)
   end;
 
   { TPasRangeType }
@@ -731,9 +731,18 @@ type
     Function IsAdvancedRecord : Boolean;
   end;
 
+  { TPasGenericTemplateType }
+
   TPasGenericTemplateType = Class(TPasType)
+  public
+    destructor Destroy; override;
+    function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    procedure AddConstraint(Expr: TPasExpr);
   Public
-    TypeConstraint : String;
+    TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
+    Constraints: TPasExprArray;
   end;
 
   TPasObjKind = (
@@ -1753,6 +1762,54 @@ begin
     end;
 end;
 
+{ TPasGenericTemplateType }
+
+destructor TPasGenericTemplateType.Destroy;
+var
+  i: Integer;
+begin
+  for i:=0 to length(Constraints)-1 do
+    Constraints[i].Release;
+  Constraints:=nil;
+  inherited Destroy;
+end;
+
+function TPasGenericTemplateType.GetDeclaration(full: boolean): string;
+var
+  i: Integer;
+begin
+  Result:=inherited GetDeclaration(full);
+  if length(Constraints)>0 then
+    begin
+    Result:=Result+': ';
+    for i:=0 to length(Constraints)-1 do
+      begin
+      if i>0 then
+        Result:=Result+',';
+      Result:=Result+Constraints[i].GetDeclaration(false);
+      end;
+    end;
+end;
+
+procedure TPasGenericTemplateType.ForEachCall(
+  const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to length(Constraints)-1 do
+    ForEachChildCall(aMethodCall,Arg,Constraints[i],false);
+end;
+
+procedure TPasGenericTemplateType.AddConstraint(Expr: TPasExpr);
+var
+  l: Integer;
+begin
+  l:=Length(Constraints);
+  SetLength(Constraints,l+1);
+  Constraints[l]:=Expr;
+end;
+
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 begin
@@ -1831,34 +1888,61 @@ begin
   SemicolonAtEOL := true;
 end;
 
-{ TInlineTypeExpr }
+{ TInlineSpecializeExpr }
 
-destructor TInlineTypeExpr.Destroy;
+constructor TInlineSpecializeExpr.Create(const AName: string;
+  AParent: TPasElement);
 begin
-  ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TInlineTypeExpr.DestType'{$ENDIF});
+  if AName='' then ;
+  inherited Create(AParent, pekSpecialize, eopNone);
+  Params:=TFPList.Create;
+end;
+
+destructor TInlineSpecializeExpr.Destroy;
+var
+  i: Integer;
+begin
+  ReleaseAndNil(TPasElement(NameExpr));
+  for i:=0 to Params.Count-1 do
+    TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF};
+  FreeAndNil(Params);
   inherited Destroy;
 end;
 
-function TInlineTypeExpr.ElementTypeName: string;
+function TInlineSpecializeExpr.ElementTypeName: string;
 begin
-  Result := DestType.ElementTypeName;
+  Result:=SPasTreeSpecializedExpr;
 end;
 
-function TInlineTypeExpr.GetDeclaration(full: Boolean): string;
+function TInlineSpecializeExpr.GetDeclaration(full: Boolean): string;
+var
+  i: Integer;
 begin
-  Result:=DestType.GetDeclaration(full);
+  Result:='specialize ';
+  Result:=Result+NameExpr.GetDeclaration(full);
+  Result:=Result+'<';
+  for i:=0 to Params.Count-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
+    end;
 end;
 
-procedure TInlineTypeExpr.ForEachCall(
+procedure TInlineSpecializeExpr.ForEachCall(
   const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
 begin
-  DestType.ForEachChildCall(aMethodCall,Arg,DestType,true);
+  inherited ForEachCall(aMethodCall, Arg);
+  ForEachChildCall(aMethodCall,Arg,NameExpr,false);
+  for i:=0 to Params.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
 end;
 
-procedure TInlineTypeExpr.ClearTypeReferences(aType: TPasElement);
+procedure TInlineSpecializeExpr.AddParam(El: TPasElement);
 begin
-  if DestType=aType then
+  Params.Add(El);
-    ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TInlineTypeExpr.DestType'{$ENDIF});
 end;
 
 { TPasSpecializeType }
@@ -1903,6 +1987,16 @@ begin
     end;
 end;
 
+procedure TPasSpecializeType.ForEachCall(
+  const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to Params.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
+end;
+
 procedure TPasSpecializeType.AddParam(El: TPasElement);
 begin
   Params.Add(El);

packages/fcl-passrc/src/pparser.pp

@@ -72,7 +72,7 @@ const
   nParserNotAProcToken = 2026;
   nRangeExpressionExpected = 2027;
   nParserExpectCase = 2028;
-  // free 2029;
+  nParserGenericFunctionNeedsGenericKeyword = 2029;
   nLogStartImplementation = 2030;
   nLogStartInterface = 2031;
   nParserNoConstructorAllowed = 2032;
@@ -132,7 +132,7 @@ resourcestring
   SParserNotAProcToken = 'Not a procedure or function token';
   SRangeExpressionExpected = 'Range expression expected';
   SParserExpectCase = 'Case label expression expected';
-  // free for 2029
+  SParserGenericFunctionNeedsGenericKeyword = 'Generic function needs keyword generic';
   SLogStartImplementation = 'Start parsing implementation section.';
   SLogStartInterface = 'Start parsing interface section';
   SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Records';
@@ -319,7 +319,7 @@ type
     procedure ParseClassMembers(AType: TPasClassType);
     procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
     procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
-    procedure ReadSpecializeArguments(Spec: TPasSpecializeType);
+    procedure ReadSpecializeArguments(Spec: TPasElement);
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
     function CheckProcedureArgs(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
@@ -1587,7 +1587,7 @@ begin
   Expr:=nil;
   ST:=nil;
   try
-    if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then
+    if CurToken=tkspecialize then
       begin
       IsSpecialize:=true;
       NextToken;
@@ -1739,7 +1739,8 @@ begin
         Result := ParseClassDecl(Parent, NamePos, TypeName, okDispInterface);
       tkInterface:
         Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
-      tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
+      tkSpecialize:
+        Result:=ParseSpecializeType(Parent,TypeName);
       tkClass:
         begin
         isHelper:=false;
@@ -2165,6 +2166,8 @@ begin
 end;
 
 function TPasParser.ParseExprOperand(AParent: TPasElement): TPasExpr;
+type
+  TAllow = (aCannot, aCan, aMust);
 
   Function IsWriteOrStr(P : TPasExpr) : boolean;
 
@@ -2235,17 +2238,17 @@ var
   Last, Func, Expr: TPasExpr;
   Params: TParamsExpr;
   Bin: TBinaryExpr;
-  ok, CanSpecialize: Boolean;
+  ok: Boolean;
+  CanSpecialize: TAllow;
   aName: String;
   ISE: TInlineSpecializeExpr;
-  ST: TPasSpecializeType;
   SrcPos, ScrPos: TPasSourcePos;
   ProcType: TProcType;
   ProcExpr: TProcedureExpr;
 
 begin
   Result:=nil;
-  CanSpecialize:=false;
+  CanSpecialize:=aCannot;
   aName:='';
   case CurToken of
     tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
@@ -2253,13 +2256,20 @@ begin
     tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkIdentifier:
       begin
-      CanSpecialize:=true;
+      CanSpecialize:=aCan;
       aName:=CurTokenText;
       if (CompareText(aName,'self')=0) and not (tkself in Scanner.NonTokens) then
         Last:=CreateSelfExpr(AParent)
       else
         Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
       end;
+    tkspecialize:
+      begin
+      CanSpecialize:=aMust;
+      ExpectToken(tkIdentifier);
+      aName:=CurTokenText;
+      Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
+      end;
     tkfalse, tktrue:    Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue);
     tknil:              Last:=CreateNilExpr(AParent);
     tkSquaredBraceOpen:
@@ -2288,7 +2298,7 @@ begin
       end;
     tkself:
       begin
-      CanSpecialize:=true;
+      CanSpecialize:=aCan;
       aName:=CurTokenText;
       Last:=CreateSelfExpr(AParent);
       end;
@@ -2350,6 +2360,13 @@ begin
         begin
         ScrPos:=CurTokenPos;
         NextToken;
+        if CurToken=tkspecialize then
+          begin
+          if CanSpecialize=aMust then
+            CheckToken(tkLessThan);
+          CanSpecialize:=aMust;
+          NextToken;
+          end;
         if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
           begin
           aName:=aName+'.'+CurTokenString;
@@ -2374,34 +2391,32 @@ begin
         Params.Value:=Result;
         Result.Parent:=Params;
         Result:=Params;
-        CanSpecialize:=false;
+        CanSpecialize:=aCannot;
         Func:=nil;
         end;
       tkCaret:
         begin
         Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
         NextToken;
-        CanSpecialize:=false;
+        CanSpecialize:=aCannot;
         Func:=nil;
         end;
       tkLessThan:
         begin
         SrcPos:=CurTokenPos;
-        if (not CanSpecialize) or not IsSpecialize then
+        if CanSpecialize=aCannot then
+          break
+        else if (CanSpecialize=aCan) and not IsSpecialize then
           break
         else
           begin
           // an inline specialization (e.g. A<B,C>)
           ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',AParent,SrcPos));
-          ISE.Kind:=pekSpecialize;
+          ReadSpecializeArguments(ISE);
-          ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',ISE,SrcPos));
+          ISE.NameExpr:=Result;
-          ISE.DestType:=ST;
-          ReadSpecializeArguments(ST);
-          ST.DestType:=ResolveTypeReference(aName,ST);
-          ST.Expr:=Result;
           Result:=ISE;
           ISE:=nil;
-          CanSpecialize:=false;
+          CanSpecialize:=aCannot;
           NextToken;
           end;
         Func:=nil;
@@ -3585,6 +3600,9 @@ begin
              Declarations.Declarations.Add(ArrEl);
              Declarations.Types.Add(ArrEl);
              CheckHint(ArrEl,True);
+             {$IFDEF VerbosePasResolver}
+             ParseExcTokenError('20190619145000');
+             {$ENDIF}
              ArrEl.ElType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
              ArrEl.ElType:=TPasGenericTemplateType(List[0]);
              List.Clear;
@@ -4008,12 +4026,12 @@ begin
   end;
 end;
 
+{$warn 5043 off}
 procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement);
-
 Var
   N : String;
   T : TPasGenericTemplateType;
-
+  Expr: TPasExpr;
 begin
   ExpectToken(tkLessThan);
   repeat
@@ -4022,17 +4040,46 @@ begin
     List.Add(T);
     NextToken;
     if Curtoken = tkColon then
-      begin
+      repeat
-      T.TypeConstraint:=ExpectIdentifier;
+        NextToken;
-      NextToken;
+        // comma separated list: identifier, class, record, constructor
-      end;
+        if CurToken in [tkclass,tkrecord,tkconstructor] then
-    if not (CurToken in [tkComma,tkSemicolon,tkGreaterThan]) then
+          begin
-      ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
+          if T.TypeConstraint='' then
-        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
+            T.TypeConstraint:=CurTokenString;
-  until CurToken = tkGreaterThan;
+          Expr:=CreatePrimitiveExpr(T,pekIdent,CurTokenText);
+          NextToken;
+          end
+        else if CurToken=tkIdentifier then
+          begin
+          if T.TypeConstraint='' then
+            T.TypeConstraint:=ReadDottedIdentifier(T,Expr,true)
+          else
+            ReadDottedIdentifier(T,Expr,false);
+          end
+        else
+          CheckToken(tkIdentifier);
+        T.AddConstraint(Expr);
+      until CurToken<>tkComma;
+    Engine.FinishScope(stTypeDef,T);
+  until not (CurToken in [tkSemicolon,tkComma]);
+  if CurToken<>tkGreaterThan then
+    ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
+      [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
 end;
+{$warn 5043 on}
 
-procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType);
+procedure TPasParser.ReadSpecializeArguments(Spec: TPasElement);
+
+  procedure AddParam(El: TPasElement);
+  begin
+    if Spec is TPasSpecializeType then
+      TPasSpecializeType(Spec).AddParam(El)
+    else if Spec is TInlineSpecializeExpr then
+      TInlineSpecializeExpr(Spec).AddParam(El)
+    else
+      ParseExcTokenError('[20190619112611] '+Spec.ClassName);
+  end;
 
 Var
   Name : String;
@@ -4042,6 +4089,7 @@ Var
   Expr: TPasExpr;
 
 begin
+  //writeln('START TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
   CheckToken(tkLessThan);
   NextToken;
   Expr:=nil;
@@ -4049,7 +4097,8 @@ begin
   NestedSpec:=nil;
   try
     repeat
-      if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then
+      //writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
+      if CurToken=tkspecialize then
         begin
         IsNested:=true;
         NextToken;
@@ -4060,6 +4109,7 @@ begin
       CheckToken(tkIdentifier);
       Expr:=nil;
       Name:=ReadDottedIdentifier(Spec,Expr,true);
+      //writeln('AFTER NAME TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
 
       if CurToken=tkLessThan then
         begin
@@ -4075,18 +4125,19 @@ begin
         // read nested specialize arguments
         ReadSpecializeArguments(NestedSpec);
         // add nested specialize
-        Spec.AddParam(NestedSpec);
+        AddParam(NestedSpec);
         NestedSpec:=nil;
         NextToken;
         end
       else if IsNested then
-        CheckToken(tkLessThan)
+        CheckToken(tkLessThan)   // specialize keyword without <
       else
         begin
         // simple type reference
-        Spec.AddParam(Expr);
+        AddParam(Expr);
         Expr:=nil;
         end;
+      //writeln('AFTER PARAMS TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
 
       if CurToken=tkComma then
         begin
@@ -6043,7 +6094,8 @@ begin
       tkEOF:
         CheckToken(tkend);
       tkAt,tkAtAt,
-      tkIdentifier,tkNumber,tkString,tkfalse,tktrue,tkChar,
+      tkIdentifier,tkspecialize,
+      tkNumber,tkString,tkfalse,tktrue,tkChar,
       tkBraceOpen,tkSquaredBraceOpen,
       tkMinus,tkPlus,tkinherited:
         begin
@@ -6207,9 +6259,9 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
         if CurToken=tkDot then
           Result:=Result+'.'+ExpectIdentifier
         else if CurToken=tkLessThan then
-          begin // <> can be ignored, we read the list but discard its content
+          begin
           if (not MustBeGeneric) and not (msDelphi in CurrentModeswitches) then
-            ParseExcTokenError('('); // e.g. "generic" is missing in mode objfpc
+            ParseExc(nParserGenericFunctionNeedsGenericKeyword,SParserGenericFunctionNeedsGenericKeyword);
           UnGetToken;
           L:=TFPList.Create;
           Try

packages/fcl-passrc/src/pscanner.pp

@@ -3432,16 +3432,22 @@ begin
   'FPC','DEFAULT':
     SetMode(msFpc,FPCModeSwitches,false,bsFPCMode);
   'OBJFPC':
+    begin
     SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode);
+    UnsetNonToken(tkgeneric);
+    UnsetNonToken(tkspecialize);
+    end;
   'DELPHI':
     begin
     SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]);
     SetNonToken(tkgeneric);
+    SetNonToken(tkspecialize);
     end;
   'DELPHIUNICODE':
     begin
     SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]);
     SetNonToken(tkgeneric);
+    SetNonToken(tkspecialize);
     end;
   'TP':
     SetMode(msTP7,TPModeSwitches,false);

packages/fcl-passrc/tests/tcgenerics.pp

@@ -17,6 +17,7 @@ Type
     Procedure TestRecordGenerics;
     Procedure TestArrayGenerics;
     Procedure TestGenericConstraint;
+    Procedure TestGenericInterfaceConstraint; // ToDo
     Procedure TestDeclarationConstraint;
     Procedure TestSpecializationDelphi;
     Procedure TestDeclarationDelphi;
@@ -26,7 +27,8 @@ Type
     Procedure TestInlineSpecializationInArgument;
     Procedure TestSpecializeNested;
     Procedure TestInlineSpecializeInStatement;
-    Procedure TestGenericFunction; // ToDo
+    Procedure TestInlineSpecializeInStatementDelphi;
+    Procedure TestGenericFunction;
   end;
 
 implementation
@@ -69,6 +71,32 @@ begin
     'Generic TSomeClass<T: TObject> = class',
     '  b : T;',
     'end;',
+    'Generic TBird<T: class> = class',
+    '  c : TBird<T>;',
+    'end;',
+    'Generic TEagle<T: record> = class',
+    'end;',
+    'Generic TEagle<T: constructor> = class',
+    'end;',
+    '']);
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestGenericInterfaceConstraint;
+begin
+  Add([
+    'Type',
+    'TIntfA = interface end;',
+    'TIntfB = interface end;',
+    'TBird = class(TInterfacedObject,TIntfA,TIntfB) end;',
+    'Generic TAnt<T: TIntfA, TIntfB> = class',
+    '  b: T;',
+    '  c: TAnt<T>;',
+    'end;',
+    'Generic TFly<T: TIntfA, TIntfB; S> = class',
+    '  b: S;',
+    '  c: TFly<T>;',
+    'end;',
     '']);
   ParseDeclarations;
 end;
@@ -80,8 +108,8 @@ begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
   Source.Add('  TSomeClass<T: T2> = Class(TObject)');
-  Source.Add('  b : T;');
+  Source.Add('    b : T;');
-  Source.Add('end;');
+  Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
@@ -105,9 +133,9 @@ begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
   Source.Add('  TSomeClass<T,T2> = Class(TObject)');
-  Source.Add('  b : T;');
+  Source.Add('    b : T;');
-  Source.Add('  b2 : T2;');
+  Source.Add('    b2 : T2;');
-  Source.Add('end;');
+  Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
@@ -126,9 +154,9 @@ begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
   Source.Add('Type');
   Source.Add('  TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
-  Source.Add('  b : T;');
+  Source.Add('    b : T;');
-  Source.Add('  b2 : T2;');
+  Source.Add('    b2 : T2;');
-  Source.Add('end;');
+  Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
@@ -148,9 +176,9 @@ begin
   Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
   Source.Add('Type');
   Source.Add('  TSomeClass<T;T2> = Class(TObject)');
-  Source.Add('  b : T;');
+  Source.Add('    b : T;');
-  Source.Add('  b2 : T2;');
+  Source.Add('    b2 : T2;');
-  Source.Add('end;');
+  Source.Add('  end;');
   ParseDeclarations;
   AssertNotNull('have generic definition',Declarations.Classes);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
@@ -207,12 +235,25 @@ begin
 end;
 
 procedure TTestGenerics.TestInlineSpecializeInStatement;
+begin
+  Add([
+  'begin',
+  '  t:=specialize a<b>;',
+  '  t:=a.specialize b<c>;',
+  '']);
+  ParseModule;
+end;
+
+procedure TTestGenerics.TestInlineSpecializeInStatementDelphi;
 begin
   Add([
   'begin',
   '  vec:=TVector<double>.create;',
   '  b:=a<b;',
   '  t:=a<b.c<d,e.f>>;',
+  '  t:=a.b<c>;',
+  '  t:=a<b>.c;',
+  // forbidden:'  t:=a<b<c>.d>;',
   '']);
   ParseModule;
 end;
@@ -224,7 +265,7 @@ begin
   'begin',
   'end;',
   'begin',
-  //'  specialize IfThen<word>(true,2,3);',
+  '  specialize IfThen<word>(true,2,3);',
   '']);
   ParseModule;
 end;

packages/fcl-passrc/tests/testpassrc.lpr

@@ -7,7 +7,7 @@ uses
   Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
   tcexprparser, tcprocfunc, tcpassrcutil, tcresolver, tcgenerics,
-  tcuseanalyzer, pasresolveeval;
+  tcuseanalyzer, pasresolveeval, tcresolvegenerics;
 
 type