codetools: clean up and added test for FindDeclaration with-do-result and GetProcResultNode

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.StartPos<CleanCursorPos)
-      then begin
-        CleanPosToCaret(CleanCursorPos, NewPos);
-        NewTopLine := NewPos.Y;
-        BlockTopLine := NewTopLine;
-        BlockBottomLine := NewPos.Y;
-        Result:=true;
-      end else
-        NewExprType.Context.Node:=CursorNode;
-      exit;
     end;
 
     DirectSearch:=false;
@@ -10600,13 +10536,14 @@ var
               ResultNode:=FindClassOfMethod(ProcNode,True,
                 fdfExceptionOnNotFound in Params.Flags);
               if (ResultNode<>nil) 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];

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;

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');

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);