diff --git a/.gitattributes b/.gitattributes index 5b0b40420f..1d8b924cb3 100644 --- a/.gitattributes +++ b/.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 diff --git a/test/codetoolstests/testmethodjumptool.pas b/test/codetoolstests/testmethodjumptool.pas new file mode 100644 index 0000000000..724b6ebc5e --- /dev/null +++ b/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. + diff --git a/test/codetoolstests/teststdcodetools.pas b/test/codetoolstests/teststdcodetools.pas index cbb56908d7..301e896cb1 100644 --- a/test/codetoolstests/teststdcodetools.pas +++ b/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 diff --git a/test/runtests.lpi b/test/runtests.lpi index 6f8e11055a..ad5933a718 100644 --- a/test/runtests.lpi +++ b/test/runtests.lpi @@ -39,7 +39,7 @@ - + @@ -115,6 +115,11 @@ + + + + + diff --git a/test/runtests.lpr b/test/runtests.lpr index 408ed12692..75737dccaf 100644 --- a/test/runtests.lpr +++ b/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 diff --git a/test/testunits.pas b/test/testunits.pas index 735338dc9c..d6fff2f463 100644 --- a/test/testunits.pas +++ b/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}