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