{ Test with: ./testcodetools --format=plain --suite=TTestRefactoring ./testcodetools --format=plain --suite=TestExplodeWith } unit TestRefactoring; {$i runtestscodetools.inc} interface uses Classes, SysUtils, Contnrs, fpcunit, AVL_Tree, LazLogger, LazFileUtils, testregistry, CodeToolManager, CodeCache, CodeTree, BasicCodeTools, CTUnitGraph, FindDeclarationTool, ChangeDeclarationTool, CustomCodeTool, LinkScanner, TestGlobals, TestFinddeclaration; const ExplodeWithMarker = 'explodewith:'; type { TCustomTestRefactoring } TCustomTestRefactoring = class(TCustomTestFindDeclaration) protected procedure RenameReferences(NewIdentifier: string; const Flags: TFindRefsFlags = []); procedure RenameSourceName(NewName, NewFilename: string); procedure RenameSourceName(NewName, NewFilename: string; const AddFiles: array of string); procedure RenameUsedUnitRefs(UsedUnit: TCodeBuffer; NewName, NewFilename: string); // only in Code, not in UsedUnit procedure RenameUsedUnitRefs(UsedUnit: TCodeBuffer; NewName, NewFilename: string; const AddFiles: array of string); procedure CheckDiff(CurCode: TCodeBuffer; const ExpLines: array of string); end; { TTestRefactoring } TTestRefactoring = class(TCustomTestRefactoring) private protected published procedure TestExplodeWith; procedure TestIdentifierHasKeywords; procedure TestRenameVarReferences; procedure TestRenameProcReferences; procedure TestRenameProcedureArg; procedure TestRenameProcedureArgCaseSensitive; procedure TestRenameForwardProcedureArgDown; procedure TestRenameForwardProcedureArgUp; procedure TestRenameMethodArgDown; procedure TestRenameMethodArgUp; procedure TestRenameMethodInherited; procedure TestRenameMethodWithOverrides; procedure TestRenameMethodWithOverridesOtherUnit; procedure TestRenameClassMethodWithOverrides; procedure TestRenameNestedProgramProcDown; procedure TestRenameNestedProgramProcUp; procedure TestRenameNestedUnitProcDown; procedure TestRenameTypeToAmp; // rename program procedure TestRenameProgramName_Amp; procedure TestRenameProgramName_DottedSameCount; procedure TestRenameProgramName_MakeDotted; procedure TestRenameProgramName_DottedAppendThird; procedure TestRenameProgramName_DottedPrependThird; procedure TestRenameProgramName_DottedInsertThird; procedure TestRenameProgramName_DottedShortenStart; procedure TestRenameProgramName_DottedShortenMiddle; procedure TestRenameProgramName_DottedShortenEnd; procedure TestRenameProgramName_ToraToraTora; // rename unit procedure TestRenameUnitName_IncludeUsedTwiceInOneUnit; procedure TestRenameUnitName_IncludeUsedInTwoUnits; // rename uses procedure TestUseOmittedNamespace; procedure TestRenameUsedUnit_Amp; procedure TestRenameUsedUnit_Impl; procedure TestRenameUsedUnit_FN_KeepShort; procedure TestRenameUsedUnit_InFilename; procedure TestRenameUsedUnit_LongestUnitnameWins; end; implementation { TCustomTestRefactoring } procedure TCustomTestRefactoring.RenameReferences(NewIdentifier: string; const Flags: TFindRefsFlags ); var Marker: TFDMarker; Tool: TCodeTool; DeclX, DeclY, DeclTopLine: integer; DeclCode: TCodeBuffer; Files: TStringList; Graph: TUsesGraph; Completed: boolean; Node: TAVLTreeNode; UGUnit: TUGUnit; DeclarationCaretXY: TPoint; PascalReferences: TAVLTree; OldIdentifier: string; begin if not IsDottedIdentifier(NewIdentifier) then Fail('TCustomTestRefactoring.RenameReferences invalid NewName="'+NewIdentifier+'"'); // find marker #Rename ParseSimpleMarkers(Code); if MarkerCount<1 then Fail('missing marker'); if MarkerCount>1 then Fail('too many markers'); Marker:=Markers[0]; if Marker.Kind<>'#' then Fail('expected # marker, but found '+Marker.Kind); if not SameText(Marker.Name,'Rename') then Fail('expected marker #Rename, but found #'+Marker.Name); // find the main declaration if not CodeToolBoss.Explore(Code,Tool,true,false) then Fail('CodeToolBoss.Explore failed'); Code.AbsoluteToLineCol(Marker.NameStartPos,DeclarationCaretXY.Y,DeclarationCaretXY.X); if not CodeToolBoss.FindMainDeclaration(Code, DeclarationCaretXY.X,DeclarationCaretXY.Y, DeclCode,DeclX,DeclY,DeclTopLine) then begin Fail('CodeToolBoss.FindMainDeclaration failed '+dbgs(DeclarationCaretXY)+' File='+Code.Filename); end; //debugln(['TCustomTestRefactoring.RenameReferences X=',DeclX,' Y=',DeclY,' "',DeclCode.GetLine(DeclY-1,false),'"']); DeclarationCaretXY:=Point(DeclX,DeclY); CodeToolBoss.GetIdentifierAt(DeclCode,DeclarationCaretXY.X,DeclarationCaretXY.Y,OldIdentifier); // create the file list Files:=TStringList.Create; Graph:=nil; PascalReferences:=nil; try Files.Add(DeclCode.Filename); if CompareFilenames(DeclCode.Filename,Code.Filename)<>0 then Files.Add(Code.Filename); Graph:=CodeToolBoss.CreateUsesGraph; Graph.AddStartUnit(Code.Filename); Graph.AddTargetUnit(DeclCode.Filename); Graph.Parse(true,Completed); Node:=Graph.FilesTree.FindLowest; Files.Clear; while Node<>nil do begin UGUnit:=TUGUnit(Node.Data); //debugln(['TCustomTestRefactoring.RenameReferences ',UGUnit.Filename]); Files.Add(UGUnit.Filename); Node:=Node.Successor; end; // search pascal source references if not CodeToolBoss.FindReferencesInFiles(Files,DeclCode, DeclarationCaretXY,true,PascalReferences,Flags) then begin Fail('CodeToolBoss.FindReferencesInFiles failed at '+dbgs(DeclarationCaretXY)+' File='+Code.Filename); end; // todo: check for conflicts if not CodeToolBoss.RenameIdentifier(PascalReferences, OldIdentifier, NewIdentifier, DeclCode, @DeclarationCaretXY) then Fail('CodeToolBoss.RenameIdentifier failed'); finally CodeToolBoss.FreeTreeOfPCodeXYPosition(PascalReferences); Graph.Free; Files.Free; end; end; procedure TCustomTestRefactoring.RenameSourceName(NewName, NewFilename: string); begin RenameSourceName(NewName,NewFilename,[]); end; procedure TCustomTestRefactoring.RenameSourceName(NewName, NewFilename: string; const AddFiles: array of string); var Files: TStringList; ListOfSrcNameRefs: TObjectList; i: Integer; begin // create the file list ListOfSrcNameRefs:=nil; Files:=TStringList.Create; try // search pascal source references in Code Files.Add(Code.Filename); for i:=0 to length(AddFiles)-1 do Files.Add(AddFiles[i]); if not CodeToolBoss.FindSourceNameReferences(Code.Filename,Files,false,ListOfSrcNameRefs) then begin Fail('CodeToolBoss.FindSourceNameReferences failed File='+Code.Filename); end; // rename if not CodeToolBoss.RenameSourceNameReferences(Code.Filename,NewFilename,NewName,ListOfSrcNameRefs) then Fail('CodeToolBoss.RenameSourceNameReferences failed'); finally ListOfSrcNameRefs.Free; Files.Free; end; end; procedure TCustomTestRefactoring.RenameUsedUnitRefs(UsedUnit: TCodeBuffer; NewName, NewFilename: string); var Files: TStringList; ListOfSrcNameRefs: TObjectList; begin // create the file list ListOfSrcNameRefs:=nil; Files:=TStringList.Create; try // search pascal source references in Code Files.Add(Code.Filename); if not CodeToolBoss.FindSourceNameReferences(UsedUnit.Filename,Files,false,ListOfSrcNameRefs) then begin Fail('CodeToolBoss.FindSourceNameReferences failed File='+Code.Filename); end; // rename if not CodeToolBoss.RenameSourceNameReferences(UsedUnit.Filename,NewFilename,NewName,ListOfSrcNameRefs) then Fail('CodeToolBoss.RenameSourceNameReferences failed'); finally ListOfSrcNameRefs.Free; Files.Free; end; end; procedure TCustomTestRefactoring.RenameUsedUnitRefs(UsedUnit: TCodeBuffer; NewName, NewFilename: string; const AddFiles: array of string); var Files: TStringList; ListOfSrcNameRefs: TObjectList; i: Integer; begin // create the file list ListOfSrcNameRefs:=nil; Files:=TStringList.Create; try // search pascal source references in Code Files.Add(UsedUnit.Filename); Files.Add(Code.Filename); for i:=0 to length(AddFiles)-1 do Files.Add(AddFiles[i]); if not CodeToolBoss.FindSourceNameReferences(UsedUnit.Filename,Files,false,ListOfSrcNameRefs) then begin Fail('CodeToolBoss.FindSourceNameReferences failed File='+Code.Filename); end; // rename if not CodeToolBoss.RenameSourceNameReferences(UsedUnit.Filename,NewFilename,NewName,ListOfSrcNameRefs) then Fail('CodeToolBoss.RenameSourceNameReferences failed'); finally ListOfSrcNameRefs.Free; Files.Free; end; end; procedure TCustomTestRefactoring.CheckDiff(CurCode: TCodeBuffer; const ExpLines: array of string); var CurLine: String; i: Integer; Differ: Boolean; begin //debugln(['TCustomTestRefactoring.CheckDiff ',CurCode.Filename,' ',length(ExpLines)]); if High(ExpLines)=CurCode.LineCount-1 then begin Differ:=false; for i:=0 to High(ExpLines) do begin if ExpLines[i]<>CurCode.GetLine(i,false) then Differ:=true; end; if not Differ then exit; end; debugln('TCustomTestRefactoring.CheckDiff Expected='); for i:=0 to High(ExpLines) do debugln(' ',ExpLines[i]); debugln('TCustomTestRefactoring.CheckDiff Found='); for i:=0 to CurCode.LineCount-1 do debugln(' ',CurCode.GetLine(i,false)); debugln('TCustomTestRefactoring.CheckDiff Diff='); for i:=0 to High(ExpLines) do begin if i>=CurCode.LineCount then begin debugln(' Expec: ',ExpLines[i]); debugln(' Found: '); end else begin CurLine:=CurCode.GetLine(i,false); if ExpLines[i]<>CurLine then begin debugln(' Expec: ',ExpLines[i]); debugln(' Found: ',CurLine); end else begin debugln(' : ',ExpLines[i]); end; end; end; for i:=High(ExpLines)+1 to CurCode.LineCount-1 do begin debugln('>>Expec: '); debugln('<nil); if not CodeToolBoss.Explore(CurCode,Tool,true) then AssertEquals('Parse error: ','',CodeToolBoss.ErrorMessage); // collect all With-Blocks Node:=Tool.Tree.Root; SetLength(ListOfWiths{%H-},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(CurCode.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:=CurCode.Source; try if CodeToolBoss.RemoveWithBlock(CurCode,CodeXYPos.X,CodeXYPos.Y) then begin // success // => check changes // get new bounds NewStartPos:=aWith^.StatementStartPos; NewEndPos:=aWith^.StatementEndPos; CurCode.AdjustPosition(NewStartPos); CurCode.AdjustPosition(NewEndPos); if (NewStartPos<1) or (NewStartPos>CurCode.SourceLength) or (NewEndPos<1) or (NewEndPos>CurCode.SourceLength) or (NewEndPosExpectedInsertion then begin Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos) +': Expected insertion "'+ExpectedInsertion+'"' +' at '+CurCode.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 CurCode.Source:=OldSource; end; end; end; procedure TTestRefactoring.TestIdentifierHasKeywords; procedure t(const Identifier: string; cm: TCompilerMode; const ExpectedAmp: string); var AmpIdentifier: string; r: Boolean; begin r:=IdentifierHasKeywords(Identifier, cm, AmpIdentifier); if AmpIdentifier<>ExpectedAmp then Fail('Identifier="'+Identifier+'" cm='+CompilerModeNames[cm]+' expected "'+ExpectedAmp+'", but got "'+AmpIdentifier+'"'); AssertEquals('Result',Identifier<>AmpIdentifier,r); end; begin t('a',cmFPC,'a'); t('a.b',cmFPC,'a.b'); t('a.&b',cmFPC,'a.&b'); t('a.Type',cmFPC,'a.&Type'); t('End.Type',cmFPC,'&End.&Type'); end; procedure TTestRefactoring.TestRenameVarReferences; begin StartProgram; Add([ 'var Cow: longint;', 'begin', ' cow{#Rename}:=3;', ' test1.cow:=4;', 'end.', '']); RenameReferences('Bird'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'var Bird: longint;', 'begin', ' Bird{#Rename}:=3;', ' test1.Bird:=4;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProcReferences; begin StartProgram; Add([ 'procedure Cow;', 'begin', 'end;', '', 'begin', ' cow{#Rename};', ' p:=@Cow;', ' test1.cow;', ' p:=@test1.Cow;', 'end.', '']); RenameReferences('Bird'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'procedure Bird;', 'begin', 'end;', '', 'begin', ' Bird{#Rename};', ' p:=@Bird;', ' test1.Bird;', ' p:=@test1.Bird;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProcedureArg; begin StartProgram; Add([ 'procedure Fly(Size{#Rename}: word);', '', ' procedure Sub1;', ' var Size: byte;', ' begin', ' Size:=3;', ' end;', '', ' procedure Sub2(Size: word);', ' begin', ' Size:=4;', ' end;', 'begin', ' Size:=Size+1;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Bird'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'procedure Fly(Bird{#Rename}: word);', '', ' procedure Sub1;', ' var Size: byte;', ' begin', ' Size:=3;', ' end;', '', ' procedure Sub2(Size: word);', ' begin', ' Size:=4;', ' end;', 'begin', ' Bird:=Bird+1;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameProcedureArgCaseSensitive; begin StartProgram; Add([ 'procedure Fly(Size{#Rename}: word);', '', ' procedure Sub1;', ' var Size: byte;', ' begin', ' Size:=3;', ' end;', '', ' procedure Sub2(Size: word);', ' begin', ' Size:=4;', ' end;', 'begin', ' Size:=Size+1;', 'end;', '', 'begin', 'end.', '']); RenameReferences('siZe'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'procedure Fly(siZe{#Rename}: word);', '', ' procedure Sub1;', ' var Size: byte;', ' begin', ' Size:=3;', ' end;', '', ' procedure Sub2(Size: word);', ' begin', ' Size:=4;', ' end;', 'begin', ' siZe:=siZe+1;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameForwardProcedureArgDown; begin StartProgram; Add([ 'procedure Fly(Size{#Rename}: word); forward;', '', 'procedure Fly(Size: word);', 'begin', ' Size:=Size+1;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Bird'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'procedure Fly(Bird{#Rename}: word); forward;', '', 'procedure Fly(Bird: word);', 'begin', ' Bird:=Bird+1;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameForwardProcedureArgUp; begin StartProgram; Add([ 'procedure Fly(Size: word); forward;', '', 'procedure Fly(Size{#Rename}: word);', 'begin', ' Size:=Size+1;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Bird'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'procedure Fly(Bird: word); forward;', '', 'procedure Fly(Bird{#Rename}: word);', 'begin', ' Bird:=Bird+1;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameMethodArgDown; begin StartProgram; Add([ 'type', ' TBird = class', ' procedure Fly(Size{#Rename}: word);', ' end;', '', 'procedure TBird.Fly(Size: word);', 'begin', ' Size:=Size+1;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Width'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'type', ' TBird = class', ' procedure Fly(Width{#Rename}: word);', ' end;', '', 'procedure TBird.Fly(Width: word);', 'begin', ' Width:=Width+1;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameMethodArgUp; begin StartProgram; Add([ 'type', ' TBird = class', ' procedure Fly(Size: word);', ' end;', '', 'procedure TBird.Fly(Size{#Rename}: word);', 'begin', ' Size:=Size+1;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Width'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'type', ' TBird = class', ' procedure Fly(Width: word);', ' end;', '', 'procedure TBird.Fly(Width{#Rename}: word);', 'begin', ' Width:=Width+1;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameMethodInherited; begin StartProgram; Add([ 'type', ' TAnimal = class', ' procedure Fly{#Rename}; virtual;', ' end;', ' TBird = class(TAnimal)', ' procedure Fly; override;', ' end;', '', 'procedure TAnimal.Fly;', 'begin', 'end;', '', 'procedure TBird.Fly;', 'begin', ' inherited Fly;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Run'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'type', ' TAnimal = class', ' procedure Run{#Rename}; virtual;', ' end;', ' TBird = class(TAnimal)', ' procedure Fly; override;', ' end;', '', 'procedure TAnimal.Run;', 'begin', 'end;', '', 'procedure TBird.Fly;', 'begin', ' inherited Run;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameMethodWithOverrides; begin StartProgram; Add([ 'type', ' TAnimal = class', ' procedure Fly{#Rename}; virtual;', ' end;', ' TFlying = class(TAnimal)', ' end;', ' TBird = class(TFlying)', ' procedure Eat;', ' procedure Fly; override;', ' end;', '', 'procedure TAnimal.Fly;', 'begin', 'end;', '', 'procedure TBird.Eat;', 'begin', ' inherited Fly;', ' Fly;', ' // Fly', 'end;', '', 'procedure TBird.Fly;', 'begin', ' inherited Fly;', ' Fly;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Run',[frfMethodOverrides]); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'type', ' TAnimal = class', ' procedure Run{#Rename}; virtual;', ' end;', ' TFlying = class(TAnimal)', ' end;', ' TBird = class(TFlying)', ' procedure Eat;', ' procedure Run; override;', ' end;', '', 'procedure TAnimal.Run;', 'begin', 'end;', '', 'procedure TBird.Eat;', 'begin', ' inherited Run;', ' Run;', ' // Run', 'end;', '', 'procedure TBird.Run;', 'begin', ' inherited Run;', ' Run;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameMethodWithOverridesOtherUnit; var DeclUnit: TCodeBuffer; begin DeclUnit:=nil; try DeclUnit:=CodeToolBoss.CreateFile('decl.pp'); DeclUnit.Source:='unit Decl;'+LineEnding +'interface'+LineEnding +'type'+LineEnding +' TAnimal = class'+LineEnding +' procedure Walk(a: word); virtual; abstract;'+LineEnding +' end;'+LineEnding +' TBird = class(TAnimal)'+LineEnding +' procedure Walk(b: longint); virtual; abstract;'+LineEnding +' procedure Walk(a: word); override;'+LineEnding +' end;'+LineEnding +'implementation'+LineEnding +'procedure TBird.Walk(a: word);'+LineEnding +'begin end;'+LineEnding +'end.'; StartUnit; Add([ 'uses Decl;', 'type', ' TBear = class(TAnimal)', ' procedure Charge;', ' end;', ' TEagle = class(TBird)', ' procedure Walk(c: int64);', ' procedure Walk(a: word); override;', ' end;', ' TBig = class(TEagle)', ' procedure Walk(b: longint); override;', ' procedure Walk(a: word); override;', ' end;', 'implementation', '', 'procedure TBear.Charge;', 'var aWord: word;', 'begin', ' Walk{#Rename}(aWord);', 'end;', '', 'procedure TEagle.Walk(c: int64);', 'begin', ' Walk(c);', ' Walk(word(c));', 'end;', '', 'procedure TEagle.Walk(a: word);', 'begin', ' Walk(c);', ' Walk(word(c));', 'end;', '', 'procedure TBig.Walk(b: longint);', 'begin', ' Walk(b);', ' Walk(word(b));', 'end;', '', 'procedure TBig.Walk(a: word);', 'begin', ' Walk(a);', ' Walk(longint(a));', 'end;', '', 'end.', '']); RenameReferences('Run',[frfMethodOverrides]); CheckDiff(Code,[ 'unit test1;', '', '{$mode objfpc}{$H+}', '', 'interface', '', 'uses Decl;', 'type', ' TBear = class(TAnimal)', ' procedure Charge;', ' end;', ' TEagle = class(TBird)', ' procedure Walk(c: int64);', ' procedure Run(a: word); override;', ' end;', ' TBig = class(TEagle)', ' procedure Walk(b: longint); override;', ' procedure Run(a: word); override;', ' end;', 'implementation', '', 'procedure TBear.Charge;', 'var aWord: word;', 'begin', ' Run{#Rename}(aWord);', 'end;', '', 'procedure TEagle.Walk(c: int64);', 'begin', ' Walk(c);', ' Run(word(c));', 'end;', '', 'procedure TEagle.Run(a: word);', 'begin', ' Walk(c);', ' Run(word(c));', 'end;', '', 'procedure TBig.Walk(b: longint);', 'begin', ' Walk(b);', ' Run(word(b));', 'end;', '', 'procedure TBig.Run(a: word);', 'begin', ' Run(a);', ' Walk(longint(a));', 'end;', '', 'end.', '']); finally if DeclUnit<>nil then DeclUnit.IsDeleted:=true; end; end; procedure TTestRefactoring.TestRenameClassMethodWithOverrides; begin StartProgram; Add([ 'type', ' TOuter = class', ' public type', ' TAnimal = class', ' class procedure Fly{#Rename}; virtual;', ' end;', ' TBird = class(TAnimal)', ' class procedure Eat;', ' class procedure Fly; override;', ' end;', ' end;', '', 'class procedure TOuter.TAnimal.Fly;', 'begin', 'end;', '', 'class procedure TOuter.TBird.Eat;', 'begin', ' TOuter.TAnimal.Fly;', ' TOuter.TBird.Fly;', ' Test1.TOuter.TAnimal.Fly;', ' Test1.TOuter.TBird.Fly;', ' // TOuter.TAnimal.Fly', ' // TOuter.TBird.Fly', ' // Test1.TOuter.TAnimal.Fly;', ' // Test1.TOuter.TBird.Fly;', 'end;', '', 'class procedure TOuter.TBird.Fly;', 'begin', 'end;', '', 'begin', 'end.', '']); RenameReferences('Run',[frfMethodOverrides]); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'type', ' TOuter = class', ' public type', ' TAnimal = class', ' class procedure Run{#Rename}; virtual;', ' end;', ' TBird = class(TAnimal)', ' class procedure Eat;', ' class procedure Run; override;', ' end;', ' end;', '', 'class procedure TOuter.TAnimal.Run;', 'begin', 'end;', '', 'class procedure TOuter.TBird.Eat;', 'begin', ' TOuter.TAnimal.Run;', ' TOuter.TBird.Run;', ' Test1.TOuter.TAnimal.Run;', ' Test1.TOuter.TBird.Run;', ' // TOuter.TAnimal.Run', ' // TOuter.TBird.Run', ' // Test1.TOuter.TAnimal.Run;', ' // Test1.TOuter.TBird.Run;', 'end;', '', 'class procedure TOuter.TBird.Run;', 'begin', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameNestedProgramProcDown; begin StartProgram; Add([ 'type', ' TBird = class', ' procedure Fly;', ' procedure Run;', ' end;', '', 'procedure TBird.Fly;', ' procedure Sub{#Rename}; forward;', ' procedure Sub;', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'procedure TBird.Run;', ' procedure Sub;', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Glide'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'type', ' TBird = class', ' procedure Fly;', ' procedure Run;', ' end;', '', 'procedure TBird.Fly;', ' procedure Glide{#Rename}; forward;', ' procedure Glide;', ' begin', ' end;', 'begin', ' Glide;', 'end;', '', 'procedure TBird.Run;', ' procedure Sub;', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameNestedProgramProcUp; begin StartProgram; Add([ 'type', ' TBird = class', ' procedure Fly;', ' procedure Run;', ' end;', '', 'procedure TBird.Fly;', '', ' procedure Sub; forward;', ' procedure Sub{#Rename};', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'procedure TBird.Run;', ' procedure Sub;', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'begin', 'end.', '']); RenameReferences('Glide'); CheckDiff(Code,[ 'program test1;', '', '{$mode objfpc}{$H+}', '', 'type', ' TBird = class', ' procedure Fly;', ' procedure Run;', ' end;', '', 'procedure TBird.Fly;', '', ' procedure Glide; forward;', ' procedure Glide{#Rename};', ' begin', ' end;', 'begin', ' Glide;', 'end;', '', 'procedure TBird.Run;', ' procedure Sub;', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'begin', 'end.', '']); end; procedure TTestRefactoring.TestRenameNestedUnitProcDown; begin StartUnit; Add([ 'type', ' TBird = class', ' procedure Fly;', ' procedure Run;', ' end;', '', 'implementation', '', 'procedure TBird.Fly;', '', ' procedure Sub; forward;', ' procedure Sub{#Rename};', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'procedure TBird.Run;', ' procedure Sub;', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'begin', 'end.', '', 'end.', '']); RenameReferences('Glide'); CheckDiff(Code,[ 'unit test1;', '', '{$mode objfpc}{$H+}', '', 'interface', '', 'type', ' TBird = class', ' procedure Fly;', ' procedure Run;', ' end;', '', 'implementation', '', 'procedure TBird.Fly;', '', ' procedure Glide; forward;', ' procedure Glide{#Rename};', ' begin', ' end;', 'begin', ' Glide;', 'end;', '', 'procedure TBird.Run;', ' procedure Sub;', ' begin', ' end;', 'begin', ' Sub;', 'end;', '', 'begin', 'end.', '', 'end.', '']); end; procedure TTestRefactoring.TestRenameTypeToAmp; begin StartUnit; Add([ 'type', ' TFoo{#Rename} = word;', ' TBar = low(TFoo)..high(TFoo);', 'implementation', 'type', ' TBird = low(TFoo)..high(TFoo);', 'end.', '']); RenameReferences('&End'); CheckDiff(Code,[ 'unit test1;', '', '{$mode objfpc}{$H+}', '', 'interface', '', 'type', ' &End{#Rename} = word;', ' TBar = low(&End)..high(&End);', 'implementation', 'type', ' TBird = low(&End)..high(&End);', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_Amp; begin Add([ 'program test1;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: test1 . TRed;', 'begin', ' test1.c:=&test1 . &c;', 'end.', '']); RenameSourceName('&End','end.pas'); CheckDiff(Code,[ 'program &End;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: &End . TRed;', 'begin', ' &End.c:=&End . &c;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_DottedSameCount; begin Add([ 'program Foo.Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: foo . bar . TRed;', 'begin', ' foo.bar.c:=&foo . &bar . &c;', 'end.', '']); RenameSourceName('Foo.&End','foo.end.pas'); CheckDiff(Code,[ 'program Foo.&End;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . &End . TRed;', 'begin', ' Foo.&End.c:=Foo . &End . &c;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_MakeDotted; begin Add([ 'program &Type;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: &Type . TRed;', 'begin', ' &type.c:=&type . &c;', 'end.', '']); RenameSourceName('Foo.&End','foo.end.pas'); CheckDiff(Code,[ 'program Foo.&End;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo.&End . TRed;', 'begin', ' Foo.&End.c:=Foo.&End . &c;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_DottedAppendThird; begin Add([ 'program Foo . Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . Bar . TRed;', 'begin', ' foo.bar.c:=&foo . bar . &c;', 'end.', '']); RenameSourceName('Foo.Bar.&End','foo.bar.end.pas'); CheckDiff(Code,[ 'program Foo . Bar.&End;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . Bar.&End . TRed;', 'begin', ' Foo.Bar.&End.c:=Foo . Bar.&End . &c;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_DottedPrependThird; begin Add([ 'program Foo . Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . Bar . TRed;', 'begin', ' foo.bar.c:=&foo . bar . &c;', 'end.', '']); RenameSourceName('&Unit.Foo.Bar','unit.foo.bar.pas'); CheckDiff(Code,[ 'program &Unit.Foo . Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: &Unit.Foo . Bar . TRed;', 'begin', ' &Unit.Foo.Bar.c:=&Unit.Foo . Bar . &c;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_DottedInsertThird; begin Add([ 'program Foo . Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . Bar . TRed;', 'begin', ' foo.bar.c:=&foo . bar . &c;', 'end.', '']); RenameSourceName('Foo.&Unit.Bar','foo.unit.bar.pas'); CheckDiff(Code,[ 'program Foo . &Unit.Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . &Unit.Bar . TRed;', 'begin', ' Foo.&Unit.Bar.c:=Foo . &Unit.Bar . &c;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_DottedShortenStart; begin Add([ 'program &Type . Foo . Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: &Type . Foo . Bar . TRed;', 'begin', ' &TYpe.foo.bar.c:=&Type . &foo . bar . &c;', ' {$IFDEF FPC}&Type.{$ENDIF}foo.bar:={$IFDEF FPC}&Type.Foo.{$ENDIF}bar;', 'end.', '']); RenameSourceName('Foo.Bar','foo.bar.pas'); CheckDiff(Code,[ 'program Foo . Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . Bar . TRed;', 'begin', ' Foo.Bar.c:=Foo . Bar . &c;', ' {$IFDEF FPC}{$ENDIF}Foo.Bar:={$IFDEF FPC}Foo.{$ENDIF}Bar;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_DottedShortenMiddle; begin Add([ 'program &Type . Foo . Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: &Type . Foo . Bar . TRed;', 'begin', ' &TYpe.foo.bar.c:=&Type . &foo . bar . &c;', ' {$ifdef fpc}&type.{$endif}foo{$ifdef fpc}.bar{$endif};', 'end.', '']); RenameSourceName('&Type.Bar','type.bar.pas'); CheckDiff(Code,[ 'program &Type .Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: &Type .Bar . TRed;', 'begin', ' &Type.Bar.c:=&Type .Bar . &c;', ' {$ifdef fpc}&Type.{$endif}{$ifdef fpc}Bar{$endif};', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_DottedShortenEnd; begin Add([ 'program Foo . Bar.&End;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . Bar . &End . TRed;', 'begin', ' foo.bar.&end.c:=&foo . bar.&end . &c;', 'end.', '']); RenameSourceName('Foo.Bar','foo.bar.pas'); CheckDiff(Code,[ 'program Foo . Bar;', '{$mode objfpc}{$H+}', 'type TRed = word;', 'var c: Foo . Bar . TRed;', 'begin', ' Foo.Bar.c:=Foo . Bar . &c;', 'end.', '']); end; procedure TTestRefactoring.TestRenameProgramName_ToraToraTora; var ToraUnit: TCodeBuffer; begin ToraUnit:=CodeToolBoss.CreateFile('tora.pas'); try ToraUnit.Source:=LinesToStr([ 'unit Tora;', 'interface', 'implementation', 'end.']); Add([ 'program tora.tora.{comment}tora;', '{$mode objFPC}', 'uses tora;', 'var Toranaga: longint;', 'begin', ' Toranaga:=3;', ' tora.tora.tora.Toranaga:=3*Toranaga;', ' tora.{}tora.{comment}tora.{}Toranaga:=3*tora.tora.tora.Toranaga;', 'end.', '']); RenameSourceName('Red.Green.Blue','red.green.blue.pas'); CheckDiff(Code,[ 'program Red.Green.{comment}Blue;', '{$mode objFPC}', 'uses tora;', 'var Toranaga: longint;', 'begin', ' Toranaga:=3;', ' Red.Green.Blue.Toranaga:=3*Toranaga;', ' Red.{}Green.{comment}Blue.{}Toranaga:=3*Red.Green.Blue.Toranaga;', 'end.', '']); finally ToraUnit.IsDeleted:=true; end; end; procedure TTestRefactoring.TestRenameUnitName_IncludeUsedTwiceInOneUnit; var RedInc: TCodeBuffer; begin RedInc:=CodeToolBoss.CreateFile('red.inc'); try RedInc.Source:= '{$IFDEF EnableIntf}'+LineEnding +'function Fly: Test1.TBird;'+LineEnding +'{$ENDIF}'+LineEnding +'{$IFDEF EnableImpl}'+LineEnding +'function Fly: Test1.TBird;'+LineEnding +'begin'+LineEnding +' Test1.Ant:=test1.ant;'+LineEnding +'end;'+LineEnding +'{$ENDIF}'+LineEnding; Add([ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'type TAnt = word;', '{$define EnableIntf}', '{$i red.inc}', '{$undefine EnableIntf}', 'implementation', '{$define EnableImpl}', '{$i red.inc}', '{$undefine EnableIntf}', 'end.', '']); RenameSourceName('&End','End.pas'); CheckDiff(Code,[ 'unit &End;', '{$mode objfpc}{$H+}', 'interface', 'type TAnt = word;', '{$define EnableIntf}', '{$i red.inc}', '{$undefine EnableIntf}', 'implementation', '{$define EnableImpl}', '{$i red.inc}', '{$undefine EnableIntf}', 'end.', '']); CheckDiff(RedInc,[ '{$IFDEF EnableIntf}', 'function Fly: &End.TBird;', '{$ENDIF}', '{$IFDEF EnableImpl}', 'function Fly: &End.TBird;', 'begin', ' &End.Ant:=&End.ant;', 'end;', '{$ENDIF}']); finally RedInc.IsDeleted:=true; end; end; procedure TTestRefactoring.TestRenameUnitName_IncludeUsedInTwoUnits; var RedInc, RedGreenUnit: TCodeBuffer; begin RedInc:=CodeToolBoss.CreateFile('red.inc'); RedGreenUnit:=CodeToolBoss.CreateFile('red.green.pas'); try RedInc.Source:=LinesToStr([ 'function Fly: Red.Green.TAnt;', 'begin', ' red.green.Ant:=3;', 'end;']); RedGreenUnit.Source:=LinesToStr([ 'unit Red.Green;', 'interface', 'type TAnt = word;', 'var Ant: TAnt;', 'implementation', '{$I red.inc}', 'var Hop: red.green.TAnt;', 'end.']); Add([ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'uses Red.Green;', 'implementation', '{$I red.inc}', 'begin', ' red.green.ant:=2;', 'end.', '']); RenameUsedUnitRefs(RedGreenUnit,'&End','end.pas',[]); CheckDiff(Code,[ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'uses &End;', 'implementation', '{$I red.inc}', 'begin', ' &End.ant:=2;', 'end.', '']); CheckDiff(RedGreenUnit,[ 'unit &End;', 'interface', 'type TAnt = word;', 'var Ant: TAnt;', 'implementation', '{$I red.inc}', 'var Hop: &End.TAnt;', 'end.']); CheckDiff(RedInc,[ 'function Fly: &End.TAnt;', 'begin', ' &End.Ant:=3;', 'end;']); finally RedInc.IsDeleted:=true; RedGreenUnit.IsDeleted:=true; end; end; procedure TTestRefactoring.TestUseOmittedNamespace; procedure t(const OldShort, OldFull, NewFull, Expected: string); var Actual: String; begin Actual:=TChangeDeclarationTool.UseOmittedNamespace(OldShort, OldFull, NewFull); if Actual=Expected then exit; Fail('OldShort="'+OldShort+'" OldFull="'+OldFull+'" NewFull="'+NewFull+'": expected "'+Expected+'", but got "'+Actual+'"'); end; begin t('','','',''); t('a','a','b.a','b.a'); t('b','a.b','c','c'); t('b','a.b','a.c','c'); t('b','a.b','b.c','b.c'); t('b','a.b','d.c','d.c'); t('a.b','&Foo.a.b','Foo.a.c','a.c'); t('a.b','&Foo.a.b','&Foo.A.c','A.c'); t('a.b','Foo.a.b','foO.a.c','a.c'); t('a.b','Foo.Bar.a.b','Foo.Bar.d','d'); t('a.b','Foo.Bar.a.b','Foo.Bar.&End.&Of','&End.&Of'); end; procedure TTestRefactoring.TestRenameUsedUnit_Amp; var UsedUnit: TCodeBuffer; begin UsedUnit:=nil; try UsedUnit:=CodeToolBoss.CreateFile('type.pas'); UsedUnit.Source:='unit &Type;'+LineEnding +'interface'+LineEnding +'type'+LineEnding +' TAnt = word;'+LineEnding +' Ant: TAnt;'+LineEnding +'implementation'+LineEnding +'end.'; Add([ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'uses &Type;', 'var c: &Type . TAnt;', 'implementation', 'initialization', ' &type.ant:=&Type . &ant;', 'end.', '']); RenameUsedUnitRefs(UsedUnit,'&End','end.pas'); CheckDiff(Code,[ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'uses &End;', 'var c: &End . TAnt;', 'implementation', 'initialization', ' &End.ant:=&End . &ant;', 'end.', '']); finally if UsedUnit<>nil then UsedUnit.IsDeleted:=true; end; end; procedure TTestRefactoring.TestRenameUsedUnit_Impl; var UsedUnit: TCodeBuffer; begin UsedUnit:=nil; try UsedUnit:=CodeToolBoss.CreateFile('type.pp'); UsedUnit.Source:='unit &Type;'+LineEnding +'interface'+LineEnding +'type'+LineEnding +' TAnt = word;'+LineEnding +' Ant: TAnt;'+LineEnding +'implementation'+LineEnding +'end.'; Add([ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'var &Type: word;', 'implementation', 'uses &Type;', 'var c: &Type . TAnt;', 'initialization', ' &type.ant:=&Type . &ant;', 'end.', '']); RenameUsedUnitRefs(UsedUnit,'&End','end.pas'); CheckDiff(Code,[ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'var &Type: word;', 'implementation', 'uses &End;', 'var c: &End . TAnt;', 'initialization', ' &End.ant:=&End . &ant;', 'end.', '']); finally if UsedUnit<>nil then UsedUnit.IsDeleted:=true; end; end; procedure TTestRefactoring.TestRenameUsedUnit_FN_KeepShort; var UsedUnit: TCodeBuffer; begin AddNameSpace('foo'); UsedUnit:=nil; try UsedUnit:=CodeToolBoss.CreateFile('foo.bar.pp'); UsedUnit.Source:='unit Foo.Bar;'+LineEnding +'interface'+LineEnding +'type'+LineEnding +' TAnt = word;'+LineEnding +' Ant: TAnt;'+LineEnding +'implementation'+LineEnding +'end.'; Add([ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'uses Bar;', 'var c: bar . TAnt;', 'implementation', 'initialization', ' bar.ant:=bar . &ant;', 'end.', '']); RenameUsedUnitRefs(UsedUnit,'foo.&End','foo.end.pas'); CheckDiff(Code,[ 'unit test1;', '{$mode objfpc}{$H+}', 'interface', 'uses &End;', 'var c: &End . TAnt;', 'implementation', 'initialization', ' &End.ant:=&End . &ant;', 'end.', '']); finally if UsedUnit<>nil then UsedUnit.IsDeleted:=true; end; end; procedure TTestRefactoring.TestRenameUsedUnit_InFilename; var UsedUnit: TCodeBuffer; begin UsedUnit:=nil; try UsedUnit:=CodeToolBoss.CreateFile('foo.bar.pp'); UsedUnit.Source:='unit Foo.Bar;'+LineEnding +'interface'+LineEnding +'type'+LineEnding +' TAnt = word;'+LineEnding +'implementation'+LineEnding +'end.'; Add([ 'program Test1;', '{$mode delphi}', 'uses Foo.Bar in ''foo.bar.pp'';', 'var c: foo.bar . TAnt;', 'begin', 'end.', '']); RenameUsedUnitRefs(UsedUnit,'Foo.&End','foo.end.pas'); CheckDiff(Code,[ 'program Test1;', '{$mode delphi}', 'uses Foo.&End in ''foo.end.pas'';', 'var c: Foo.&End . TAnt;', 'begin', 'end.', '']); finally if UsedUnit<>nil then UsedUnit.IsDeleted:=true; end; end; procedure TTestRefactoring.TestRenameUsedUnit_LongestUnitnameWins; var RedUnit, RedGreenUnit, RedGreenBlueUnit: TCodeBuffer; begin RedUnit:=CodeToolBoss.CreateFile('red.pas'); RedGreenUnit:=CodeToolBoss.CreateFile('red.green.pas'); RedGreenBlueUnit:=CodeToolBoss.CreateFile('red.green.blue.pas'); try RedUnit.Source:='unit Red;'+LineEnding +'interface'+LineEnding +'var'+LineEnding +' Red, Green: word;'+LineEnding +'implementation'+LineEnding +'end.'; RedGreenUnit.Source:='unit Red.Green;'+LineEnding +'interface'+LineEnding +'var'+LineEnding +' Green, Blue: word;'+LineEnding +'implementation'+LineEnding +'end.'; RedGreenBlueUnit.Source:='unit Red.Green.Blue;'+LineEnding +'interface'+LineEnding +'var'+LineEnding +' Blue: word;'+LineEnding +'implementation'+LineEnding +'end.'; Add([ 'program test1;', '{$mode objfpc}{$H+}', 'uses Red, Red.Green, Red.Green.Blue;', 'begin', ' red.red:=1;', ' red.green.green:=2;', ' red.green.blue.blue:=3;', 'end.', '']); RenameUsedUnitRefs(RedGreenUnit,'&End','end.pas'); CheckDiff(Code,[ 'program test1;', '{$mode objfpc}{$H+}', 'uses Red, &End, Red.Green.Blue;', 'begin', ' red.red:=1;', ' &End.green:=2;', ' red.green.blue.blue:=3;', 'end.', '']); finally RedUnit.IsDeleted:=true; RedGreenUnit.IsDeleted:=true; RedGreenBlueUnit.IsDeleted:=true; end; end; initialization RegisterTests([TTestRefactoring]); end.