1 {
2  Test with:
3    ./testcodetools --format=plain --suite=TTestRefactoring
4    ./testcodetools --format=plain --suite=TestExplodeWith
5 }
6 unit TestRefactoring;
7 
8 {$i runtestscodetools.inc}
9 
10 interface
11 
12 uses
13   Classes, SysUtils, CodeToolManager, CodeCache, CodeTree, BasicCodeTools,
14   CTUnitGraph, LazLogger, LazFileUtils, Laz_AVL_Tree, fpcunit, testregistry,
15   TestFinddeclaration;
16 
17 const
18   ExplodeWithMarker = 'explodewith:';
19 type
20 
21   { TCustomTestRefactoring }
22 
23   TCustomTestRefactoring = class(TCustomTestFindDeclaration)
24   protected
25     procedure RenameReferences(NewIdentifier: string);
26     procedure CheckDiff(CurCode: TCodeBuffer; const ExpLines: array of string);
27   end;
28 
29   { TTestRefactoring }
30 
31   TTestRefactoring = class(TCustomTestRefactoring)
32   private
33   published
34     procedure TestExplodeWith;
35     procedure TestRenameReferences;
36     procedure TestRenameProcReferences;
37   end;
38 
39 implementation
40 
41 { TCustomTestRefactoring }
42 
43 procedure TCustomTestRefactoring.RenameReferences(NewIdentifier: string);
44 var
45   Marker: TFDMarker;
46   Tool: TCodeTool;
47   DeclX, DeclY, DeclTopLine: integer;
48   DeclCode: TCodeBuffer;
49   Files: TStringList;
50   Graph: TUsesGraph;
51   Completed: boolean;
52   Node: TAVLTreeNode;
53   UGUnit: TUGUnit;
54   DeclarationCaretXY: TPoint;
55   PascalReferences: TAVLTree;
56   OldIdentifier: string;
57 begin
58   if not IsValidIdent(NewIdentifier) then
59     Fail('TCustomTestRefactoring.RenameReferences invalid NewName="'+NewIdentifier+'"');
60   // find marker #Rename
61   ParseSimpleMarkers(Code);
62   if MarkerCount<1 then
63     Fail('missing marker');
64   if MarkerCount>1 then
65     Fail('too many markers');
66   Marker:=Markers[0];
67   if Marker.Kind<>'#' then
68     Fail('expected # marker, but found '+Marker.Kind);
69   if not SameText(Marker.Name,'Rename') then
70     Fail('expected marker #Rename, but found #'+Marker.Name);
71 
72   // find the main declaration
73   if not CodeToolBoss.Explore(Code,Tool,true,false) then
74     Fail('CodeToolBoss.Explore failed');
75   Code.AbsoluteToLineCol(Marker.NameStartPos,DeclarationCaretXY.Y,DeclarationCaretXY.X);
76   if not CodeToolBoss.FindMainDeclaration(Code,
77     DeclarationCaretXY.X,DeclarationCaretXY.Y,
78     DeclCode,DeclX,DeclY,DeclTopLine) then
79   begin
80     Fail('CodeToolBoss.FindMainDeclaration failed '+dbgs(DeclarationCaretXY)+' File='+Code.Filename);
81   end;
82   DeclarationCaretXY:=Point(DeclX,DeclY);
83 
84   CodeToolBoss.GetIdentifierAt(DeclCode,DeclarationCaretXY.X,DeclarationCaretXY.Y,OldIdentifier);
85 
86   // create the file list
87   Files:=TStringList.Create;
88   Graph:=nil;
89   PascalReferences:=nil;
90   try
91     Files.Add(DeclCode.Filename);
92     if CompareFilenames(DeclCode.Filename,Code.Filename)<>0 then
93       Files.Add(DeclCode.Filename);
94 
95     Graph:=CodeToolBoss.CreateUsesGraph;
96     Graph.AddStartUnit(Code.Filename);
97     Graph.AddTargetUnit(DeclCode.Filename);
98     Graph.Parse(true,Completed);
99     Node:=Graph.FilesTree.FindLowest;
100     Files.Clear;
101     while Node<>nil do begin
102       UGUnit:=TUGUnit(Node.Data);
103       Files.Add(UGUnit.Filename);
104       Node:=Node.Successor;
105     end;
106 
107     // search pascal source references
108     if not CodeToolBoss.FindReferencesInFiles(Files,DeclCode,
109         DeclarationCaretXY,true,PascalReferences) then begin
110       Fail('CodeToolBoss.FindReferencesInFiles failed at '+dbgs(DeclarationCaretXY)+' File='+Code.Filename);
111     end;
112 
113     if not CodeToolBoss.RenameIdentifier(PascalReferences,
114       OldIdentifier, NewIdentifier, DeclCode, @DeclarationCaretXY)
115     then begin
116       Fail('CodeToolBoss.RenameIdentifier failed');
117     end;
118 
119   finally
120     CodeToolBoss.FreeTreeOfPCodeXYPosition(PascalReferences);
121     Graph.Free;
122     Files.Free;
123   end;
124 end;
125 
126 procedure TCustomTestRefactoring.CheckDiff(CurCode: TCodeBuffer;
127   const ExpLines: array of string);
128 var
129   CurLine: String;
130   i: Integer;
131   Differ: Boolean;
132 begin
133   //debugln(['TCustomTestRefactoring.CheckDiff ',CurCode.Filename,' ',length(ExpLines)]);
134   if High(ExpLines)=CurCode.LineCount-1 then begin
135     Differ:=false;
136     for i:=0 to High(ExpLines) do begin
137       if ExpLines[i]<>CurCode.GetLine(i,false) then
138         Differ:=true;
139     end;
140     if not Differ then exit;
141   end;
142 
143   debugln('TCustomTestRefactoring.CheckDiff Expected=');
144   for i:=0 to High(ExpLines) do
145     debugln('  ',ExpLines[i]);
146   debugln('TCustomTestRefactoring.CheckDiff Found=');
147   for i:=0 to CurCode.LineCount-1 do
148     debugln('  ',CurCode.GetLine(i,false));
149 
150   debugln('TCustomTestRefactoring.CheckDiff Diff=');
151   for i:=0 to High(ExpLines) do begin
152     if i>=CurCode.LineCount then begin
153       debugln('  Expec: ',ExpLines[i]);
154       debugln('  Found: ');
155     end else begin
156       CurLine:=CurCode.GetLine(i,false);
157       if ExpLines[i]<>CurLine then begin
158         debugln('  Expec: ',ExpLines[i]);
159         debugln('  Found: ',CurLine);
160       end else begin
161         debugln('       : ',ExpLines[i]);
162       end;
163     end;
164   end;
165   for i:=High(ExpLines)+1 to CurCode.LineCount-1 do begin
166     debugln('>>Expec: ');
167     debugln('<<Found: ',CurCode.GetLine(i,false));
168   end;
169 
170   Fail('TCustomTestRefactoring.CheckDiff ');
171 end;
172 
173 { TTestRefactoring }
174 
175 procedure TTestRefactoring.TestExplodeWith;
176 type
177   TWithBlock = record
178     CodeXYPos: TCodeXYPosition;
179     WithExpr: string;
180     StatementStartPos: integer;
181     StatementEndPos: integer;
182   end;
183   PWithBlock = ^TWithBlock;
184 var
185   CurCode: TCodeBuffer;
186   Tool: TCodeTool;
187   Node, StatementNode: TCodeTreeNode;
188   CodeXYPos: TCodeXYPosition;
189   ListOfWiths: array of TWithBlock;
190   i, NewStartPos, NewEndPos, p, CommentStartPos, CommentEndPos: Integer;
191   Filename, OldSource, Src, ID, ExpectedInsertion: String;
192   aWith: PWithBlock;
193 begin
194   Filename:=ExpandFileNameUTF8('moduletests/rt_explodewith.pas');
195   CurCode:=CodeToolBoss.LoadFile(Filename,true,false);
196   AssertEquals('Load file error: '+Filename,true,CurCode<>nil);
197   if not CodeToolBoss.Explore(CurCode,Tool,true) then
198     AssertEquals('Parse error: ','',CodeToolBoss.ErrorMessage);
199   // collect all With-Blocks
200   Node:=Tool.Tree.Root;
201   SetLength(ListOfWiths{%H-},0);
202   while Node<>nil do begin
203     if Node.Desc=ctnWithVariable then begin
204       Tool.CleanPosToCaret(Node.StartPos,CodeXYPos);
205       StatementNode:=Tool.FindWithBlockStatement(Node);
206       if StatementNode<>nil then begin
207         SetLength(ListOfWiths,length(ListOfWiths)+1);
208         aWith:=@ListOfWiths[High(ListOfWiths)];
209         aWith^.CodeXYPos:=CodeXYPos;
210         aWith^.WithExpr:=Tool.ExtractWithBlockExpression(Node,[]);
211         aWith^.StatementStartPos:=FindPrevNonSpace(CurCode.Source,StatementNode.StartPos);
212         aWith^.StatementEndPos:=StatementNode.EndPos;
213       end;
214     end;
215     Node:=Node.Next;
216   end;
217 
218   for i:=0 to High(ListOfWiths) do begin
219     aWith:=@ListOfWiths[i];
220     CodeXYPos:=aWith^.CodeXYPos;
221     //debugln(['TTestRefactoring.TestExplodeWith ',dbgs(CodeXYPos)]);
222     OldSource:=CurCode.Source;
223     try
224       if CodeToolBoss.RemoveWithBlock(CurCode,CodeXYPos.X,CodeXYPos.Y) then begin
225         // success
226         // => check changes
227         // get new bounds
228         NewStartPos:=aWith^.StatementStartPos;
229         NewEndPos:=aWith^.StatementEndPos;
230         CurCode.AdjustPosition(NewStartPos);
231         CurCode.AdjustPosition(NewEndPos);
232         if (NewStartPos<1) or (NewStartPos>CurCode.SourceLength)
233         or (NewEndPos<1) or (NewEndPos>CurCode.SourceLength)
234         or (NewEndPos<NewStartPos)
235         then begin
236           debugln(['TTestRefactoring.TestExplodeWith WrongCode: ']);
237           debugln(CurCode.Source);
238           Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos));
239         end;
240         // check each marker
241         Src:=CurCode.Source;
242         //debugln(['TTestRefactoring.TestExplodeWith NewBlock=',copy(Src,NewStartPos,NewEndPos-NewStartPos)]);
243         p:=NewStartPos;
244         repeat
245           CommentStartPos:=FindNextComment(Src,p,NewEndPos);
246           if CommentStartPos>=NewEndPos then break;
247           p:=CommentStartPos;
248           CommentEndPos:=FindCommentEnd(Src,CommentStartPos,Tool.Scanner.NestedComments);
249           if Src[p]='{' then begin
250             inc(p);
251             if copy(Src,p,length(ExplodeWithMarker))=ExplodeWithMarker then begin
252               inc(p,length(ExplodeWithMarker));
253               ID:=copy(Src,p,CommentEndPos-p-1);
254               if ID=aWith^.WithExpr then begin
255                 // this marker expects an insertion
256                 ExpectedInsertion:=Id+'.';
257                 if copy(Src,CommentEndPos,length(ExpectedInsertion))<>ExpectedInsertion
258                 then begin
259                   Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos)
260                     +': Expected insertion "'+ExpectedInsertion+'"'
261                     +' at '+CurCode.AbsoluteToLineColStr(CommentEndPos)
262                     +', but found "'+dbgstr(Src,CommentStartPos,20)+'"');
263                 end;
264               end;
265             end;
266           end;
267           p:=CommentEndPos;
268         until false;
269 
270 
271       end else begin
272         Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos)+': '+CodeToolBoss.ErrorMessage);
273       end;
274     finally
275       CurCode.Source:=OldSource;
276     end;
277   end;
278 end;
279 
280 procedure TTestRefactoring.TestRenameReferences;
281 begin
282   StartProgram;
283   Add([
284   'var Cow: longint;',
285   'begin',
286   '  cow{#Rename}:=3;',
287   '  test1.cow:=4;',
288   'end.',
289   '']);
290   RenameReferences('Bird');
291   CheckDiff(Code,[
292   'program test1;',
293   '',
294   '{$mode objfpc}{$H+}',
295   '',
296   'var Bird: longint;',
297   'begin',
298   '  Bird{#Rename}:=3;',
299   '  test1.Bird:=4;',
300   'end.',
301   '']);
302 end;
303 
304 procedure TTestRefactoring.TestRenameProcReferences;
305 begin
306   StartProgram;
307   Add([
308   'procedure Cow;',
309   'begin',
310   'end;',
311   '',
312   'begin',
313   '  cow{#Rename};',
314   '  p:=@Cow;',
315   '  test1.cow;',
316   '  p:=@test1.Cow;',
317   'end.',
318   '']);
319   RenameReferences('Bird');
320   CheckDiff(Code,[
321   'program test1;',
322   '',
323   '{$mode objfpc}{$H+}',
324   '',
325   'procedure Bird;',
326   'begin',
327   'end;',
328   '',
329   'begin',
330   '  Bird{#Rename};',
331   '  p:=@Bird;',
332   '  test1.Bird;',
333   '  p:=@test1.Bird;',
334   'end.',
335   '']);
336 end;
337 
338 initialization
339   RegisterTests([TTestRefactoring]);
340 end.
341 
342