Codetools: support generics in extended record syntax. Issue #18566, patch from Anton

git-svn-id: trunk@32015 -

components/codetools/pascalparsertool.pas

@@ -2488,6 +2488,19 @@ begin
   end;
   ReadNextAtom;
   if (CurSection<>ctnInterface) then begin
+    if (Scanner.CompilerMode = cmDELPHI) and AtomIsChar('<') then
+    begin
+      repeat
+        ReadNextAtom;
+        if CurPos.Flag <> cafWord then
+          RaiseExceptionFmt(ctsIdentExpectedButAtomFound, [GetAtom]);
+        ReadNextAtom;
+        if AtomIsChar('>') then Break;
+        if CurPos.Flag <> cafColon then
+          RaiseCharExpectedButAtomFound(',');
+      until False;
+      ReadNextAtom;
+    end;
     while (CurPos.Flag=cafPoint) do begin
       // read procedure name of a class method (the name after the . )
       ReadNextAtom;
@@ -3639,7 +3652,9 @@ procedure TPascalParserTool.ReadTypeReference;
     controls.TButton
     TGenericClass<TypeReference,TypeReference>
 }
+var SavePos: TAtomPosition;
 begin
+  SavePos := CurPos;
   ReadNextAtom;
   while CurPos.Flag=cafPoint do begin
     ReadNextAtom;
@@ -3647,24 +3662,16 @@ begin
     ReadNextAtom;
   end;
   if not AtomIsChar('<') then exit;
+  if Scanner.CompilerMode <> cmDELPHI then
+    RaiseException('Unexpected character "<"');
   // read specialization parameters
-  repeat
-    ReadNextAtom;
-    if AtomIsIdentifier(false) then begin
-      ReadTypeReference;
-      if CurPos.Flag=cafComma then begin
-        // read another parameter
-        continue;
-      end;
-    end;
-    if AtomIs('>=') then
-      // this is the only case where >= are two atoms
-      dec(CurPos.EndPos);
-    if not AtomIsChar('>') then
-      RaiseCharExpectedButAtomFound('>');
-    ReadNextAtom;
-    break;
-  until false;
+  CurPos := SavePos;
+  ReadPriorAtom; // unread generic name
+  CurNode := CurNode.Parent;
+  FreeAndNil(CurNode.FirstChild);
+  CurNode.LastChild := nil;
+  ReadSpecialize(True);
+  CurNode.EndPos := CurPos.EndPos;
 end;
 
 function TPascalParserTool.KeyWordFuncTypePacked: boolean;
@@ -4167,6 +4174,8 @@ begin
   if CurPos.Flag in AllCommonAtomWords then begin
     AtomIsIdentifier(true);
     ReadTypeReference;
+    if CurNode.EndPos > 0 then
+      Exit(True);
     while (CurPos.Flag in [cafRoundBracketOpen,cafEdgedBracketOpen]) do begin
       ReadTilBracketClose(true);
       ReadNextAtom;
@@ -4924,7 +4933,7 @@ begin
           CurNode.Desc:=ctnIdentifier;
         end;
         ReadTypeReference;
-        if CreateChildNodes then begin
+        if (CurNode.EndPos < 0) and CreateChildNodes then begin
           CurNode.EndPos:=CurPos.EndPos;
           EndChildNode;
         end;

components/codetools/pascalreadertool.pas

@@ -459,6 +459,15 @@ begin
       // read classname and name
       repeat
         ExtractNextAtom(true,Attr);
+        if Scanner.CompilerMode = cmDELPHI then
+        begin { delphi generics }
+          if AtomIsChar('<') then
+          begin
+            while not AtomIsChar('>') and (CurPos.EndPos < SrcLen) do
+              ExtractNextAtom(true,Attr);
+            ExtractNextAtom(true,Attr);
+          end;
+        end;
         if CurPos.Flag<>cafPoint then break;
         ExtractNextAtom(true,Attr);
         if not AtomIsIdentifier(false) then exit;
@@ -467,6 +476,12 @@ begin
       // read only part of name
       repeat
         ReadNextAtom;
+        if (Scanner.CompilerMode = cmDELPHI) and AtomIsChar('<') then
+        begin
+          while not AtomIsChar('>') and (CurPos.EndPos < SrcLen) do
+            ReadNextAtom;
+          ReadNextAtom;
+        end;
         IsClassName:=(CurPos.Flag=cafPoint);
         UndoReadNextAtom;
         if IsClassName then begin
@@ -558,7 +573,11 @@ begin
       if ClassNode.Desc=ctnTypeDefinition then
         Result:=GetIdentifier(@Src[ClassNode.StartPos])+Result
       else if ClassNode.FirstChild<>nil then
+      begin
+        if (Scanner.CompilerMode = cmDELPHI) and (ClassNode.Desc = ctnGenericType) then
+          Result := Result + ExtractNode(ClassNode.FirstChild.NextBrother, []);
         Result:=GetIdentifier(@Src[ClassNode.FirstChild.StartPos])+Result;
+      end;
       if not WithParents then break;
     end;
     ClassNode:=ClassNode.Parent;
@@ -612,6 +631,15 @@ begin
     if not AtomIsIdentifier(false) then break;
     Part:=GetAtom;
     ReadNextAtom;
+    if (Scanner.CompilerMode = cmDELPHI) and AtomIsChar('<') then
+    begin { delphi generics }
+      Part := Part + GetAtom;
+      repeat
+        ReadNextAtom;
+        Part := Part + GetAtom;
+      until (CurPos.StartPos > SrcLen) or AtomIsChar('>');
+      ReadNextAtom;
+    end;
     if (CurPos.Flag<>cafPoint) then break;
     if Result<>'' then Result:=Result+'.';
     Result:=Result+Part;
@@ -1652,6 +1680,11 @@ begin
   p:=AClassName;
   if SkipFirst then begin
     while IsIdentChar[p^] do inc(p);
+    if p^='<' then
+    begin
+      while not (p^ in [#0,'>']) do Inc(p);
+      if p^ = '>' then Inc(p);
+    end;
     if p^=#0 then exit(RootClassNode);
     if p^<>'.' then exit;
     inc(p);

components/codetools/sourcechanger.pas

@@ -1542,9 +1542,11 @@ var
   CurAtom: string;
   OldIndent: Integer;
   OldAtomStart: LongInt;
+  AfterProcedure: Boolean;
 begin
   //DebugLn('**********************************************************');
   //DebugLn('[TBeautifyCodeOptions.BeautifyStatement] "',AStatement,'"');
+  AfterProcedure := False;
   // set flags
   CurFlags:=BeautifyFlags;
   OldIndent:=Indent;
@@ -1589,6 +1591,20 @@ begin
         else
           break;
       until false;
+      if AfterProcedure then
+      begin
+        if CurAtomType = atSemicolon then
+          AfterProcedure := False
+        else
+        // in implementation of generic methods in DELPHI mode
+        // "<" and ">" have a sense of brackets
+        if (CurAtomType = atSymbol) and (CurAtom[1] in ['<', '>']) then
+          CurAtomType := atBracket;
+      end else
+      if (CurAtomType = atKeyword)
+        and (SameText(CurAtom, 'procedure') or SameText(CurAtom, 'function'))
+      then
+        AfterProcedure := True;
       //DebugLn(['TBeautifyCodeOptions.BeautifyStatement ',CurAtom,' LastAtomType=',AtomTypeNames[LastAtomType],',',LastAtomType in DoNotInsertSpaceAfter,',',LastAtomType in DoInsertSpaceAfter,' CurAtomType=',AtomTypeNames[CurAtomType],',',CurAtomType in DoNotInsertSpaceInFront,',',CurAtomType in DoInsertSpaceInFront]);
       if ((Result='') or (Result[length(Result)]<>' '))
       and (not (CurAtomType in DoNotInsertSpaceInFront))
@@ -1670,8 +1686,16 @@ begin
   end else begin
     // there is already a name
     if AClassName<>'' then begin
-      while (StartPos<=ProcLen) and (IsSpaceChar[AProcCode[StartPos]]) do
-        inc(StartPos);
+      while (StartPos<=ProcLen) do
+        if IsSpaceChar[AProcCode[StartPos]] then
+          inc(StartPos)
+        else
+        if AProcCode[StartPos] = '<' then { the case of delphi style generics }
+        begin
+          while (StartPos<=ProcLen) and (AProcCode[StartPos]<>'>') do
+            inc(StartPos);
+          inc(StartPos)
+        end else Break;
       if (StartPos<=ProcLen) and (AProcCode[StartPos]<>'.') then
         Result:=copy(AProcCode,1,NamePos-1)+AClassName+'.'
                +copy(AProcCode,NamePos,length(AProcCode)-NamePos+1)