codetools: added test for FindJumpPoint and double parsed include file

git-svn-id: trunk@39569 -

.gitattributes

@@ -6797,6 +6797,7 @@ test/codetoolstests/testcompleteblock.pas svneol=native#text/plain
 test/codetoolstests/testcth2pas.pas svneol=native#text/pascal
 test/codetoolstests/testctrangescan.pas svneol=native#text/plain
 test/codetoolstests/testctxmlfixfragments.pas svneol=native#text/pascal
+test/codetoolstests/testmethodjumptool.pas svneol=native#text/plain
 test/codetoolstests/teststdcodetools.pas svneol=native#text/plain
 test/customdrawn/cd_test_all.ico -text
 test/customdrawn/cd_test_all.lpi svneol=native#text/plain

test/codetoolstests/testmethodjumptool.pas

@@ -0,0 +1,126 @@
+{
+ Test with:
+     ./runtests --format=plain --suite=TTestCTMethodJumpTool
+     ./runtests --format=plain --suite=TestCTFindJumpPointIncFilewithIntfAndImpl
+}
+unit TestMethodJumpTool;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LCLProc, testglobals, fpcunit,
+  CodeToolManager, StdCodeTools, CodeCache, LinkScanner;
+
+type
+
+  { TTestCTMethodJumpTool }
+
+  TTestCTMethodJumpTool = class(TTestCase)
+  private
+    function GetCTMarker(Code: TCodeBuffer; Comment: string; out Position: TPoint;
+      LeftOfComment: boolean = true): boolean;
+    function GetInfo(Code: TCodeBuffer; XY: TPoint): string;
+  published
+    procedure TestCTFindJumpPointIncFilewithIntfAndImpl;
+  end;
+
+
+implementation
+
+{ TTestCTMethodJumpTool }
+
+function TTestCTMethodJumpTool.GetCTMarker(Code: TCodeBuffer; Comment: string;
+  out Position: TPoint; LeftOfComment: boolean): boolean;
+var
+  p: SizeInt;
+begin
+  Result:=false;
+  Position:=Point(0,0);
+  if Comment[1]<>'{' then
+    Comment:='{'+Comment+'}';
+  p:=System.Pos(Comment,Code.Source);
+  if p<1 then
+    AssertEquals('searching marker: '+Comment,true,p>=1);
+  if not LeftOfComment then
+    inc(p,length(Comment));
+  Code.AbsoluteToLineCol(p,Position.Y,Position.X);
+  if Position.Y<1 then
+    AssertEquals('Code.AbsoluteToLineCol: '+Comment,true,Position.Y>=1)
+  else
+    Result:=true;
+end;
+
+function TTestCTMethodJumpTool.GetInfo(Code: TCodeBuffer; XY: TPoint): string;
+var
+  Line: String;
+begin
+  Line:=Code.GetLine(XY.Y-1);
+  Result:=dbgs(XY)+': '+copy(Line,1,XY.X-1)+'|'+copy(Line,XY.X,length(Line));
+end;
+
+procedure TTestCTMethodJumpTool.TestCTFindJumpPointIncFilewithIntfAndImpl;
+
+  procedure Test(aTitle: string; Code: TCodeBuffer;
+    StartMarker: string; LeftOfStart: boolean;
+    EndMarker: string; LeftOfEnd: boolean);
+  var
+    BlockStart: TPoint;
+    BlockEnd: TPoint;
+    NewCode: TCodeBuffer;
+    NewX: integer;
+    NewY: integer;
+    NewTopline: integer;
+    RevertableJump: boolean;
+  begin
+    if not GetCTMarker(Code,StartMarker,BlockStart,LeftOfStart) then exit;
+    if not GetCTMarker(Code,EndMarker,BlockEnd,LeftOfEnd) then exit;
+    //debugln(['TTestCTStdCodetools.TestCTStdFindBlockStart BlockStart=',GetInfo(BlockStart),' BlockEnd=',GetInfo(BlockEnd)]);
+    if not CodeToolBoss.JumpToMethod(Code,BlockStart.X,BlockStart.Y,
+      NewCode,NewX,NewY,NewTopline,RevertableJump)
+    then
+      AssertEquals(aTitle+': '+CodeToolBoss.ErrorMessage,true,false)
+    else
+      AssertEquals(aTitle,GetInfo(Code,BlockEnd),GetInfo(NewCode,Point(NewX,NewY)))
+  end;
+
+var
+  UnitCode: TCodeBuffer;
+  IncCode: TCodeBuffer;
+begin
+  UnitCode:=CodeToolBoss.CreateFile('TestMethodJumpTool1.pas');
+  IncCode:=CodeToolBoss.CreateFile('TestMethodJumpTool2.inc');
+  UnitCode.Source:=''
+    +'unit TestMethodJumpTool1;'+LineEnding
+    +'interface'+LineEnding
+    +'{$DEFINE UseInterface}'
+    +'{$I TestMethodJumpTool2.inc}'+LineEnding
+    +'{$UNDEF UseInterface}'+LineEnding
+    +'implementation'+LineEnding
+    +'{$DEFINE UseImplementation}'
+    +'{$I TestMethodJumpTool2.inc}'+LineEnding
+    +'end.'+LineEnding;
+  IncCode.Source:=''
+    +'{%MainUnit TestMethodJumpTool1.pas}'+LineEnding
+    +'{$IFDEF UseInterface}'+LineEnding
+    +'procedure {ProcHeader}DoSomething;'+LineEnding
+    +'{$ENDIF}'+LineEnding
+    +'{$IFDEF UseImplementation}'+LineEnding
+    +'procedure DoSomething;'+LineEnding
+    +'begin'+LineEnding
+    +'  {ProcBody}writeln;'+LineEnding
+    +'end;'+LineEnding
+    +'{$ENDIF}'+LineEnding;
+
+  Test('Method jump from interface to implementation in one include file',
+       IncCode,'ProcHeader',false,'ProcBody',true);
+  Test('Method jump from implementation to interface in one include file',
+       IncCode,'ProcBody',false,'ProcHeader',false);
+end;
+
+initialization
+  AddToCodetoolsTestSuite(TTestCTMethodJumpTool);
+
+end.
+

test/codetoolstests/teststdcodetools.pas

@@ -18,6 +18,8 @@ type
   { TTestCTStdCodetools }
 
   TTestCTStdCodetools = class(TTestCase)
+  private
+    function GetCTMarker(Code: TCodeBuffer; Comment: string; out Position: TPoint): boolean;
   published
     procedure TestCTStdFindBlockStart;
   end;
@@ -26,6 +28,25 @@ implementation
 
 { TTestCTStdCodetools }
 
+function TTestCTStdCodetools.GetCTMarker(Code: TCodeBuffer; Comment: string;
+  out Position: TPoint): boolean;
+var
+  p: SizeInt;
+begin
+  Result:=false;
+  Position:=Point(0,0);
+  if Comment[1]<>'{' then
+    Comment:='{'+Comment+'}';
+  p:=System.Pos(Comment,Code.Source);
+  if p<1 then
+    AssertEquals('searching marker: '+Comment,true,p>=1);
+  Code.AbsoluteToLineCol(p+length(Comment),Position.Y,Position.X);
+  if Position.Y<1 then
+    AssertEquals('Code.AbsoluteToLineCol: '+Comment,true,Position.Y>=1)
+  else
+    Result:=true;
+end;
+
 procedure TTestCTStdCodetools.TestCTStdFindBlockStart;
 var
   Code: TCodeBuffer;
@@ -46,21 +67,6 @@ var
     +'end.'+LineEnding;
   end;
 
-  function GetMarker(Comment: string): TPoint;
-  var
-    p: SizeInt;
-  begin
-    Result:=Point(0,0);
-    if Comment[1]<>'{' then
-      Comment:='{'+Comment+'}';
-    p:=System.Pos(Comment,Code.Source);
-    if p<1 then
-      AssertEquals('searching marker: '+Comment,true,p>=1);
-    Code.AbsoluteToLineCol(p+length(Comment),Result.Y,Result.X);
-    if Result.Y<1 then
-      AssertEquals('Code.AbsoluteToLineCol: '+Comment,true,Result.Y>=1);
-  end;
-
   function GetInfo(XY: TPoint): string;
   var
     Line: String;
@@ -78,8 +84,8 @@ var
     NewY: integer;
     NewTopline: integer;
   begin
-    BlockStart:=GetMarker(StartMarker);
-    BlockEnd:=GetMarker(EndMarker);
+    if not GetCTMarker(Code,StartMarker,BlockStart) then exit;
+    if not GetCTMarker(Code,EndMarker,BlockEnd) then exit;
     //debugln(['TTestCTStdCodetools.TestCTStdFindBlockStart BlockStart=',GetInfo(BlockStart),' BlockEnd=',GetInfo(BlockEnd)]);
     if not CodeToolBoss.FindBlockStart(Code,BlockEnd.X,BlockEnd.Y,NewCode,NewX,NewY,NewTopline)
     then

test/runtests.lpi

@@ -39,7 +39,7 @@
         <PackageName Value="LCL"/>
       </Item4>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="16">
       <Unit0>
         <Filename Value="runtests.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -115,6 +115,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TestAvgLvlTree"/>
       </Unit14>
+      <Unit15>
+        <Filename Value="codetoolstests\testmethodjumptool.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TestMethodJumpTool"/>
+      </Unit15>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

test/runtests.lpr

@@ -24,7 +24,8 @@ uses
   Classes, consoletestrunner,
   testglobals, testunits, dom,
   {Unit needed to set the LCL version and widget set name}
-  LCLVersion, InterfaceBase, Interfaces, testlazxml, testavglvltree;
+  LCLVersion, InterfaceBase, Interfaces, testlazxml, testavglvltree, 
+testmethodjumptool;
   
 type
 

test/testunits.pas

@@ -33,7 +33,7 @@ uses
   TestLazUtils, TestLazUTF8, TestAvgLvlTree,
   // codetools
   TestBasicCodetools, TestCTXMLFixFragments, TestCTRangeScan, TestCTH2Pas,
-  TestCompleteBlock, TestStdCodetools, TestCfgScript,
+  TestCompleteBlock, TestStdCodetools, TestMethodJumpTool, TestCfgScript,
   // lcltests
   testunicode, testpen, TestPreferredSize
   {$IFNDEF NoSemiAutomatedTests}