From c56aecb0ba41d9e278afce8be7ecc256d22090b8 Mon Sep 17 00:00:00 2001 From: mattias Date: Mon, 30 Jun 2025 19:47:47 +0200 Subject: [PATCH] codetools: clean up and added test for FindDeclaration with-do-result and GetProcResultNode --- components/codetools/finddeclarationtool.pas | 89 ++----------------- components/codetools/pascalreadertool.pas | 11 ++- .../codetools/tests/testfinddeclaration.pas | 24 +++++ .../codetools/tests/testpascalparser.pas | 37 +++++++- 4 files changed, 76 insertions(+), 85 deletions(-) diff --git a/components/codetools/finddeclarationtool.pas b/components/codetools/finddeclarationtool.pas index 79bc103ec9..c622c9d4e5 100644 --- a/components/codetools/finddeclarationtool.pas +++ b/components/codetools/finddeclarationtool.pas @@ -2065,53 +2065,6 @@ var CursorNode, ClassNode: TCodeTreeNode; DirectSearch, SkipChecks, SearchForward: boolean; - function IsPredefinedResult: boolean; - var - ANode: TCodeTreeNode; - p: Integer; - begin - Result:=false; - p:=GetIdentStartPosition(Src,CleanCursorPos); - if p<1 then exit; - if CompareIdentifiers('Result',@Src[p])<>0 then exit; - - if CursorNode.Desc<>ctnBeginBlock then exit; - if not CursorNode.HasParentOfType(ctnProcedure) then exit; - if not (cmsResult in Scanner.CompilerModeSwitches) then begin - debugln('Predefined "Result" inside a function body is not allowed'); - exit; - end; - ANode:=CursorNode.Parent; - while ANode<>nil do begin - if (ANode.Desc = ctnProcedure) then begin - if CompareIdentifiers('function',@Src[ANode.StartPos])=0 then - break; - end; - ANode:=ANode.Parent - end; - if ANode=nil then exit; - CursorNode:=ANode; - MoveCursorToCleanPos(CleanCursorPos); - Result:=true; - end; - - function FindFunctionResultTypeNode: TCodeTreeNode; - var ANode: TCodeTreeNode; - begin - Result:=nil; - if CursorNode.Desc<>ctnProcedure then exit; - ANode:=CursorNode.FirstChild; - if ANode.Desc<>ctnProcedureHead then exit; - ANode:=ANode.FirstChild; - while ANode<>nil do begin - if ANode.Desc=ctnIdentifier then break; - ANode:=Anode.NextBrother; - end; - - if (ANode<>nil) and (ANode.Desc=ctnIdentifier) then - Result:=ANode; - end; - function CheckIfNodeIsForwardDefinedClass(ANode: TCodeTreeNode; ATool: TFindDeclarationTool): Boolean; var @@ -2474,23 +2427,6 @@ begin {$ENDIF} end; exit; - end else if IsPredefinedResult then begin - // "Result" is allowed - Result:=false; - CleanCursorPos:=GetIdentStartPosition(Src,CleanCursorPos); - NewExprType.Desc:=xtContext; - NewExprType.Context.Tool:=Self; - NewExprType.Context.Node:=FindFunctionResultTypeNode(); - if (NewExprType.Context.Node<>nil) and (NewExprType.Context.Node.StartPosnil) and - (ResultNode.Desc in [ctnClassHelper,ctnRecordHelper,ctnTypeHelper]) - then//Self is helper -> return extended type + (ResultNode.Desc in [ctnClassHelper,ctnRecordHelper,ctnTypeHelper]) then begin + // Self is helper -> return extended type ExprType := FindExtendedExprOfHelper(ResultNode); ResultNode := ExprType.Context.Node; end else - begin//Self is class/record + begin + // Self is class/record if (ResultNode<>nil) and (ResultNode.Parent<>nil) then begin ExprType.Desc:=xtContext; @@ -10638,19 +10575,11 @@ var if (ProcNode<>nil) then begin if IsEnd and (fdfFindVariable in StartFlags) then begin BuildSubTreeForProcHead(ProcNode); - ResultNode:=ProcNode.FirstChild.FirstChild; - while (ResultNode<>nil) do begin - if ResultNode.Desc in [ctnVarDefinition,ctnIdentifier] then begin - // procedure: none - // operator: ctnVarDefinition,ctnIdentifier - // function: ctnIdentifier - ExprType.Desc:=xtContext; - ExprType.Context.Node:=ResultNode; - ExprType.Context.Tool:=Self; - exit; - end; - ResultNode:=ResultNode.NextBrother; - end; + ResultNode:=GetProcResultNode(ProcNode); + ExprType.Desc:=xtContext; + ExprType.Context.Node:=ResultNode; + ExprType.Context.Tool:=Self; + exit; end else begin OldFlags:=Params.Flags; Params.Flags:=Params.Flags+[fdfFunctionResult,fdfFindChildren]; diff --git a/components/codetools/pascalreadertool.pas b/components/codetools/pascalreadertool.pas index f5b82ca56b..40b90b5dbd 100644 --- a/components/codetools/pascalreadertool.pas +++ b/components/codetools/pascalreadertool.pas @@ -3615,17 +3615,20 @@ end; function TPascalReaderTool.GetProcResultNode(ProcNode: TCodeTreeNode ): TCodeTreeNode; +// procedure: none +// operator: ctnVarDefinition,ctnIdentifier +// function: ctnIdentifier begin Result:=nil; if ProcNode=nil then exit; if ProcNode.Desc in [ctnProcedure,ctnProcedureType] then begin - Result:=ProcNode.FirstChild; - if Result=nil then exit; + ProcNode:=ProcNode.FirstChild; + if ProcNode=nil then exit; end; - if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedureHead) then exit; + if ProcNode.Desc<>ctnProcedureHead then exit; Result:=ProcNode.FirstChild; while Result<>nil do begin - if Result.Desc=ctnIdentifier then exit; + if Result.Desc in [ctnVarDefinition,ctnIdentifier] then exit; Result:=Result.NextBrother; end; end; diff --git a/components/codetools/tests/testfinddeclaration.pas b/components/codetools/tests/testfinddeclaration.pas index 4dbe6dea80..101c4bdb63 100644 --- a/components/codetools/tests/testfinddeclaration.pas +++ b/components/codetools/tests/testfinddeclaration.pas @@ -123,6 +123,7 @@ type procedure TestFindDeclaration_Proc_BaseTypes; procedure TestFindDeclaration_ProcNested; procedure TestFindDeclaration_With; + procedure TestFindDeclaration_WithResult; procedure TestFindDeclaration_ClassOf; procedure TestFindDeclaration_NestedClasses; procedure TestFindDeclaration_NestedAliasClass; @@ -828,6 +829,29 @@ begin FindDeclarations('moduletests/fdt_with.pas'); end; +procedure TTestFindDeclaration.TestFindDeclaration_WithResult; +begin + StartProgram; + Add([ + '{$mode objfpc}', + 'type', + ' TBird = record', + ' Result: word;', + ' end;', + 'var Bird: TBird;', + 'function Fly: word;', + 'begin', + ' Result{declaration:Fly}:=1;', + ' with Bird do begin', + //' Result{declaration:TBird.Result}:=3;', + ' end;', + 'end;', + 'begin', + 'end.', + '']); + FindDeclarations(Code); +end; + procedure TTestFindDeclaration.TestFindDeclaration_ClassOf; begin FindDeclarations('moduletests/fdt_classof.pas'); diff --git a/components/codetools/tests/testpascalparser.pas b/components/codetools/tests/testpascalparser.pas index c43abca3fb..19ebeb7121 100644 --- a/components/codetools/tests/testpascalparser.pas +++ b/components/codetools/tests/testpascalparser.pas @@ -13,7 +13,7 @@ interface uses Classes, SysUtils, math, CodeToolManager, CodeCache, CodeAtom, DefineTemplates, ExprEval, - LazLogger, fpcunit, testregistry, TestGlobals; + CodeTree, PascalParserTool, LazLogger, fpcunit, testregistry, TestGlobals; type @@ -66,6 +66,7 @@ type procedure TestParseUnderscoreIsSeparator; procedure TestParseDirective_IF_SizeOf_Char; procedure TestParseObjectSealedAbstract; + procedure TestGetProcResultNode; end; implementation @@ -750,6 +751,40 @@ begin ParseModule; end; +procedure TTestPascalParser.TestGetProcResultNode; +var + Tool: TCodeTool; + Node, ResultNode: TCodeTreeNode; +begin + StartProgram; + Add([ + 'procedure Fly(a: word);', + 'begin', + 'end;', + 'function Fly(a: boolean): boolean;', + 'begin', + 'end;', + 'operator =() IsEqual: boolean;', + 'begin', + 'end;', + 'begin', + 'end.']); + DoParseModule(Code,Tool); + + Node:=Tool.Tree.Root; + while Node<>nil do begin + if Node.Desc=ctnProcedure then begin + ResultNode:=Tool.GetProcResultNode(Node); + writeln('TTestPascalParser.TestGetProcResultNode Proc="', + Tool.ExtractProcHead(Node,[phpWithStart,phpWithVarModifiers,phpWithParameterNames, + phpWithResultType,phpWithOfObject,phpWithCallingSpecs]),'"'); + writeln('TTestPascalParser.TestGetProcResultNode Result=',ResultNode.DescAsString,'="', + Tool.ExtractNode(ResultNode,[]),'"'); + end; + Node:=Node.Next; + end; +end; + initialization RegisterTest(TTestPascalParser);