1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
|
{
Test with:
./testcodetools --format=plain --suite=TTestRefactoring
./testcodetools --format=plain --suite=TestExplodeWith
}
unit TestRefactoring;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, CodeToolManager, CodeCache, CodeTree,
BasicCodeTools, LazLogger, LazFileUtils, fpcunit, testregistry,
TestFinddeclaration;
const
ExplodeWithMarker = 'explodewith:';
type
{ TTestRefactoring }
TTestRefactoring = class(TTestCase)
private
published
procedure TestExplodeWith;
end;
implementation
{ TTestRefactoring }
procedure TTestRefactoring.TestExplodeWith;
type
TWithBlock = record
CodeXYPos: TCodeXYPosition;
WithExpr: string;
StatementStartPos: integer;
StatementEndPos: integer;
end;
PWithBlock = ^TWithBlock;
var
Code: TCodeBuffer;
Tool: TCodeTool;
Node, StatementNode: TCodeTreeNode;
CodeXYPos: TCodeXYPosition;
ListOfWiths: array of TWithBlock;
i, NewStartPos, NewEndPos, p, CommentStartPos, CommentEndPos: Integer;
Filename, OldSource, Src, ID, ExpectedInsertion: String;
aWith: PWithBlock;
begin
Filename:=ExpandFileNameUTF8('moduletests/rt_explodewith.pas');
Code:=CodeToolBoss.LoadFile(Filename,true,false);
AssertEquals('Load file error: '+Filename,true,Code<>nil);
if not CodeToolBoss.Explore(Code,Tool,true) then
AssertEquals('Parse error: ','',CodeToolBoss.ErrorMessage);
// collect all With-Blocks
Node:=Tool.Tree.Root;
SetLength(ListOfWiths,0);
while Node<>nil do begin
if Node.Desc=ctnWithVariable then begin
Tool.CleanPosToCaret(Node.StartPos,CodeXYPos);
StatementNode:=Tool.FindWithBlockStatement(Node);
if StatementNode<>nil then begin
SetLength(ListOfWiths,length(ListOfWiths)+1);
aWith:=@ListOfWiths[High(ListOfWiths)];
aWith^.CodeXYPos:=CodeXYPos;
aWith^.WithExpr:=Tool.ExtractWithBlockExpression(Node,[]);
aWith^.StatementStartPos:=FindPrevNonSpace(Code.Source,StatementNode.StartPos);
aWith^.StatementEndPos:=StatementNode.EndPos;
end;
end;
Node:=Node.Next;
end;
for i:=0 to High(ListOfWiths) do begin
aWith:=@ListOfWiths[i];
CodeXYPos:=aWith^.CodeXYPos;
//debugln(['TTestRefactoring.TestExplodeWith ',dbgs(CodeXYPos)]);
OldSource:=Code.Source;
try
if CodeToolBoss.RemoveWithBlock(Code,CodeXYPos.X,CodeXYPos.Y) then begin
// success
// => check changes
// get new bounds
NewStartPos:=aWith^.StatementStartPos;
NewEndPos:=aWith^.StatementEndPos;
Code.AdjustPosition(NewStartPos);
Code.AdjustPosition(NewEndPos);
if (NewStartPos<1) or (NewStartPos>Code.SourceLength)
or (NewEndPos<1) or (NewEndPos>Code.SourceLength)
or (NewEndPos<NewStartPos)
then begin
debugln(['TTestRefactoring.TestExplodeWith WrongCode: ']);
debugln(Code.Source);
Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos));
end;
// check each marker
Src:=Code.Source;
//debugln(['TTestRefactoring.TestExplodeWith NewBlock=',copy(Src,NewStartPos,NewEndPos-NewStartPos)]);
p:=NewStartPos;
repeat
CommentStartPos:=FindNextComment(Src,p,NewEndPos);
if CommentStartPos>=NewEndPos then break;
p:=CommentStartPos;
CommentEndPos:=FindCommentEnd(Src,CommentStartPos,Tool.Scanner.NestedComments);
if Src[p]='{' then begin
inc(p);
if copy(Src,p,length(ExplodeWithMarker))=ExplodeWithMarker then begin
inc(p,length(ExplodeWithMarker));
ID:=copy(Src,p,CommentEndPos-p-1);
if ID=aWith^.WithExpr then begin
// this marker expects an insertion
ExpectedInsertion:=Id+'.';
if copy(Src,CommentEndPos,length(ExpectedInsertion))<>ExpectedInsertion
then begin
Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos)
+': Expected insertion "'+ExpectedInsertion+'"'
+' at '+Code.AbsoluteToLineColStr(CommentEndPos)
+', but found "'+dbgstr(Src,CommentStartPos,20)+'"');
end;
end;
end;
end;
p:=CommentEndPos;
until false;
end else begin
Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos)+': '+CodeToolBoss.ErrorMessage);
end;
finally
Code.Source:=OldSource;
end;
end;
end;
initialization
RegisterTests([TTestRefactoring]);
end.
|