diff --git a/components/jcf2/Parse/BuildParseTree.pas b/components/jcf2/Parse/BuildParseTree.pas index 9d7acee0fd..3958d6f1fe 100644 --- a/components/jcf2/Parse/BuildParseTree.pas +++ b/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 } diff --git a/components/jcf2/Parse/TokenUtils.pas b/components/jcf2/Parse/TokenUtils.pas index 839d9ba6c5..98172b8274 100644 --- a/components/jcf2/Parse/TokenUtils.pas +++ b/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 diff --git a/components/jcf2/Process/Returns/ReturnBefore.pas b/components/jcf2/Process/Returns/ReturnBefore.pas index 207a6a9c9e..eb4a4edd71 100644 --- a/components/jcf2/Process/Returns/ReturnBefore.pas +++ b/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;