paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 17:20:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: rename source name references: keep omitted namespace

Browse Source
This commit is contained in:
mattias 2025-02-04 15:10:18 +01:00
parent 370938ca90
commit e5c09ba479
6 changed files with 285 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
components/codetools/basiccodetools.pas
View File

@ -190,7 +190,7 @@ function CompareComments(p1, p2: PChar; NestedComments: boolean): integer; // co
function FindDiff(const s1, s2: string): integer;
function dbgsDiff(Expected, Actual: string): string; overload;
// dotted identifiers
// dotted identifiers. Note: spaces and comments are treated as end
function DottedIdentifierLength(Identifier: PChar): integer;
function GetDottedIdentifier(Identifier: PChar): string;
function IsDottedIdentifier(const Identifier: string; AllowAmp: boolean = True): boolean;
@ -201,6 +201,7 @@ function ChompDottedIdentifier(const Identifier: string): string;
function SkipDottedIdentifierPart(var Identifier: PChar): boolean;
function DottedIdentifierStartsWith(Identifier, StartsWithIdent: PChar): boolean; // true if equal or longer
function DottedIdentifierEndsWith(Identifier, EndsWithIdent: PChar): boolean; // true if equal or longer
function SplitDottedIdentifier(const Dotted: string; out Arr: TStringArray; SkipAmps: boolean = false): boolean;
// space and special chars
function TrimCodeSpace(const ACode: string): string;
@ -295,11 +296,11 @@ function CompareNameSpaceAndNameSpaceInfo(NamespacePAnsiString,
function FindSourceType(const Source: string;
var SrcNameStart, SrcNameEnd: integer; NestedComments: boolean = false): string;
// identifier
// read dotted identifier, skipping spaces and comments
function ReadDottedIdentifier(const Source: string; var Position: integer;
NestedComments: boolean = false): string;
NestedComments: boolean = false; aSkipAmp: boolean = true): string;
function ReadDottedIdentifier(var Position: PChar; SrcEnd: PChar;
NestedComments: boolean = false): string;
NestedComments: boolean = false; aSkipAmp: boolean = true): string;
// program name
function RenameProgramInSource(Source:TSourceLog;
@ -589,19 +590,19 @@ begin
ModuleType:='';
end;
function ReadDottedIdentifier(const Source: string; var Position: integer;
NestedComments: boolean): string;
function ReadDottedIdentifier(const Source: string; var Position: integer; NestedComments: boolean;
aSkipAmp: boolean): string;
var
p: PChar;
begin
if (Position<1) or (Position>length(Source)) then exit('');
p:=@Source[Position];
Result:=ReadDottedIdentifier(p,PChar(Source)+length(Source),NestedComments);
Result:=ReadDottedIdentifier(p,PChar(Source)+length(Source),NestedComments,aSkipAmp);
Position:=p-PChar(Source)+1;
end;
function ReadDottedIdentifier(var Position: PChar; SrcEnd: PChar;
NestedComments: boolean): string;
function ReadDottedIdentifier(var Position: PChar; SrcEnd: PChar; NestedComments: boolean;
aSkipAmp: boolean): string;
var
AtomStart, p: PChar;
s: String;
@ -611,7 +612,7 @@ begin
ReadRawNextPascalAtom(p,AtomStart,SrcEnd,NestedComments);
Position:=AtomStart;
if (AtomStart>=p) then exit;
Result:=GetIdentifier(AtomStart);
Result:=GetIdentifier(AtomStart,aSkipAmp);
if Result='' then exit;
repeat
Position:=p;
@ -619,7 +620,7 @@ begin
if (AtomStart+1<>p) or (AtomStart^<>'.') then exit;
ReadRawNextPascalAtom(p,AtomStart,SrcEnd,NestedComments);
if (AtomStart>=p) then exit;
s:=GetIdentifier(AtomStart);
s:=GetIdentifier(AtomStart,aSkipAmp);
if s='' then exit;
Result:=Result+'.'+s;
until false;
@ -5536,6 +5537,33 @@ begin
Result:=CompareDottedIdentifiers(Identifier,EndsWithIdent)=0;
end;
function SplitDottedIdentifier(const Dotted: string; out Arr: TStringArray; SkipAmps: boolean
): boolean;
var
p, l, StartP: integer;
begin
Arr:=[];
Result:=false;
p:=1;
l:=length(Dotted);
repeat
StartP:=p;
if p>l then exit;
if Dotted[p]='&' then begin
if SkipAmps then inc(StartP);
inc(p);
end;
if p>l then exit;
if not IsIdentStartChar[Dotted[p]] then exit;
inc(p);
while (p<=l) and IsIdentChar[Dotted[p]] do inc(p);
Insert(copy(Dotted,StartP,p-StartP),Arr,length(Arr));
if p>l then exit(true);
if Dotted[p]<>'.' then exit;
inc(p);
until false;
end;
function CompareDottedIdentifiersCaseSensitive(Identifier1, Identifier2: PChar): integer;
var
c: Char;

55
components/codetools/changedeclarationtool.pas
View File

@ -110,6 +110,7 @@ type
out Param: TReplaceDottedIdentifierParam): boolean;
function ReplaceDottedIdentifier(CleanPos: integer; const Param: TReplaceDottedIdentifierParam;
SourceChanger: TSourceChangeCache): boolean;
class function UseOmittedNamespace(const OldShort, OldFull, NewFull: string): string;
function RenameSourceNameReferences(OldTargetFilename, NewTargetFilename: string;
Refs: TSrcNameRefs; SourceChanger: TSourceChangeCache): boolean;
end;
@ -1079,36 +1080,13 @@ end;
function TChangeDeclarationTool.InitReplaceDottedIdentifier(const OldDottedIdentifier,
NewDottedIdentifier: string; out Param: TReplaceDottedIdentifierParam): boolean;
function SplitDotty(const Dotted: string; var Arr: TStringArray): boolean;
var
p, l, StartP: integer;
begin
Result:=false;
p:=1;
l:=length(Dotted);
repeat
StartP:=p;
if p>l then exit;
if Dotted[p]='&' then inc(p);
if p>l then exit;
if not IsIdentStartChar[Dotted[p]] then exit;
inc(p);
while (p<=l) and IsIdentChar[Dotted[p]] do inc(p);
Insert(copy(Dotted,StartP,p-StartP),Arr,length(Arr));
if p>l then exit(true);
if Dotted[p]<>'.' then exit;
inc(p);
until false;
end;
var
OldCount, NewCount: integer;
begin
Result:=false;
Param:=Default(TReplaceDottedIdentifierParam);
if not SplitDotty(OldDottedIdentifier,Param.OldNames) then exit;
if not SplitDotty(NewDottedIdentifier,Param.NewNames) then exit;
if not SplitDottedIdentifier(OldDottedIdentifier,Param.OldNames) then exit;
if not SplitDottedIdentifier(NewDottedIdentifier,Param.NewNames) then exit;
OldCount:=length(Param.OldNames);
NewCount:=length(Param.NewNames);
@ -1293,6 +1271,33 @@ begin
//debugln(['TChangeDeclarationTool.ReplaceDottedIdentifier OldCode="',copy(Src,CleanPos,EndPos-CleanPos),'"']);
end;
class function TChangeDeclarationTool.UseOmittedNamespace(const OldShort, OldFull, NewFull: string
): string;
// for example: OldShort=Bar, OldFull=Foo.Bar, NewFull=Foo.Red.Blue, Result=Red.Blue
var
ShortPartCnt, i, OldPartCnt: Integer;
OldP, NewP, OldShortP: PChar;
begin
Result:=NewFull;
if OldShort=OldFull then exit;
OldP:=PChar(OldFull);
OldShortP:=PChar(OldShort);
if not DottedIdentifierEndsWith(OldP,OldShortP) then exit;
ShortPartCnt:=GetDotCountInIdentifier(OldShortP)+1;
OldPartCnt:=GetDotCountInIdentifier(OldP)+1;
NewP:=PChar(NewFull);
for i:=1 to OldPartCnt-ShortPartCnt do begin
if CompareIdentifiers(OldP,NewP)<>0 then exit;
if not SkipDottedIdentifierPart(OldP) then exit;
if not SkipDottedIdentifierPart(NewP) then exit;
end;
// NewFull uses the same namespace as OldFull
// -> omit the namespace
Result:=NewP;
end;
function TChangeDeclarationTool.RenameSourceNameReferences(OldTargetFilename,
NewTargetFilename: string; Refs: TSrcNameRefs; SourceChanger: TSourceChangeCache): boolean;
var

45
components/codetools/codetoolmanager.pas
View File

@ -230,10 +230,12 @@ type
GlobalValues: TExpressionEvaluator;
DirectoryCachePool: TCTDirectoryCachePool;
CompilerDefinesCache: TCompilerDefinesCache;
Indenter: TFullyAutomaticBeautifier;
IdentifierList: TIdentifierList;
IdentifierHistory: TIdentifierHistoryList;
Positions: TCodeXYPositions;
Indenter: TFullyAutomaticBeautifier;
property Beautifier: TBeautifyCodeOptions read GetBeautifier;
constructor Create;
@ -3114,20 +3116,29 @@ begin
Tools.Add(FCurCodeTool);
// search references
if not FCurCodeTool.FindSourceNameReferences(TargetFilename,SkipComments,LocalSrcName,
InFilenameCleanPos, TreeOfPCodeXYPosition, false)
then begin
debugln(['TCodeToolManager.FindSourceNameReferences FindSourceNameReferences FAILED in "',Code.Filename,'"']);
if TreeOfPCodeXYPosition<>nil then
FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
continue;
TreeOfPCodeXYPosition:=nil;
try
if not FCurCodeTool.FindSourceNameReferences(TargetFilename,SkipComments,LocalSrcName,
InFilenameCleanPos, TreeOfPCodeXYPosition, false)
then begin
debugln(['TCodeToolManager.FindSourceNameReferences FindSourceNameReferences FAILED in "',Code.Filename,'"']);
if TreeOfPCodeXYPosition<>nil then
FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
continue;
end;
except
on e: Exception do HandleException(e);
end;
{$IFDEF VerboseFindSourceNameReferences}
if TreeOfPCodeXYPosition<>nil then
debugln(['TCodeToolManager.FindSourceNameReferences SrcName="',LocalSrcName,'" Count=',TreeOfPCodeXYPosition.Count])
else
if (TreeOfPCodeXYPosition=nil) or (TreeOfPCodeXYPosition.Count=0) then begin
{$IFDEF VerboseFindSourceNameReferences}
debugln(['TCodeToolManager.FindSourceNameReferences SrcName="',LocalSrcName,'" Count=0']);
{$ENDIF}
FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
continue;
end;
{$IFDEF VerboseFindSourceNameReferences}
debugln(['TCodeToolManager.FindSourceNameReferences SrcName="',LocalSrcName,'" Count=',TreeOfPCodeXYPosition.Count]);
{$ENDIF}
Param:=TSrcNameRefs.Create;
Param.Tool:=FCurCodeTool;
@ -3153,7 +3164,7 @@ var
i: Integer;
Param: TSrcNameRefs;
Tool: TChangeDeclarationTool;
NewTargetSrcName: string;
NewTargetSrcName, OldTargetUnitName: string;
begin
Result:=true;
if (ListOfSrcNameRefs=nil) or (ListOfSrcNameRefs.Count=0) then exit;
@ -3162,11 +3173,15 @@ begin
{$ENDIF}
ClearCurCodeTool;
SourceChangeCache.Clear;
OldTargetUnitName:=ExtractFileNameOnly(OldFilename);
for i:=0 to ListOfSrcNameRefs.Count-1 do begin
Param:=TSrcNameRefs(ListOfSrcNameRefs[i]);
Tool:=Param.Tool;
if Param.NewLocalSrcName='' then
Param.NewLocalSrcName:=NewSrcName;
if Param.NewLocalSrcName='' then begin
Param.NewLocalSrcName:=TChangeDeclarationTool.UseOmittedNamespace(
Param.LocalSrcName,OldTargetUnitName,NewSrcName);
//debugln(['TCodeToolManager.RenameSourceNameReferences LocalSrcName="',Param.LocalSrcName,'" OldUnitName="',OldTargetUnitName,'" NewUnitName="',NewSrcName,'" NewLocalSrcName="',Param.NewLocalSrcName,'"']);
end;
if not Tool.RenameSourceNameReferences(OldFilename,NewFilename,
Param,SourceChangeCache) then
begin

3
components/codetools/finddeclarationtool.pas
View File

@ -7774,10 +7774,9 @@ begin
exit; // unit not used
end;
// find references in source
MaxPos:=Tree.FindLastPosition;
if MaxPos>SrcLen then MaxPos:=SrcLen;
// find references in source
Params:=nil;
try
if InterfaceUsesNode<>nil then begin

36
components/codetools/tests/testpascalparser.pas
View File

@ -12,7 +12,7 @@ unit TestPascalParser;
interface
uses
Classes, SysUtils, math, CodeToolManager, CodeCache, CodeAtom,
Classes, SysUtils, math, CodeToolManager, CodeCache, CodeAtom, DefineTemplates, ExprEval,
LazLogger, fpcunit, testregistry, TestGlobals;
type
@ -23,9 +23,13 @@ type
private
FCode: TCodeBuffer;
protected
VirtualDirAdditions: TDefineTemplate;
NameSpaceDefine: TDefineTemplate;
procedure SetUp; override;
procedure TearDown; override;
procedure DoParseModule(aCode: TCodeBuffer; out Tool: TCodeTool);
function GetVirtualDirAdditions: TDefineTemplate;
procedure AddNameSpace(aNameSpaces: string); virtual;
public
procedure Add(const s: string);
procedure Add(Args: array of const);
@ -76,6 +80,10 @@ end;
procedure TCustomTestPascalParser.TearDown;
begin
if VirtualDirAdditions<>nil then begin
CodeToolBoss.DefineTree.RemoveDefineTemplate(VirtualDirAdditions);
VirtualDirAdditions:=nil;
end;
inherited TearDown;
end;
@ -98,6 +106,32 @@ begin
end;
end;
function TCustomTestPascalParser.GetVirtualDirAdditions: TDefineTemplate;
begin
if VirtualDirAdditions=nil then begin
VirtualDirAdditions:=TDefineTemplate.Create('TestDefinesForVirtualDir','',
'',VirtualDirectory,da_Directory);
CodeToolBoss.DefineTree.Add(VirtualDirAdditions);
end;
Result:=VirtualDirAdditions;
end;
procedure TCustomTestPascalParser.AddNameSpace(aNameSpaces: string);
var
ParentDef: TDefineTemplate;
begin
aNameSpaces:=Trim(aNameSpaces);
if aNameSpaces='' then exit;
if NameSpaceDefine=nil then begin
ParentDef:=GetVirtualDirAdditions;
NameSpaceDefine:=TDefineTemplate.Create('TestNameSpaces','',
NamespacesMacroName,NamespacesMacro+';'+aNameSpaces,da_DefineRecurse);
CodeToolBoss.DefineTree.AddChild(ParentDef,NameSpaceDefine);
end else
NameSpaceDefine.Value:=NameSpaceDefine.Value+';'+aNameSpaces;
end;
procedure TCustomTestPascalParser.Add(const s: string);
begin
FCode.Source:=FCode.Source+s+LineEnding;

157
components/codetools/tests/testrefactoring.pas
View File

@ -11,8 +11,8 @@ interface
uses
Classes, SysUtils, CodeToolManager, CodeCache, CodeTree, BasicCodeTools, CTUnitGraph,
FindDeclarationTool, LazLogger, LazFileUtils, AVL_Tree, Contnrs, fpcunit, testregistry,
TestFinddeclaration;
FindDeclarationTool, ChangeDeclarationTool, LazLogger, LazFileUtils, AVL_Tree, Contnrs, fpcunit,
testregistry, TestFinddeclaration;
const
ExplodeWithMarker = 'explodewith:';
@ -62,16 +62,17 @@ type
procedure TestRenameProgramName_MakeDotted;
procedure TestRenameProgramName_DottedAppendThird;
procedure TestRenameProgramName_DottedPrependThird;
procedure TestRenameProgramName_DottedInsertThird;
procedure TestRenameProgramName_DottedShortenStart;
procedure TestRenameProgramName_DottedShortenMiddle;
procedure TestRenameProgramName_DottedShortenEnd;
// todo: tskip multiline string literals
// rename uses
procedure TestUseOmittedNamespace;
procedure TestRenameUsedUnit_Amp;
// todo: search in an include file should not stop searching in other files
// todo: missing used unit should not stop searching in other files
// todo: rename with -FN, unit Foo.Bar to Foo.Red, uses Bar;
procedure TestRenameUsedUnit_Impl;
procedure TestRenameUsedUnit_FN_KeepShort;
// todo: rename uses Bar in 'bar.pas'
end;
implementation
@ -209,7 +210,7 @@ begin
Fail('CodeToolBoss.FindSourceNameReferences failed File='+Code.Filename);
end;
// rename
if not CodeToolBoss.RenameSourceNameReferences(Code.Filename,NewFilename,NewName,ListOfSrcNameRefs)
if not CodeToolBoss.RenameSourceNameReferences(UsedUnit.Filename,NewFilename,NewName,ListOfSrcNameRefs)
then
Fail('CodeToolBoss.RenameSourceNameReferences failed');
finally
@ -1357,6 +1358,29 @@ begin
'']);
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([
@ -1430,6 +1454,31 @@ begin
'']);
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;
@ -1475,6 +1524,100 @@ begin
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;
initialization
RegisterTests([TTestRefactoring]);
end.