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