* Allow Delphi specialization syntax for generics (bug ID 30615)

git-svn-id: trunk@34688 -

packages/fcl-passrc/src/pparser.pp

@@ -1028,13 +1028,15 @@ function TPasParser.ParseSimpleType(Parent: TPasElement;
   ): TPasType;
 
 Type
-  TSimpleTypeKind = (stkAlias,stkString,stkRange);
+  TSimpleTypeKind = (stkAlias,stkString,stkRange,stkSpecialize);
 
 Var
   Ref: TPasElement;
   K : TSimpleTypeKind;
   Name : String;
   SS : Boolean;
+  CT : TPasClassType;
+
 begin
   Name := CurTokenString;
   NextToken;
@@ -1059,6 +1061,8 @@ begin
       end
     else if (CurToken in [tkBraceOpen,tkDotDot]) then // Type A = B..C;
       K:=stkRange
+    else if (CurToken = tkLessThan) then // A = B<t>;
+      K:=stkSpecialize
     else
       ParseExcTokenError(';');
     UnGetToken;
@@ -1068,6 +1072,11 @@ begin
     K:=stkRange;
     UnGetToken;
     end
+  else if (CurToken = tkLessThan) then // A = B<t>;
+    begin
+    K:=stkSpecialize;
+    UnGetToken;
+    end
   else
     begin
     UnGetToken;
@@ -1080,6 +1089,20 @@ begin
       begin
       Result:=ParseStringType(Parent,NamePos,TypeName);
       end;
+    stkSpecialize:
+      begin
+      CT := TPasClassType(CreateElement(TPasClassType, TypeName, Parent, Scanner.CurSourcePos));
+      try
+        CT.ObjKind := okSpecialize;
+        CT.AncestorType := TPasUnresolvedTypeRef.Create(Name,Parent);
+        CT.IsShortDefinition:=True;
+        ReadGenericArguments(CT.GenericTemplateTypes,CT);
+        Result:=CT;
+        CT:=Nil;
+      Finally
+        FreeAndNil(CT);
+      end;
+      end;
     stkRange:
       begin
       UnGetToken;

packages/fcl-passrc/tests/tctypeparser.pas

@@ -159,6 +159,7 @@ type
     Procedure TestReferencePointer;
     Procedure TestInvalidColon;
     Procedure TestTypeHelper;
+    Procedure TestSpecializationDelphi;
   end;
 
   { TTestRecordTypeParser }
@@ -3279,6 +3280,11 @@ begin
   ParseType('Type Helper for AnsiString end',TPasClassType,'');
 end;
 
+procedure TTestTypeParser.TestSpecializationDelphi;
+begin
+  ParseType('TFPGList<integer>',TPasClassType,'');
+end;
+
 initialization
   RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);
 end.