From 5a0ff3af3078b8d06c1c6b3e42ea361bd5391782 Mon Sep 17 00:00:00 2001 From: Juha Date: Sat, 15 Oct 2022 12:20:44 +0300 Subject: [PATCH] =?UTF-8?q?Jedi=20Code=20Format:=20Support=20anonymous=20m?= =?UTF-8?q?ethods.=20Issue=20#39928,=20patch=20by=20Domingo=20Galm=C3=A9s.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- components/jcf2/Parse/BuildParseTree.pas | 95 ++++++++++++------- components/jcf2/Process/Indent/Indenter.pas | 3 + .../jcf2/Process/Returns/NoReturnAfter.pas | 3 +- .../jcf2/Process/Returns/NoReturnBefore.pas | 10 +- .../jcf2/Process/Returns/ReturnBefore.pas | 6 +- .../jcf2/Process/Spacing/SingleSpaceAfter.pas | 5 + 6 files changed, 86 insertions(+), 36 deletions(-) diff --git a/components/jcf2/Parse/BuildParseTree.pas b/components/jcf2/Parse/BuildParseTree.pas index 7f7ab26634..a957221749 100644 --- a/components/jcf2/Parse/BuildParseTree.pas +++ b/components/jcf2/Parse/BuildParseTree.pas @@ -206,8 +206,8 @@ type procedure RecogniseInline; procedure RecogniseInlineItem; - procedure RecogniseFunctionDecl(const pbAnon: boolean); - procedure RecogniseProcedureDecl(const pbAnon: boolean); + procedure RecogniseFunctionDecl(const pbAnon: boolean;pbIsNamedAnonymous:boolean=false); + procedure RecogniseProcedureDecl(const pbAnon: boolean;pbIsNamedAnonymous:boolean=false); procedure RecogniseSquareBracketDir; procedure RecogniseConstructorDecl; procedure RecogniseDestructorDecl; @@ -2859,7 +2859,7 @@ begin CheckSpecialize(True); lt := fcTokenList.FirstSolidTokenType; - if AnonymousMethodNext then + if lt in [ttProcedure, ttFunction] then begin RecogniseAnonymousMethod; end @@ -3043,16 +3043,25 @@ end; procedure TBuildParseTree.RecogniseAnonymousMethod; var lt: TTokenType; + lIsNamedAnonymous:boolean; begin + {// this code compiles without error (anonymous Method with name?? ) + i := function foo:integer + begin + foo:= 4711; + end; + } + lIsNamedAnonymous := not AnonymousMethodNext; + lt := fcTokenList.FirstSolidTokenType; PushNode(nAnonymousMethod); case lt of ttProcedure: - RecogniseProcedureDecl(true); + RecogniseProcedureDecl(true,lIsNamedAnonymous); ttFunction: - RecogniseFunctionDecl(true); + RecogniseFunctionDecl(true,lIsNamedAnonymous); else RaiseParseError('Unexpected token in RecogniseAnonymousMethod', fcTokenList.FirstSolidToken); end; @@ -3446,6 +3455,8 @@ begin // empty statement // this gets doen later in common code Recognise(ttSemicolon); end + else if lt in[ttProcedure,ttFunction] then //anonymous function or procedure + RecogniseExpr(True) else begin RaiseParseError('Expected simple statement', fcTokenList.FirstSolidToken); @@ -4074,9 +4085,10 @@ begin result := False; end; -procedure TBuildParseTree.RecogniseProcedureDecl(const pbAnon: boolean); +procedure TBuildParseTree.RecogniseProcedureDecl(const pbAnon: boolean;pbIsNamedAnonymous:boolean=false); var lcTop: TParseTreeNode; + lbAnon:boolean; begin { ProcedureDecl -> ProcedureHeading ';' [Directive] Block ';' @@ -4085,7 +4097,10 @@ begin } PushNode(nProcedureDecl); - RecogniseProcedureHeading(pbAnon, False); + lbAnon:=pbAnon; + if pbIsNamedAnonymous then + lbAnon:=false; + RecogniseProcedureHeading(lbAnon, False); { the ';' is ommited by lazy programmers in some rare occasions} if fcTokenList.FirstSolidTokenType = ttSemicolon then @@ -4115,15 +4130,19 @@ begin PopNode; end; -procedure TBuildParseTree.RecogniseFunctionDecl(const pbAnon: boolean); +procedure TBuildParseTree.RecogniseFunctionDecl(const pbAnon: boolean;pbIsNamedAnonymous:boolean=false); var lcTop: TParseTreeNode; + lbAnon:boolean; begin // ProcedureDecl -> FunctionHeading ';' [Directive] Block ';' PushNode(nFunctionDecl); - RecogniseFunctionHeading(pbAnon, False); + lbAnon:=pbAnon; + if pbIsNamedAnonymous then + lbAnon:=false; + RecogniseFunctionHeading(lbAnon, False); { the ';' is ommited by lazy programmers in some rare occasions} if fcTokenList.FirstSolidTokenType = ttSemicolon then Recognise(ttSemicolon); @@ -4332,17 +4351,25 @@ begin 'out' with a comma, colon or ')' directly after is not a prefix, it is a param name if another name follows it is a prefix } - - if fcTokenList.FirstSolidTokenType in PARAM_PREFIXES then - Recognise(PARAM_PREFIXES) - else if fcTokenList.FirstSolidTokenType = ttOut then + if fcTokenList.FirstSolidTokenType in [ttProcedure, ttFunction] then begin - if IsIdentifierToken(fcTokenList.SolidToken(2), idAllowDirectives) then - Recognise(ttOut); + RecogniseAnonymousMethod; + //parameters to anonymous procedure/function + if fcTokenList.FirstSolidTokenType=ttOpenBracket then + RecogniseActualParams; + end + else + begin + if fcTokenList.FirstSolidTokenType in PARAM_PREFIXES then + Recognise(PARAM_PREFIXES) + else if fcTokenList.FirstSolidTokenType = ttOut then + begin + if IsIdentifierToken(fcTokenList.SolidToken(2), idAllowDirectives) then + Recognise(ttOut); + end; + + RecogniseParameter; end; - - RecogniseParameter; - PopNode; end; @@ -4376,6 +4403,13 @@ begin Recognise(ttArray); Recognise(ttOf); lbArray := True; + end + else if fcTokenList.FirstSolidTokenType in [ttProcedure, ttFunction] then + begin + RecogniseAnonymousMethod; + //parameters to anonymous procedure/function + if fcTokenList.FirstSolidTokenType=ttOpenBracket then + RecogniseActualParams; end; // type is optional in params ie procedure foo(var pp); @@ -6037,6 +6071,14 @@ begin CheckSpecialize(True); lc := fcTokenList.FirstSolidToken; CheckNilInstance(lc, fcRoot.LastLeaf); + if lc.TokenType in [ttProcedure, ttFunction] then + begin + RecogniseAnonymousMethod; + //parameters to anonymous procedure/function + if fcTokenList.FirstSolidTokenType=ttOpenBracket then + RecogniseActualParams; + exit; + end; { all kinds of reserved words can sometimes be param names thanks to COM and named params See LittleTest43.pas } @@ -6051,10 +6093,6 @@ begin begin RecogniseArrayType; end - else if AnonymousMethodNext then - begin - RecogniseAnonymousMethod; - end else begin { quick surgery. Perhaps even a hack - @@ -6105,19 +6143,10 @@ begin end; function TBuildParseTree.AnonymousMethodNext: boolean; -var - lc, lcNext: TSourceToken; begin Result := False; - lc := fcTokenList.FirstSolidToken; - CheckNilInstance(lc, fcRoot.LastLeaf); - - if lc.TokenType in [ttProcedure, ttFunction] then - begin - lcNext := fcTokenList.SolidToken(2); - if lcNext <> nil then - Result := (lcNext.TokenType in [ttOpenBracket, ttColon]); - end; + if fcTokenList.FirstSolidTokenType in [ttProcedure, ttFunction] then + Result := (fcTokenList.SolidTokenType(2) in [ttOpenBracket, ttColon, ttBegin]); end; procedure TBuildParseTree.CheckEnumeratorToken(aCheckTwoTokens:boolean); diff --git a/components/jcf2/Process/Indent/Indenter.pas b/components/jcf2/Process/Indent/Indenter.pas index ee0f7aac70..91b76e11a5 100644 --- a/components/jcf2/Process/Indent/Indenter.pas +++ b/components/jcf2/Process/Indent/Indenter.pas @@ -413,6 +413,9 @@ begin liIndentCount := pt.Nestings.GetLevel(nlBlock); if liIndentCount > 0 then begin + if pt.HasParentNode(nAnonymousMethod) and not (pt.TokenType in ProcedureWords) then + Dec(liIndentCount); + // outdent keywords that start and end the block if pt.TokenType in BlockOutdentWords then begin diff --git a/components/jcf2/Process/Returns/NoReturnAfter.pas b/components/jcf2/Process/Returns/NoReturnAfter.pas index ea74aaf6c7..8b39fe787d 100644 --- a/components/jcf2/Process/Returns/NoReturnAfter.pas +++ b/components/jcf2/Process/Returns/NoReturnAfter.pas @@ -76,8 +76,9 @@ end; function TNoReturnAfter.NeedsNoReturn(const pt: TSourceToken): boolean; const + // add ttTo for "reference to procedure/function" NoReturnWords: TTokenTypeSet = [ttProcedure, ttFunction, - ttConstructor, ttDestructor, ttProperty, ttGoto, ttGeneric]; + ttConstructor, ttDestructor, ttProperty, ttGoto, ttGeneric, ttTo]; var lcSetReturns: TSetReturns; lcNext, lcNext2: TSourceToken; diff --git a/components/jcf2/Process/Returns/NoReturnBefore.pas b/components/jcf2/Process/Returns/NoReturnBefore.pas index 90ed247eab..d90540eb7f 100644 --- a/components/jcf2/Process/Returns/NoReturnBefore.pas +++ b/components/jcf2/Process/Returns/NoReturnBefore.pas @@ -56,7 +56,8 @@ uses SourceToken, TokenUtils, Tokens, ParseTreeNodeType, function HasNoReturnBefore(const pt: TSourceToken): boolean; const - NoReturnTokens: TTokenTypeSet = [ttAssign, ttColon, ttSemiColon, ttPlusAssign, ttMinusAssign, ttTimesAssign, ttFloatDivAssign]; + // add ttTo for "reference to procedure/function" + NoReturnTokens: TTokenTypeSet = [ttAssign, ttColon, ttSemiColon, ttPlusAssign, ttMinusAssign, ttTimesAssign, ttFloatDivAssign, ttTo]; ProcNoReturnWords: TTokenTypeSet = [ttThen, ttDo]; var lcPrev: TParseTreeNode; @@ -66,6 +67,13 @@ begin if pt = nil then exit; + if pt.TokenType=ttReference then + exit(true); + + // referencce to procedure/function + if (pt.TokenType in [ttFunction,ttProcedure]) and (pt.PriorSolidTokenType=ttTo) then + exit(true); + //var // Test : function: Integer; // No New Line //type diff --git a/components/jcf2/Process/Returns/ReturnBefore.pas b/components/jcf2/Process/Returns/ReturnBefore.pas index c95cdfa250..b851946654 100644 --- a/components/jcf2/Process/Returns/ReturnBefore.pas +++ b/components/jcf2/Process/Returns/ReturnBefore.pas @@ -382,9 +382,13 @@ begin Result := False; lcSourceToken := TSourceToken(pcToken); lcNext := lcSourceToken.NextToken; - if lcNext = nil then + if (lcSourceToken=nil) or (lcNext = nil) then exit; + //reference to procedure/function + if (lcSourceToken.TokenType in [ttProcedure,ttFunction]) and (lcSourceToken.PriorSolidTokenType=ttTo) then + exit(false); + liReturnsNeeded := 0; if NeedsBlankLine(lcSourceToken) then diff --git a/components/jcf2/Process/Spacing/SingleSpaceAfter.pas b/components/jcf2/Process/Spacing/SingleSpaceAfter.pas index 1049a03e8a..210a808ea4 100644 --- a/components/jcf2/Process/Spacing/SingleSpaceAfter.pas +++ b/components/jcf2/Process/Spacing/SingleSpaceAfter.pas @@ -141,6 +141,11 @@ begin if (pt.TokenType in SingleSpaceAfterWords) then begin + // reference to procedure/function(param1:typeparam1) + // Anonymous Functions procedure(param1:typeparam1) + if (pt.TokenType in [ttProcedure,ttFunction]) and (ptNext.TokenType in + [ttOpenBracket, ttSemiColon]) then + exit(false); { 'procedure' and 'function' in proc type def don't have space after, e.g. type TFredProc = procedure(var psFred: integer); }