mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-18 05:09:33 +02:00
codetools: test JumpToMethod intf to impl for single proc
git-svn-id: trunk@56521 -
This commit is contained in:
mattias
parent
5b565ad568
commit
78e914cc82
@ -72,8 +72,6 @@ type
|
||||
procedure FindDeclarations(Filename: string; ExpandFile: boolean = true);
|
||||
procedure FindDeclarations(aCode: TCodeBuffer);
|
||||
procedure TestFiles(Directory: string);
|
||||
procedure WriteSource(CleanPos: integer; Tool: TCodeTool = nil);
|
||||
procedure WriteSource(const CursorPos: TCodeXYPosition);
|
||||
property MainCode: TCodeBuffer read FMainCode;
|
||||
property MainTool: TCodeTool read FMainTool;
|
||||
end;
|
||||
@ -248,7 +246,7 @@ begin
|
||||
while (IdentifierStartPos>1) and (IsIdentChar[Src[IdentifierStartPos-1]]) do
|
||||
dec(IdentifierStartPos);
|
||||
if IdentifierStartPos=p then begin
|
||||
WriteSource(p);
|
||||
WriteSource(p,MainTool);
|
||||
Fail('missing identifier in front of marker at '+MainTool.CleanPosToStr(p));
|
||||
end;
|
||||
inc(p);
|
||||
@ -257,7 +255,7 @@ begin
|
||||
{#name} {@name}
|
||||
inc(p);
|
||||
if not IsIdentStartChar[Src[p]] then begin
|
||||
WriteSource(p);
|
||||
WriteSource(p,MainTool);
|
||||
Fail('Expected identifier at '+MainTool.CleanPosToStr(p,true));
|
||||
end;
|
||||
NameStartPos:=p;
|
||||
@ -274,7 +272,7 @@ begin
|
||||
while (p<=length(Src)) and (IsIdentChar[Src[p]]) do inc(p);
|
||||
Marker:=copy(Src,NameStartPos,p-NameStartPos);
|
||||
if (p>length(Src)) or (Src[p]<>':') then begin
|
||||
WriteSource(p);
|
||||
WriteSource(p,MainTool);
|
||||
AssertEquals('Expected : at '+MainTool.CleanPosToStr(p,true),'declaration',Marker);
|
||||
continue;
|
||||
end;
|
||||
@ -299,7 +297,7 @@ begin
|
||||
//ErrorTool:=CodeToolBoss.GetCodeToolForSource(CodeToolBoss.ErrorCode);
|
||||
//if ErrorTool<>MainTool then
|
||||
// WriteSource(,ErrorTool);
|
||||
WriteSource(IdentifierStartPos);
|
||||
WriteSource(IdentifierStartPos,MainTool);
|
||||
Fail('find declaration failed at '+MainTool.CleanPosToStr(IdentifierStartPos,true)+': '+CodeToolBoss.ErrorMessage);
|
||||
end;
|
||||
continue;
|
||||
@ -320,7 +318,7 @@ begin
|
||||
end;
|
||||
//debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
|
||||
if LowerCase(ExpectedPath)<>LowerCase(FoundPath) then begin
|
||||
WriteSource(IdentifierStartPos);
|
||||
WriteSource(IdentifierStartPos,MainTool);
|
||||
AssertEquals('find declaration wrong at '+MainTool.CleanPosToStr(IdentifierStartPos,true),LowerCase(ExpectedPath),LowerCase(FoundPath));
|
||||
end;
|
||||
end;
|
||||
@ -330,7 +328,7 @@ begin
|
||||
if not CodeToolBoss.GatherIdentifiers(CursorPos.Code,CursorPos.X,CursorPos.Y)
|
||||
then begin
|
||||
if ExpectedPath<>'' then begin
|
||||
WriteSource(IdentifierStartPos);
|
||||
WriteSource(IdentifierStartPos,MainTool);
|
||||
AssertEquals('GatherIdentifiers failed at '+MainTool.CleanPosToStr(IdentifierStartPos,true)+': '+CodeToolBoss.ErrorMessage,false,true);
|
||||
end;
|
||||
continue;
|
||||
@ -346,7 +344,7 @@ begin
|
||||
dec(i);
|
||||
end;
|
||||
if i<0 then begin
|
||||
WriteSource(IdentifierStartPos);
|
||||
WriteSource(IdentifierStartPos,MainTool);
|
||||
AssertEquals('GatherIdentifiers misses "'+ExpectedPath+'" at '+MainTool.CleanPosToStr(IdentifierStartPos,true),true,i>=0);
|
||||
end;
|
||||
end;
|
||||
@ -371,7 +369,7 @@ begin
|
||||
end else begin
|
||||
//debugln(['TTestFindDeclaration.FindDeclarations FoundPath=',FoundPath]);
|
||||
if LowerCase(ExpectedType)<>LowerCase(NewType) then begin
|
||||
WriteSource(IdentifierStartPos);
|
||||
WriteSource(IdentifierStartPos,MainTool);
|
||||
AssertEquals('GuessTypeOfIdentifier wrong at '+MainTool.CleanPosToStr(IdentifierStartPos,true),LowerCase(ExpectedType),LowerCase(NewType));
|
||||
end;
|
||||
end;
|
||||
@ -380,7 +378,7 @@ begin
|
||||
end;
|
||||
|
||||
end else begin
|
||||
WriteSource(IdentifierStartPos);
|
||||
WriteSource(IdentifierStartPos,MainTool);
|
||||
AssertEquals('Unknown marker at '+MainTool.CleanPosToStr(IdentifierStartPos,true),'declaration',Marker);
|
||||
continue;
|
||||
end;
|
||||
@ -425,37 +423,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomTestFindDeclaration.WriteSource(CleanPos: integer; Tool: TCodeTool);
|
||||
var
|
||||
Caret: TCodeXYPosition;
|
||||
begin
|
||||
if Tool=nil then Tool:=MainTool;
|
||||
if Tool=nil then
|
||||
Fail('TTestFindDeclaration.WriteSource: missing Tool');
|
||||
if not Tool.CleanPosToCaret(CleanPos,Caret) then
|
||||
Fail('TTestFindDeclaration.WriteSource: invalid cleanpos '+IntToStr(CleanPos)+' Tool='+Tool.MainFilename);
|
||||
WriteSource(Caret);
|
||||
end;
|
||||
|
||||
procedure TCustomTestFindDeclaration.WriteSource(const CursorPos: TCodeXYPosition);
|
||||
var
|
||||
CurCode: TCodeBuffer;
|
||||
i: Integer;
|
||||
Line: String;
|
||||
begin
|
||||
CurCode:=CursorPos.Code;
|
||||
if CurCode=nil then
|
||||
Fail('TTestFindDeclaration.WriteSource CurCode=nil');
|
||||
for i:=1 to CurCode.LineCount do begin
|
||||
Line:=CurCode.GetLine(i-1,false);
|
||||
if (i=CursorPos.Y) then begin
|
||||
write('*');
|
||||
Line:=LeftStr(Line,CursorPos.X-1)+'|'+copy(Line,CursorPos.X,length(Line));
|
||||
end;
|
||||
writeln(Format('%:4d: ',[i]),Line);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomTestFindDeclaration.SetUp;
|
||||
begin
|
||||
inherited SetUp;
|
||||
@ -537,7 +504,7 @@ begin
|
||||
{#name} {@name}
|
||||
inc(p);
|
||||
if not IsIdentStartChar[Src[p]] then begin
|
||||
WriteSource(p);
|
||||
WriteSource(p,MainTool);
|
||||
Fail('Expected identifier at '+MainTool.CleanPosToStr(p,true));
|
||||
end;
|
||||
NameStartPos:=p;
|
||||
@ -545,7 +512,7 @@ begin
|
||||
Marker:=copy(Src,NameStartPos,p-NameStartPos);
|
||||
AddMarker(Marker,Src[NameStartPos-1],CommentP,IdentifierStartPos,IdentifierEndPos);
|
||||
end else begin
|
||||
WriteSource(p);
|
||||
WriteSource(p,MainTool);
|
||||
Fail('invalid marker at '+MainTool.CleanPosToStr(p));
|
||||
end;
|
||||
end;
|
||||
@ -914,20 +881,20 @@ begin
|
||||
if (Src[p]='[') and (IsIdentStartChar[Src[p+1]]) then begin
|
||||
Node:=MainTool.FindDeepestNodeAtPos(p,false);
|
||||
if (Node=nil) then begin
|
||||
WriteSource(p);
|
||||
WriteSource(p,MainTool);
|
||||
Fail('missing node at '+MainTool.CleanPosToStr(p));
|
||||
end;
|
||||
if (Node.Desc<>ctnAttribute) then begin
|
||||
WriteSource(p);
|
||||
WriteSource(p,MainTool);
|
||||
Fail('missing attribute at '+MainTool.CleanPosToStr(p));
|
||||
end;
|
||||
if Node.NextBrother=nil then begin
|
||||
WriteSource(Node.StartPos);
|
||||
WriteSource(Node.StartPos,MainTool);
|
||||
Fail('Attribute without NextBrother');
|
||||
end;
|
||||
if not (Node.NextBrother.Desc in [ctnAttribute,ctnVarDefinition,ctnTypeDefinition,ctnProcedure,ctnProperty])
|
||||
then begin
|
||||
WriteSource(Node.StartPos);
|
||||
WriteSource(Node.StartPos,MainTool);
|
||||
Fail('Attribute invalid NextBrother '+Node.NextBrother.DescAsString);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
{
|
||||
Test with:
|
||||
./runtests --format=plain --suite=TTestCTMethodJumpTool
|
||||
./runtests --format=plain --suite=TestCTFindJumpPointIncFilewithIntfAndImpl
|
||||
./runtests --format=plain --suite=TTestMethodJumpTool
|
||||
./runtests --format=plain --suite=TestFindJumpPointIncFilewithIntfAndImpl
|
||||
}
|
||||
unit TestMethodJumpTool;
|
||||
|
||||
@ -11,56 +11,58 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry, LazLoggerBase,
|
||||
CodeToolManager, StdCodeTools, CodeCache, LinkScanner;
|
||||
CodeToolManager, StdCodeTools, CodeCache, LinkScanner, TestPascalParser;
|
||||
|
||||
type
|
||||
|
||||
{ TTestCTMethodJumpTool }
|
||||
{ TTestMethodJumpTool }
|
||||
|
||||
TTestCTMethodJumpTool = class(TTestCase)
|
||||
TTestMethodJumpTool = class(TCustomTestPascalParser)
|
||||
private
|
||||
function GetCTMarker(Code: TCodeBuffer; Comment: string; out Position: TPoint;
|
||||
LeftOfComment: boolean = true): boolean;
|
||||
function GetInfo(Code: TCodeBuffer; XY: TPoint): string;
|
||||
procedure GetCTMarker(aCode: TCodeBuffer; Comment: string; out Position: TPoint;
|
||||
LeftOfComment: boolean = true);
|
||||
function GetInfo(aCode: TCodeBuffer; XY: TPoint): string;
|
||||
published
|
||||
procedure TestCTFindJumpPointIncFilewithIntfAndImpl;
|
||||
procedure TestFindJumpPointIncFilewithIntfAndImpl;
|
||||
procedure TestMethodJump_IntfToImplSingleProc;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestCTMethodJumpTool }
|
||||
{ TTestMethodJumpTool }
|
||||
|
||||
function TTestCTMethodJumpTool.GetCTMarker(Code: TCodeBuffer; Comment: string;
|
||||
out Position: TPoint; LeftOfComment: boolean): boolean;
|
||||
procedure TTestMethodJumpTool.GetCTMarker(aCode: TCodeBuffer; Comment: string;
|
||||
out Position: TPoint; LeftOfComment: 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);
|
||||
p:=System.Pos(Comment,aCode.Source);
|
||||
if p<1 then begin
|
||||
WriteSource(CodeXYPosition(1,1,Code));
|
||||
Fail('TTestMethodJumpTool.GetCTMarker, missing marker "'+Comment+'" in "'+Code.Filename+'"');
|
||||
end;
|
||||
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;
|
||||
aCode.AbsoluteToLineCol(p,Position.Y,Position.X);
|
||||
if Position.Y<1 then begin
|
||||
WriteSource(CodeXYPosition(Position.X,Position.Y,Code));
|
||||
Fail('TTestMethodJumpTool.GetCTMarker, Code.AbsoluteToLineCol: "'+Comment+'" Pos='+dbgs(Position)+' in "'+Code.Filename+'"');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTestCTMethodJumpTool.GetInfo(Code: TCodeBuffer; XY: TPoint): string;
|
||||
function TTestMethodJumpTool.GetInfo(aCode: TCodeBuffer; XY: TPoint): string;
|
||||
var
|
||||
Line: String;
|
||||
begin
|
||||
Line:=Code.GetLine(XY.Y-1);
|
||||
Line:=aCode.GetLine(XY.Y-1);
|
||||
Result:=dbgs(XY)+': '+copy(Line,1,XY.X-1)+'|'+copy(Line,XY.X,length(Line));
|
||||
end;
|
||||
|
||||
procedure TTestCTMethodJumpTool.TestCTFindJumpPointIncFilewithIntfAndImpl;
|
||||
procedure TTestMethodJumpTool.TestFindJumpPointIncFilewithIntfAndImpl;
|
||||
|
||||
procedure Test(aTitle: string; Code: TCodeBuffer;
|
||||
StartMarker: string; LeftOfStart: boolean;
|
||||
@ -74,8 +76,8 @@ procedure TTestCTMethodJumpTool.TestCTFindJumpPointIncFilewithIntfAndImpl;
|
||||
NewTopline, BlockTopLine, BlockBottomLine: integer;
|
||||
RevertableJump: boolean;
|
||||
begin
|
||||
if not GetCTMarker(Code,StartMarker,BlockStart,LeftOfStart) then exit;
|
||||
if not GetCTMarker(Code,EndMarker,BlockEnd,LeftOfEnd) then exit;
|
||||
GetCTMarker(Code,StartMarker,BlockStart,LeftOfStart);
|
||||
GetCTMarker(Code,EndMarker,BlockEnd,LeftOfEnd);
|
||||
//debugln(['TTestCTStdCodetools.TestCTStdFindBlockStart BlockStart=',GetInfo(BlockStart),' BlockEnd=',GetInfo(BlockEnd)]);
|
||||
if not CodeToolBoss.JumpToMethod(Code,BlockStart.X,BlockStart.Y,
|
||||
NewCode,NewX,NewY,NewTopline,BlockTopLine,BlockBottomLine,RevertableJump)
|
||||
@ -86,12 +88,10 @@ procedure TTestCTMethodJumpTool.TestCTFindJumpPointIncFilewithIntfAndImpl;
|
||||
end;
|
||||
|
||||
var
|
||||
UnitCode: TCodeBuffer;
|
||||
IncCode: TCodeBuffer;
|
||||
begin
|
||||
UnitCode:=CodeToolBoss.CreateFile('TestMethodJumpTool1.pas');
|
||||
UnitCode.Source:=''
|
||||
+'unit TestMethodJumpTool1;'+LineEnding
|
||||
Code.Source:=''
|
||||
+'unit Test1;'+LineEnding
|
||||
+'interface'+LineEnding
|
||||
+'{$DEFINE UseInterface}'
|
||||
+'{$I TestMethodJumpTool2.inc}'+LineEnding
|
||||
@ -102,7 +102,7 @@ begin
|
||||
+'end.'+LineEnding;
|
||||
IncCode:=CodeToolBoss.CreateFile('TestMethodJumpTool2.inc');
|
||||
IncCode.Source:=''
|
||||
+'{%MainUnit TestMethodJumpTool1.pas}'+LineEnding
|
||||
+'{%MainUnit test1.pas}'+LineEnding
|
||||
+'{$IFDEF UseInterface}'+LineEnding
|
||||
+'procedure {ProcHeader}DoSomething;'+LineEnding
|
||||
+'{$ENDIF}'+LineEnding
|
||||
@ -119,8 +119,48 @@ begin
|
||||
IncCode,'ProcBody',false,'ProcHeader',false);
|
||||
end;
|
||||
|
||||
procedure TTestMethodJumpTool.TestMethodJump_IntfToImplSingleProc;
|
||||
|
||||
procedure TestJumpToMethod(FromMarker: string; LeftFrom: boolean;
|
||||
ToMarker: string; LeftTo: boolean);
|
||||
var
|
||||
FromPos, ToPos: TPoint;
|
||||
NewCode: TCodeBuffer;
|
||||
NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer;
|
||||
RevertableJump: boolean;
|
||||
begin
|
||||
GetCTMarker(Code,FromMarker,FromPos,LeftFrom);
|
||||
GetCTMarker(Code,ToMarker,ToPos,LeftTo);
|
||||
CodeToolBoss.JumpToMethod(Code,FromPos.X,FromPos.Y,NewCode, NewX, NewY,
|
||||
NewTopLine, BlockTopLine, BlockBottomLine, RevertableJump);
|
||||
if NewCode<>Code then
|
||||
AssertEquals('JumpToMethod jumped to wrong file, From line='+IntToStr(FromPos.Y)+' col='+IntToStr(FromPos.X),
|
||||
Code.Filename,NewCode.Filename);
|
||||
if NewY<>ToPos.Y then
|
||||
AssertEquals('JumpToMethod jumped to wrong line, From line='+IntToStr(FromPos.Y)+' col='+IntToStr(FromPos.X),
|
||||
ToPos.Y,NewY);
|
||||
if NewX<>ToPos.X then
|
||||
AssertEquals('JumpToMethod jumped to wrong line, From line='+IntToStr(FromPos.Y)+' col='+IntToStr(FromPos.X),
|
||||
ToPos.X,NewX);
|
||||
end;
|
||||
|
||||
begin
|
||||
Add([
|
||||
'unit Test1;',
|
||||
'{$mode objfpc}{$H+}',
|
||||
'interface',
|
||||
'procedure {a}DoIt;',
|
||||
'implementation',
|
||||
'procedure DoIt;',
|
||||
'begin',
|
||||
' {b}',
|
||||
'end;',
|
||||
'end.']);
|
||||
TestJumpToMethod('a',false,'b',true);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TTestCTMethodJumpTool);
|
||||
RegisterTest(TTestMethodJumpTool);
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -32,6 +32,8 @@ type
|
||||
procedure StartUnit;
|
||||
procedure StartProgram;
|
||||
procedure ParseModule;
|
||||
procedure WriteSource(CleanPos: integer; Tool: TCodeTool);
|
||||
procedure WriteSource(const CursorPos: TCodeXYPosition);
|
||||
property Code: TCodeBuffer read FCode;
|
||||
end;
|
||||
|
||||
@ -115,6 +117,37 @@ begin
|
||||
DoParseModule(Code,Tool);
|
||||
end;
|
||||
|
||||
procedure TCustomTestPascalParser.WriteSource(CleanPos: integer; Tool: TCodeTool
|
||||
);
|
||||
var
|
||||
Caret: TCodeXYPosition;
|
||||
begin
|
||||
if Tool=nil then
|
||||
Fail('TCustomTestPascalParser.WriteSource: missing Tool');
|
||||
if not Tool.CleanPosToCaret(CleanPos,Caret) then
|
||||
Fail('TCustomTestPascalParser.WriteSource: invalid cleanpos '+IntToStr(CleanPos)+' Tool='+Tool.MainFilename);
|
||||
WriteSource(Caret);
|
||||
end;
|
||||
|
||||
procedure TCustomTestPascalParser.WriteSource(const CursorPos: TCodeXYPosition);
|
||||
var
|
||||
CurCode: TCodeBuffer;
|
||||
i: Integer;
|
||||
Line: String;
|
||||
begin
|
||||
CurCode:=CursorPos.Code;
|
||||
if CurCode=nil then
|
||||
Fail('TCustomTestPascalParser.WriteSource CurCode=nil');
|
||||
for i:=1 to CurCode.LineCount do begin
|
||||
Line:=CurCode.GetLine(i-1,false);
|
||||
if (i=CursorPos.Y) then begin
|
||||
write('*');
|
||||
Line:=LeftStr(Line,CursorPos.X-1)+'|'+copy(Line,CursorPos.X,length(Line));
|
||||
end;
|
||||
writeln(Format('%:4d: ',[i]),Line);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTestPascalParser }
|
||||
|
||||
procedure TTestPascalParser.TestAtomRing;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user