Jedi Code Format: Add support for generic procedures/functions. Issue #38026, patch from Domingo Galmés.

git-svn-id: trunk@64100 -

components/jcf2/Parse/BuildParseTree.pas

@@ -919,7 +919,7 @@ begin
 
   }
   while fcTokenList.FirstSolidTokenType in
-    [ttClass] + Declarations + ProcedureWords do
+    [ttClass, ttGeneric] + Declarations + ProcedureWords do
     RecogniseDeclSection;
 end;
 
@@ -950,7 +950,7 @@ begin
       RecogniseTypeSection(false);
     ttVar, ttThreadvar:
       RecogniseVarSection(false);
-    ttProcedure, ttFunction, ttConstructor, ttDestructor, ttClass, ttOperator:
+    ttProcedure, ttFunction, ttConstructor, ttDestructor, ttClass, ttOperator,ttGeneric:
       RecogniseProcedureDeclSection;
     ttExports:
       RecogniseExportsSection;
@@ -2557,7 +2557,11 @@ begin
       Note that the function name can be omitted "
    }
   lc := fcTokenList.FirstSolidToken;
-
+  if lc.TokenType = ttSpecialize then
+  begin
+    Recognise(ttSpecialize);
+    lc := fcTokenList.FirstSolidToken;
+  end;
   if AnonymousMethodNext then
   begin
     RecogniseAnonymousMethod;
@@ -2942,6 +2946,12 @@ begin
 
   lct :=  fcTokenList.FirstSolidTokenType;
 
+  if lct = ttSpecialize then
+  begin
+    Recognise(ttSpecialize);
+    lct :=  fcTokenList.FirstSolidTokenType;
+  end;
+
   if lct = ttSemicolon then
   begin
     // empty statement
@@ -3656,6 +3666,24 @@ begin
           raise TEParseError.Create('expected class procedure or class function', lc);
       end;
     end;
+    ttGeneric:
+      case fcTokenList.SolidTokenType(2) of
+        ttProcedure:
+          RecogniseProcedureDecl(false);
+        ttFunction:
+          RecogniseFunctionDecl(false);
+        ttClass:
+          case fcTokenList.SolidTokenType(3) of
+            ttProcedure:
+              RecogniseProcedureDecl(false);
+            ttFunction:
+              RecogniseFunctionDecl(false);
+            else
+              raise TEParseError.Create('expected class procedure or class function', lc);
+          end
+        else
+          raise TEParseError.Create('expected class procedure or class function', lc);
+     end;
     else
       raise TEParseError.Create('expected procedure or function', lc);
   end;
@@ -3792,6 +3820,9 @@ begin
   // FunctionHeading -> FUNCTION Ident [FormalParameters] ':' (SimpleType | STRING)
   PushNode(nFunctionHeading);
 
+  if fcTokenList.FirstSolidTokenType = ttGeneric then
+    Recognise(ttGeneric);
+
   // class procs
   if fcTokenList.FirstSolidTokenType = ttClass then
     Recognise(ttClass);
@@ -3845,6 +3876,8 @@ begin
   }
 
   PushNode(nProcedureHeading);
+  if fcTokenList.FirstSolidTokenType = ttGeneric then
+    Recognise(ttGeneric);
 
   if fcTokenList.FirstSolidTokenType = ttClass then
     Recognise(ttClass);
@@ -5591,7 +5624,11 @@ var
   lc: TSourceToken;
 begin
   lc := fcTokenList.FirstSolidToken;
-
+  if lc.TokenType = ttSpecialize then
+  begin
+    Recognise(ttSpecialize);
+    lc := fcTokenList.FirstSolidToken;
+  end;
   { all kinds of reserved words can sometimes be param names
     thanks to COM and named params
     See LittleTest43.pas }

components/jcf2/Parse/TokenUtils.pas

@@ -68,6 +68,7 @@ function ExtractNameFromFunctionHeading(const pcNode: TParseTreeNode;
   const pbFullName: boolean): string;
 
 function IsClassFunctionOrProperty(const pt: TSourceToken): boolean;
+function IsGenericFunctionOrProperty(const pt: TSourceToken): boolean;
 
 function RHSExprEquals(const pt: TSourceToken): boolean;
 
@@ -254,8 +255,12 @@ var
   lcNameToken: TSourceToken;
   lcPriorToken1, lcPriorToken2: TSourceToken;
 begin
+  if pcNode=nil then
+  begin
+    Result:='';
+    exit;
+  end;
   lcNameToken := nil;
-
   { function heading is of one of these forms
       function foo(param: integer): integer;
       function foo: integer;
@@ -378,6 +383,10 @@ begin
   Result := pt.IsOnRightOf(ProcedureHeadings + [nProperty], [ttClass]);
 end;
 
+function IsGenericFunctionOrProperty(const pt: TSourceToken): boolean;
+begin
+  Result := pt.IsOnRightOf(ProcedureHeadings + [nProperty], [ttGeneric]);
+end;
 
 function RHSExprEquals(const pt: TSourceToken): boolean;
 begin

components/jcf2/Process/Returns/ReturnBefore.pas

@@ -160,11 +160,11 @@ begin
    }
   if StartsAnonymousMethod(pt) then
     exit;
-
   if (pt.TokenType in ProcedureWords) and
     (not pt.IsOnRightOf(nTypeDecl, ttEquals)) and
     (not pt.HasParentNode(nProcedureType, 2)) and
     (not IsClassFunctionOrProperty(pt)) and
+    (not IsGenericFunctionOrProperty(pt)) and
     (ProcedureHasBody(pt)) and
     (not IsIdentifier(pt, idAny)) then
   begin
@@ -196,6 +196,7 @@ begin
   { start of class function body }
   if (pt.TokenType = ttClass) and
     ( not pt.HasParentNode([nVarDecl, nConstDecl, nClassDeclarations, nRecordType])) and
+    ( not IsGenericFunctionOrProperty(pt)) and
     (pt.HasParentNode(nFunctionHeading, 1)) then
   begin
     Result := True;
@@ -241,7 +242,6 @@ begin
 
 end;
 
-
 function NeedsReturn(const pt, ptNext: TSourceToken): boolean;
 var
   lcPrev: TSourceToken;
@@ -299,6 +299,7 @@ begin
   { procedure & function in class def get return but not blank line before }
   if (pt.TokenType in ProcedureWords + [ttProperty]) and
     (pt.HasParentNode([nClassType])) and
+    (not IsGenericFunctionOrProperty(pt)) and
     (not IsClassFunctionOrProperty(pt)) then
   begin
     Result := True;
@@ -309,7 +310,8 @@ begin
   if (pt.TokenType in ProcedureWords) and
     (not IsClassFunctionOrProperty(pt)) and
     (not pt.HasParentNode(nType)) and
-    (not IsIdentifier(pt, idAny)) then
+    (not IsIdentifier(pt, idAny)) and
+    (not IsGenericFunctionOrProperty(pt)) then
   begin
     Result := True;
     exit;
@@ -317,8 +319,9 @@ begin
 
   { start of class function decl in class }
   if (pt.TokenType = ttClass) and pt.HasParentNode([nProcedureDecl, nFunctionDecl, nProperty]) and
+    (not IsGenericFunctionOrProperty(pt)) and
     pt.HasParentNode(nClassDeclarations) and
-    ( not pt.HasParentNode([nVarDecl, nConstDecl])) then
+    (not pt.HasParentNode([nVarDecl, nConstDecl])) then
   begin
     Result := True;
     exit;
@@ -340,6 +343,7 @@ begin
 
   { return before 'class' in class function }
   if (pt.TokenType = ttClass) and pt.HasParentNode(ProcedureHeadings) and
+    (not IsGenericFunctionOrProperty(pt)) and
     (RoundBracketLevel(pt) < 1) then
   begin
     Result := True;
@@ -376,7 +380,7 @@ function StartsProcedure(const pcSourceToken: TSourceToken): boolean;
 var
   lcPrev: TSourceToken;
 begin
-  Result := (pcSourceToken.TokenType in ProcedureWords + [ttClass]) and
+  Result := (pcSourceToken.TokenType in ProcedureWords + [ttClass] +[ttGeneric]) and
     pcSourceToken.HasParentNode(ProcedureNodes, 2);
 
   if Result then
@@ -385,7 +389,7 @@ begin
 
     // check that it's not "procedure" in "class procedure foo;"
     // or "reference to procedure
-    if (lcPrev <> nil) and (lcPrev.TokenType in [ttClass, ttTo]) then
+    if (lcPrev <> nil) and (lcPrev.TokenType in [ttClass, ttGeneric, ttTo]) then
       result := False;
   end;