* Fix generics >=Class and type ^File and external vars

git-svn-id: trunk@47494 -

packages/fcl-passrc/src/pparser.pp

@@ -1192,29 +1192,40 @@ procedure TPasParser.ChangeToken(tk: TToken);
 var
   Cur, Last: PTokenRec;
   IsLast: Boolean;
+
+  Procedure DoChange(tk1,tk2 : TToken);
+
+    begin
+      // change last token '>>' into two '>'
+      Cur:=@FTokenRing[FTokenRingCur];
+      Cur^.Token:=tk2;
+      Cur^.AsString:=TokenInfos[tk2];
+      Last:=@FTokenRing[FTokenRingEnd];
+      Last^.Token:=tk2;
+      Last^.AsString:=TokenInfos[tk2];
+      if Last^.Comments<>nil then
+        Last^.Comments.Clear;
+      Last^.SourcePos:=Cur^.SourcePos;
+      dec(Cur^.SourcePos.Column);
+      Last^.TokenPos:=Cur^.TokenPos;
+      inc(Last^.TokenPos.Column);
+      FTokenRingEnd:=(FTokenRingEnd+1) mod FTokenRingSize;
+      if FTokenRingStart=FTokenRingEnd then
+        FTokenRingStart:=(FTokenRingStart+1) mod FTokenRingSize;
+      FCurToken:=tk1;
+      FCurTokenString:=TokenInfos[tk1];
+    end;
+
 begin
   //writeln('TPasParser.ChangeToken FTokenBufferSize=',FTokenRingStart,' FTokenBufferIndex=',FTokenRingCur);
   IsLast:=((FTokenRingCur+1) mod FTokenRingSize)=FTokenRingEnd;
-  if (CurToken=tkshr) and (tk=tkGreaterThan) and IsLast then
+  if (CurToken=tkGreaterEqualThan) and (tk=tkGreaterThan) and IsLast then
     begin
-    // change last token '>>' into two '>'
-    Cur:=@FTokenRing[FTokenRingCur];
-    Cur^.Token:=tkGreaterThan;
-    Cur^.AsString:='>';
-    Last:=@FTokenRing[FTokenRingEnd];
-    Last^.Token:=tkGreaterThan;
-    Last^.AsString:='>';
-    if Last^.Comments<>nil then
-      Last^.Comments.Clear;
-    Last^.SourcePos:=Cur^.SourcePos;
-    dec(Cur^.SourcePos.Column);
-    Last^.TokenPos:=Cur^.TokenPos;
-    inc(Last^.TokenPos.Column);
-    FTokenRingEnd:=(FTokenRingEnd+1) mod FTokenRingSize;
-    if FTokenRingStart=FTokenRingEnd then
-      FTokenRingStart:=(FTokenRingStart+1) mod FTokenRingSize;
-    FCurToken:=tkGreaterThan;
-    FCurTokenString:='>';
+    DoChange(tkGreaterThan,tkEqual);
+    end
+  else if (CurToken=tkshr) and (tk=tkGreaterThan) and IsLast then
+    begin
+    DoChange(tkGreaterThan,tkGreaterThan);
     end
   else
     CheckToken(tk);
@@ -1770,7 +1781,7 @@ begin
   Try
     // only allowed: ^dottedidentifer
     // forbidden: ^^identifier, ^array of word, ^A<B>
-    ExpectIdentifier;
+    ExpectTokens([tkIdentifier,tkFile]);
     Name:=CurTokenString;
     repeat
       NextToken;
@@ -4196,8 +4207,12 @@ begin
       until CurToken<>tkComma;
     Engine.FinishScope(stTypeDef,T);
   until not (CurToken in [tkSemicolon,tkComma]);
-  if CurToken<>tkGreaterThan then
-    ParseExcExpectedAorB(TokenInfos[tkComma], TokenInfos[tkGreaterThan]);
+  if Not (CurToken in [tkGreaterThan,tkGreaterEqualThan]) then
+    ParseExcExpectedAorB(TokenInfos[tkComma], TokenInfos[tkGreaterThan])
+  else if CurToken=tkGreaterEqualThan then
+    begin
+    ChangeToken(tkGreaterThan);
+    end;
 end;
 {$warn 5043 on}
 
@@ -4611,6 +4626,8 @@ begin
     Result := Result + ' ' + CurTokenText;
     LibName:=DoParseExpression(Parent);
     end;
+  if CurToken=tkSemiColon then
+    exit;
   if not CurTokenIsIdentifier('name') then
     ParseExcSyntaxError;
   NextToken;

packages/fcl-passrc/tests/tcgenerics.pp

@@ -21,6 +21,7 @@ Type
     Procedure TestProcTypeGenerics;
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationFPC;
+    Procedure TestDeclarationFPCNoSpaces;
     Procedure TestMethodImplementation;
 
     // generic constraints
@@ -141,6 +142,27 @@ begin
   AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
 end;
 
+procedure TTestGenerics.TestDeclarationFPCNoSpaces;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T;T2>=Class(TObject)');
+  Source.Add('    b : T;');
+  Source.Add('    b2 : T2;');
+  Source.Add('  end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
 procedure TTestGenerics.TestMethodImplementation;
 begin
   With source do

packages/fcl-passrc/tests/tctypeparser.pas

@@ -168,6 +168,7 @@ type
     Procedure TestTypeHelperWithParent;
     procedure TestPointerReference;
     Procedure TestPointerKeyWord;
+    Procedure TestPointerFile;
   end;
 
   { TTestRecordTypeParser }
@@ -3674,6 +3675,15 @@ begin
   AssertEquals('object definition count',1,Declarations.Classes.Count);
 end;
 
+procedure TTestTypeParser.TestPointerFile;
+begin
+  Add('type');
+  Add('  pfile = ^file;');
+  ParseDeclarations;
+  AssertEquals('object definition count',1,Declarations.Types.Count);
+end;
+
+
 
 initialization
   RegisterTests([TTestTypeParser,TTestRecordTypeParser,TTestProcedureTypeParser]);

packages/fcl-passrc/tests/tcvarparser.pas

@@ -49,6 +49,7 @@ Type
     Procedure TestVarExternalLib;
     Procedure TestVarExternalLibName;
     procedure TestVarExternalNoSemiColon;
+    procedure TestVarExternalLibNoName;
     Procedure TestVarCVar;
     Procedure TestVarCVarExternal;
     Procedure TestVarPublic;
@@ -325,6 +326,17 @@ begin
   AssertNotNull('Library symbol',TheVar.ExportName);
 end;
 
+
+procedure TTestVarParser.TestVarExternalLibNoName;
+begin
+  // Found in e.g.apache headers
+  ParseVar('integer; external ''mylib''','');
+  AssertEquals('Variable modifiers',[vmexternal],TheVar.VarModifiers);
+  AssertNotNull('Library name',TheVar.LibraryName);
+
+end;
+
+
 procedure TTestVarParser.TestVarExternalLibName;
 begin
   ParseVar('integer; external ''mylib'' name ''de''','');