* Generic array parsing

git-svn-id: trunk@34198 -

packages/fcl-passrc/src/pastree.pp

@@ -134,7 +134,7 @@ type
     procedure Accept(Visitor: TPassTreeVisitor); override;
     property RefCount: LongWord read FRefCount;
     property Name: string read FName write FName;
-    property Parent: TPasElement read FParent;
+    property Parent: TPasElement read FParent Write FParent;
     Property Hints : TPasMemberHints Read FHints Write FHints;
     Property CustomData : TObject Read FData Write FData;
     Property HintMessage : String Read FHintMessage Write FHintMessage;
@@ -428,6 +428,7 @@ type
     IndexRange : string;
     PackMode : TPackMode;
     ElType: TPasType;
+    Function IsGenericArray : Boolean;
     Function IsPacked : Boolean;
   end;
 
@@ -512,7 +513,7 @@ type
     Function IsAdvancedRecord : Boolean;
   end;
 
-  TPasGenericTemplateType = Class(TPasElement);
+  TPasGenericTemplateType = Class(TPasType);
   TPasObjKind = (okObject, okClass, okInterface, okGeneric, okSpecialize,
                  okClassHelper,okRecordHelper,okTypeHelper);
 
@@ -2561,6 +2562,11 @@ begin
     end;
 end;
 
+function TPasArrayType.IsGenericArray: Boolean;
+begin
+  Result:=elType is TPasGenericTemplateType;
+end;
+
 function TPasArrayType.IsPacked: Boolean;
 begin
   Result:=PackMode=pmPacked;

packages/fcl-passrc/src/pparser.pp

@@ -68,6 +68,9 @@ const
   nParserArrayPropertiesCannotHaveDefaultValue = 2041;
   nParserDefaultPropertyMustBeArray = 2042;
   nParserUnknownProcedureType = 2043;
+  nParserGenericArray1Element = 2044;
+  nParserGenericClassOrArray = 2045;
+
 
 // resourcestring patterns of messages
 resourcestring
@@ -114,6 +117,8 @@ resourcestring
   SParserArrayPropertiesCannotHaveDefaultValue = 'Array properties cannot have default value';
   SParserDefaultPropertyMustBeArray = 'The default property must be an array property';
   SParserUnknownProcedureType = 'Unknown procedure type "%d"';
+  SParserGenericArray1Element = 'Generic arrays can have only 1 template element';
+  SParserGenericClassOrArray = 'Generic can only be used with classes or arrays';
 
 type
   TPasParserLogHandler = Procedure (Sender : TObject; Const Msg : String) of object;
@@ -2064,12 +2069,13 @@ var
   ResStrEl: TPasResString;
   TypeEl: TPasType;
   ClassEl: TPasClassType;
+  ArrEl : TPasArrayType;
   List: TFPList;
   i,j: Integer;
   VarEl: TPasVariable;
   ExpEl: TPasExportSymbol;
   PropEl : TPasProperty;
-  TypeName: String;
+  TypeName,ETN: String;
   PT : TProcType;
 
 begin
@@ -2255,21 +2261,44 @@ begin
           if CurBlock <> declType then
             ParseExcSyntaxError;
           TypeName := ExpectIdentifier;
-          ClassEl := TPasClassType(Engine.CreateElement(TPasClassType,TypeName,Declarations, Scanner.CurFilename, Scanner.CurRow));
-          ClassEl.ObjKind:=okGeneric;
+          List:=TFPList.Create;
           try
-            ReadGenericArguments(ClassEl.GenericTemplateTypes,ClassEl);
-          Except
+            ReadGenericArguments(List,Nil);
+            ExpectToken(tkEqual);
+            NextToken;
+            Case CurToken of
+              tkClass :
+                 begin
+                 ClassEl := TPasClassType(Engine.CreateElement(TPasClassType,TypeName,Declarations, Scanner.CurFilename, Scanner.CurRow));
+                 ClassEl.ObjKind:=okGeneric;
+                 For I:=0 to List.Count-1 do
+                   begin
+                   TPasElement(List[i]).Parent:=ClassEl;
+                   ClassEl.GenericTemplateTypes.Add(List[i]);
+                   end;
+                 NextToken;
+                 DoParseClassType(ClassEl);
+                 Declarations.Declarations.Add(ClassEl);
+                 Declarations.Classes.Add(ClassEl);
+                 CheckHint(classel,True);
+                 end;
+              tkArray:
+                 begin
+                 if List.Count<>1 then
+                   ParseExc(nParserGenericArray1Element,sParserGenericArray1Element);
+                 ArrEl:=TPasArrayType(ParseArrayType(Declarations,TypeName,pmNone));
+                 CheckHint(ArrEl,True);
+                 ArrEl.ElType.Release;
+                 ArrEl.elType:=TPasGenericTemplateType(List[0]);
+                 Declarations.Declarations.Add(ArrEl);
+                 Declarations.Types.Add(ArrEl);
+                 end;
+            else
+              ParseExc(nParserGenericClassOrArray,SParserGenericClassOrArray);
+            end;
+          finally
             List.Free;
-            Raise;
           end;
-          ExpectToken(tkEqual);
-          ExpectToken(tkClass);
-          NextToken;
-          DoParseClassType(ClassEl);
-          Declarations.Declarations.Add(ClassEl);
-          Declarations.Classes.Add(ClassEl);
-          CheckHint(classel,True);
         end;
       tkbegin:
         begin

packages/fcl-passrc/tests/tctypeparser.pas

@@ -114,6 +114,7 @@ type
     Procedure TestStaticArrayTypedIndex;
     Procedure TestDynamicArray;
     Procedure TestDynamicArrayComment;
+    Procedure TestGenericArray;
     Procedure TestSimpleEnumerated;
     Procedure TestSimpleEnumeratedComment;
     Procedure TestSimpleEnumeratedComment2;
@@ -2837,6 +2838,20 @@ begin
   AssertComment;
 end;
 
+procedure TTestTypeParser.TestGenericArray;
+begin
+  Add('Type');
+  Add('generic TArray<T> = array of T;');
+//  Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One type definition',1,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasArrayType,TObject(Declarations.Types[0]).ClassType);
+  AssertEquals('First declaration has correct name.','TArray',TPasType(Declarations.Types[0]).Name);
+  FType:=TPasType(Declarations.Types[0]);
+  AssertEquals('Array type','',TPasArrayType(TheType).IndexRange);
+  AssertEquals('Generic Array type',True,TPasArrayType(TheType).IsGenericArray);
+end;
+
 procedure TTestTypeParser.TestSimpleEnumerated;
 
 begin