paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 23:08:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: ReplaceDottedIdentifier: delete atoms

Browse Source
This commit is contained in:
mattias 2025-02-04 00:08:57 +01:00
parent cdeeb79cc7
commit 3276690fec
4 changed files with 287 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
components/codetools/basiccodetools.pas
View File

@ -61,7 +61,7 @@ procedure FindCommentsInRange(const Src: string; StartPos, EndPos: integer;
out FirstCommentStart, FirstAtomStart, LastCommentEnd, LastAtomEnd: integer;
NestedComments: boolean = false);
function FindNextCompilerDirective(const ASource: string; StartPos: integer;
NestedComments: boolean): integer;
NestedComments: boolean; MaxPos: integer = -1): integer;
function FindNextCompilerDirectiveWithName(const ASource: string;
StartPos: integer; const DirectiveName: string;
NestedComments: boolean; out ParamPos: integer): integer;
@ -1502,11 +1502,10 @@ begin
end;
function FindNextCompilerDirective(const ASource: string; StartPos: integer;
NestedComments: boolean): integer;
var
MaxPos: integer;
NestedComments: boolean; MaxPos: integer): integer;
begin
MaxPos:=length(ASource);
if MaxPos<0 then
MaxPos:=length(ASource);
Result:=StartPos;
while (Result<=MaxPos) do begin
case ASource[Result] of

100
components/codetools/changedeclarationtool.pas
View File

@ -33,7 +33,7 @@ unit ChangeDeclarationTool;
interface
uses
Classes, SysUtils, Contnrs, AVL_Tree,
Classes, SysUtils, Math, Contnrs, AVL_Tree,
// Codetools
CodeAtom, CodeCache, FileProcs, CodeTree, ExtractProcTool, FindDeclarationTool,
BasicCodeTools, KeywordFuncLists, LinkScanner, SourceChanger, CustomCodeTool;
@ -1136,11 +1136,15 @@ type
DotPos: integer;
end;
var
EndPos: integer;
function Replace(CleanStartPos, CleanEndPos: integer; const NewCode: string): boolean;
var
StartCodePos, EndCodePos: TCodePosition;
OldCode: String;
begin
Result:=true;
CleanPosToCodePos(CleanStartPos,StartCodePos);
CleanPosToCodePos(CleanEndPos,EndCodePos);
if (StartCodePos.Code<>EndCodePos.Code) or (StartCodePos.P>EndCodePos.P) then
@ -1153,18 +1157,41 @@ type
debugln(['ReplaceDottedIdentifier ',CleanPosToStr(CleanStartPos),' OldCode="',OldCode,'" NewCode="',NewCode,'"']);
{$ENDIF}
if OldCode=NewCode then
exit(true);
exit;
Result:=SourceChanger.ReplaceEx(gtNone,gtNone,1,1,StartCodePos.Code,
StartCodePos.P,EndCodePos.P, NewCode);
if not Result then
debugln(['Error: [20250203111611] SourceChanger.ReplaceEx failed at: ',CleanPosToStr(CleanStartPos,true)]);
end;
function GetRange(FromIndex, ToIndex: integer): string;
var
i: Integer;
begin
Result:='';
for i:=FromIndex to ToIndex do begin
if i>FromIndex then
Result:=Result+'.';
Result:=Result+Param.NewNames[i];
end;
end;
function DeleteRange(FromPos, ToPos: integer): boolean;
// delete range and spaces around
begin
while (FromPos>CleanPos) and IsSpaceChar[Src[FromPos-1]] do dec(FromPos);
while (ToPos<EndPos) and IsSpaceChar[Src[ToPos]] do inc(ToPos);
if FromPos=ToPos then exit;
{$IFDEF VerboseFindSourceNameReferences}
debugln(['ReplaceDottedIdentifier DeleteRange at ',CleanPosToStr(FromPos),' "',copy(Src,FromPos,ToPos-FromPos),'"']);
{$ENDIF}
Result:=SourceChanger.DeleteRange(Scanner,FromPos,ToPos,false,true);
end;
var
Item: TItem;
Items: array of TItem;
NewCode: String;
EndPos, OldCount, NewCount, i: Integer;
OldCount, NewCount, i, j, k, p: Integer;
HasComments: Boolean;
begin
Result:=false;
@ -1181,6 +1208,7 @@ begin
Item.StartPos:=CurPos.StartPos;
Item.EndPos:=CurPos.EndPos;
Item.Name:=GetAtom;
Item.DotPos:=0;
if (i>0) and (Item.StartPos>Items[i-1].DotPos+1) then
HasComments:=true;
@ -1204,15 +1232,65 @@ begin
if not HasComments then begin
// simple replace
NewCode:=Param.NewNames[0];
for i:=1 to NewCount-1 do
NewCode:=NewCode+'.'+Param.NewNames[i];
NewCode:=GetRange(0,NewCount-1);
Result:=Replace(CleanPos,EndPos,NewCode);
exit;
end;
// ToDo:
debugln(['TChangeDeclarationTool.ReplaceDottedIdentifier Complex: OldCode="',copy(Src,CleanPos,EndPos-CleanPos),'"']);
if OldCount=NewCount then begin
// 1:1 matching -> replace each identifier
for i:=0 to NewCount-1 do begin
if not Replace(Items[i].StartPos,Items[i].EndPos,Param.NewNames[i]) then
exit;
end;
exit(true);
end;
// number of identifiers have changed
// replace each matching identifier at start
i:=0;
while i<Param.SameStart do begin
if not Replace(Items[i].StartPos,Items[i].EndPos,Param.NewNames[i]) then
exit;
inc(i);
end;
if i=OldCount then begin
// new version is just longer -> append new identifiers
NewCode:='.'+GetRange(OldCount,NewCount-1);
Result:=Replace(EndPos,EndPos,NewCode);
exit;
end;
// replace identifiers at end
k:=Min(OldCount-i,NewCount-i);
j:=OldCount-1;
while (k>0) and (j>=i) do begin
if not Replace(Items[j].StartPos,Items[j].EndPos,
Param.NewNames[j+(NewCount-OldCount)]) then
exit;
dec(j);
dec(k);
end;
//debugln(['TChangeDeclarationTool.ReplaceDottedIdentifier i=',i,' j=',j]);
if j<i then begin
// insertion: for example A.B -> A.C.B or B.C -> A.B.C
p:=Items[i].StartPos;
NewCode:=GetRange(i,i+(NewCount-OldCount)-1)+'.';
Result:=Replace(p,p,NewCode);
exit;
end;
// deletion: for example A.B.C -> A.C or A.D.E.C -> A.B.C
if Items[j].DotPos>0 then
Result:=DeleteRange(Items[i].StartPos,Items[j].DotPos+1)
else
Result:=DeleteRange(Items[i-1].DotPos,Items[j].EndPos);
//debugln(['TChangeDeclarationTool.ReplaceDottedIdentifier OldCode="',copy(Src,CleanPos,EndPos-CleanPos),'"']);
end;
function TChangeDeclarationTool.RenameSourceNameReferences(OldTargetFilename,
@ -1239,7 +1317,7 @@ begin
Node:=Refs.TreeOfPCodeXYPosition.FindLowest;
while Node<>nil do begin
CodePos:=PCodeXYPosition(Node.Data);
debugln(['AAA1 TChangeDeclarationTool.RenameSourceNameReferences ',dbgs(CodePos^)]);
//debugln(['TChangeDeclarationTool.RenameSourceNameReferences ',dbgs(CodePos^)]);
if CaretToCleanPos(CodePos^,p)<>0 then begin
debugln(['TChangeDeclarationTool.RenameSourceNameReferences invalid codepos: ',dbgs(CodePos^)]);
end else begin

119
components/codetools/sourcechanger.pas
View File

@ -267,7 +267,7 @@ type
FUpdateLock: integer;
Src: string; // current cleaned source
SrcLen: integer; // same as length(Src)
procedure DeleteCleanText(CleanFromPos,CleanToPos: integer);
procedure DeleteCleanText(Scanner: TLinkScanner; CleanFromPos,CleanToPos: integer);
procedure DeleteDirectText(ACode: TCodeBuffer;
DirectFromPos,DirectToPos: integer);
procedure InsertNewText(ACode: TCodeBuffer; DirectPos: integer;
@ -277,6 +277,9 @@ type
procedure UpdateBuffersToModify;
protected
procedure RaiseException(id: int64; const AMessage: string);
procedure AddEntry(FrontGap, AfterGap: TGapTyp; FromPos, ToPos: integer;
DirectCode: TCodeBuffer; FromDirectPos, ToDirectPos: integer;
const Text: string; IsDirectChange: boolean);
public
BeautifyCodeOptions: TBeautifyCodeOptions;
constructor Create;
@ -290,6 +293,8 @@ type
function ReplaceEx(FrontGap, AfterGap: TGapTyp; FromPos, ToPos: integer;
DirectCode: TCodeBuffer; FromDirectPos, ToDirectPos: integer;
const Text: string): boolean;
function DeleteRange(Scanner: TLinkScanner; FromPos, ToPos: integer;
KeepComments: boolean = false; KeepDirectives: boolean = true): boolean;
function IndentBlock(FromPos, ToPos, IndentDiff: integer): boolean;
function IndentLine(LineStartPos, IndentDiff: integer): boolean;
function Apply: boolean;
@ -477,31 +482,28 @@ end;
function CompareSourceChangeCacheEntry(NodeData1, NodeData2: pointer): integer;
var
Entry1, Entry2: TSourceChangeCacheEntry;
Entry1: TSourceChangeCacheEntry absolute NodeData1;
Entry2: TSourceChangeCacheEntry absolute NodeData2;
IsEntry1Delete, IsEntry2Delete: boolean;
begin
Entry1:=TSourceChangeCacheEntry(NodeData1);
Entry2:=TSourceChangeCacheEntry(NodeData2);
if Entry1.FromPos>Entry2.FromPos then
Result:=1
else if Entry1.FromPos<Entry2.FromPos then
Result:=-1
else if Entry1.FromDirectPos>Entry2.FromDirectPos then
Result:=1
else if Entry1.FromDirectPos<Entry2.FromDirectPos then
Result:=-1
else begin
IsEntry1Delete:=Entry1.IsDeleteOperation;
IsEntry2Delete:=Entry2.IsDeleteOperation;
if IsEntry1Delete=IsEntry2Delete then begin
if Entry1.FromDirectPos>Entry2.FromDirectPos then
Result:=1
else if Entry1.FromDirectPos<Entry2.FromDirectPos then
Result:=-1
else
Result:=0;
end else begin
if IsEntry1Delete<>IsEntry2Delete then begin
if IsEntry1Delete then
Result:=1
else
Result:=-1;
end;
end else
Result:=0;
end;
end;
@ -788,19 +790,68 @@ begin
DirectCode:=TCodeBuffer(p);
ToDirectPos:=0;
end;
// add entry
NewEntry:=TSourceChangeCacheEntry.Create(FrontGap,AfterGap,FromPos,ToPos,
Text,DirectCode,FromDirectPos,ToDirectPos,IsDirectChange);
FEntries.Add(NewEntry);
if not IsDirectChange then
FMainScannerNeeded:=true;
FBuffersToModifyNeedsUpdate:=true;
AddEntry(FrontGap,AfterGap,FromPos,ToPos,
DirectCode,FromDirectPos,ToDirectPos,Text,IsDirectChange);
Result:=true;
{$IFDEF VerboseSrcChanger}
DebugLn('TSourceChangeCache.ReplaceEx SUCCESS IsDelete=',dbgs(NewEntry.IsDeleteOperation));
{$ENDIF}
end;
function TSourceChangeCache.DeleteRange(Scanner: TLinkScanner; FromPos, ToPos: integer;
KeepComments: boolean; KeepDirectives: boolean): boolean;
var
StartPos, p, LinkIndex, aLinkSize, Len: Integer;
CurSrc: String;
Link: TSourceLink;
begin
Result:=false;
//debugln(['TSourceChangeCache.DeleteRange ',FromPos,'-',ToPos]);
if Scanner=nil then exit;
if FromPos>=ToPos then exit(true);
if (FromPos<1) or (ToPos>Scanner.CleanedLen+1) then
exit;
//debugln(['TSourceChangeCache.DeleteRange ',FromPos,'-',ToPos]);
if KeepComments or KeepDirectives then begin
// delete code and spaces between comments/directives
CurSrc:=Scanner.CleanedSrc;
p:=FromPos;
repeat
StartPos:=p;
if KeepComments then
p:=FindNextComment(CurSrc,FromPos,ToPos-1)
else
p:=FindNextCompilerDirective(CurSrc,FromPos,Scanner.NestedComments,ToPos-1);
if p>ToPos then p:=ToPos;
if p>StartPos then
if not DeleteRange(Scanner,StartPos,p,false,false) then exit;
if p>=ToPos then break;
p:=FindCommentEnd(CurSrc,p,Scanner.NestedComments);
until p>=ToPos;
end else begin
// delete range
LinkIndex:=Scanner.LinkIndexAtCleanPos(ToPos);
while LinkIndex>=0 do begin
Link:=Scanner.Links[LinkIndex];
if Link.Code<>nil then begin
StartPos:=FromPos-Link.CleanedPos;
if StartPos<0 then StartPos:=0;
aLinkSize:=Scanner.LinkSize(LinkIndex);
//debugln(['TSourceChangeCache.DeleteRange LinkIndex=',LinkIndex,' aLinkSize=',aLinkSize,' StartPosInLink=',StartPos]);
Len:=ToPos-Link.CleanedPos;
if Len>aLinkSize then Len:=aLinkSize;
dec(Len,StartPos);
inc(StartPos,Link.SrcPos);
//DebugLn(['[TSourceChangeCache.DeleteRange] Pos=',StartPos,'-',StartPos+Len,' "',dbgstr(copy(TCodeBuffer(Link.Code).Source,StartPos,Len)),'"']);
AddEntry(gtNone,gtNone,1,1,TCodeBuffer(Link.Code),StartPos,StartPos+Len,'',true);
end;
if Link.CleanedPos<=ToPos then break;
dec(LinkIndex);
end;
end;
Result:=true;
end;
function TSourceChangeCache.IndentBlock(FromPos, ToPos, IndentDiff: integer): boolean;
// (un)indent all lines in FromPos..ToPos
// If FromPos starts in the middle of a line the first line is not changed
@ -1104,8 +1155,9 @@ begin
while CurNode<>nil do begin
FirstEntry:=TSourceChangeCacheEntry(CurNode.Data);
{$IFDEF VerboseSrcChanger}
DebugLn('TSourceChangeCache.Apply Pos=',dbgs(FirstEntry.FromPos),'-',dbgs(FirstEntry.ToPos),
' Text="',dbgstr(FirstEntry.Text),'"');
DebugLn(['TSourceChangeCache.Apply Pos=',FirstEntry.FromPos,'-',FirstEntry.ToPos,
' DirectPos=',FirstEntry.FromDirectPos,'-',FirstEntry.ToDirectPos,
' Text="',dbgstr(FirstEntry.Text),'"']);
{$ENDIF}
InsertText:=FirstEntry.Text;
// add after gap
@ -1148,7 +1200,7 @@ begin
AddFrontGap(CurEntry);
// delete old text in code buffers
if not FirstEntry.IsDirectChange then
DeleteCleanText(FirstEntry.FromPos+FromPosAdjustment,FirstEntry.ToPos)
DeleteCleanText(MainScanner,FirstEntry.FromPos+FromPosAdjustment,FirstEntry.ToPos)
else
DeleteDirectText(FirstEntry.DirectCode,
FirstEntry.FromDirectPos+FromPosAdjustment,
@ -1165,13 +1217,14 @@ begin
Result:=true;
end;
procedure TSourceChangeCache.DeleteCleanText(CleanFromPos,CleanToPos: integer);
procedure TSourceChangeCache.DeleteCleanText(Scanner: TLinkScanner; CleanFromPos,
CleanToPos: integer);
begin
{$IFDEF VerboseSrcChanger}
DebugLn('[TSourceChangeCache.DeleteCleanText] Pos=',dbgs(CleanFromPos),'-',dbgs(CleanToPos));
{$ENDIF}
if CleanFromPos=CleanToPos then exit;
MainScanner.DeleteRange(CleanFromPos,CleanToPos);
if CleanFromPos>=CleanToPos then exit;
Scanner.DeleteRange(CleanFromPos,CleanToPos);
end;
procedure TSourceChangeCache.DeleteDirectText(ACode: TCodeBuffer; DirectFromPos,
@ -1271,6 +1324,20 @@ begin
raise ESourceChangeCacheError.Create(Self,id,AMessage);
end;
procedure TSourceChangeCache.AddEntry(FrontGap, AfterGap: TGapTyp; FromPos, ToPos: integer;
DirectCode: TCodeBuffer; FromDirectPos, ToDirectPos: integer; const Text: string;
IsDirectChange: boolean);
var
NewEntry: TSourceChangeCacheEntry;
begin
NewEntry:=TSourceChangeCacheEntry.Create(FrontGap,AfterGap,FromPos,ToPos,
Text,DirectCode,FromDirectPos,ToDirectPos,IsDirectChange);
FEntries.Add(NewEntry);
FBuffersToModifyNeedsUpdate:=true;
if not IsDirectChange then
FMainScannerNeeded:=true;
end;
{ TBeautifyCodeOptions }
// inline

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

@ -57,7 +57,12 @@ type
// rename program
procedure TestRenameProgramName_Amp;
procedure TestRenameProgramName_DottedPostfix; // todo
procedure TestRenameProgramName_DottedSameCount;
procedure TestRenameProgramName_MakeDotted;
procedure TestRenameProgramName_DottedAppendThird;
procedure TestRenameProgramName_DottedPrependThird;
procedure TestRenameProgramName_DottedShortenEnd;
// todo: skip multiline string literals
// rename uses
// todo: rename unit &Type to &End
@ -1241,17 +1246,15 @@ begin
'']);
end;
procedure TTestRefactoring.TestRenameProgramName_DottedPostfix;
procedure TTestRefactoring.TestRenameProgramName_DottedSameCount;
begin
exit;
Add([
'program Foo.Bar;',
'{$mode objfpc}{$H+}',
'type TRed = word;',
'var c: foo . bar . TRed;',
'begin',
//' foo.bar.c:=&foo . &bar . &c;',
' foo.bar.c:=&foo . &bar . &c;',
'end.',
'']);
RenameSourceName('Foo.&End','foo.end.pas');
@ -1261,7 +1264,99 @@ begin
'type TRed = word;',
'var c: Foo . &End . TRed;',
'begin',
//' Foo.&End.c:=Foo . &End . &c;',
' 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_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;