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

codetools: fixed SetApplicationTitleStatement for Application as param

Browse Source
This commit is contained in:
mattias 2023-10-08 00:18:57 +02:00
parent a50a1e18b5
commit e38a298110
2 changed files with 123 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
components/codetools/stdcodetools.pas
View File

@ -3775,11 +3775,12 @@ end;
function TStandardCodeTool.FindApplicationStatement(const APropertyUpCase: string;
out StartPos, ConstStartPos, EndPos: integer): boolean;
// Find statement "Application.APropertyUpCase:=XYZ;" and return True if found.
// Also return its positions (Start, const "XYZ" and End) in out parameters.
// Also return its positions (Start, const "XYZ" and End) in out parameters.
// If not found, out parameters get a good position to insert such a statement.
var
MainBeginNode: TCodeTreeNode;
AppPos, FirstAppPos: Integer;
Last: TCommonAtomFlag;
begin
Result:=false;
StartPos:=-1;
@ -3791,48 +3792,54 @@ begin
if (MainBeginNode=nil) or (MainBeginNode.StartPos<1) then exit;
MoveCursorToCleanPos(MainBeginNode.StartPos);
repeat
Last:=CurPos.Flag;
ReadNextAtom;
if UpAtomIs('APPLICATION') then
begin
AppPos:=CurPos.StartPos;
if FirstAppPos=-1 then
FirstAppPos:=AppPos;
ReadNextAtom;
if AtomIsChar('.') then
begin // Application.APropertyUpCase:=XYZ;
if ReadNextUpAtomIs(APropertyUpCase) and ReadNextUpAtomIs(':=') then
case CurPos.Flag of
cafWord:
if UpAtomIs('APPLICATION')
and ((Last=cafSemicolon)
or ((Last=cafWord) and LastAtomIs(1,'begin'))) then
begin
AppPos:=CurPos.StartPos;
if FirstAppPos=-1 then
FirstAppPos:=AppPos;
ReadNextAtom;
if CurPos.Flag=cafPoint then
begin
StartPos:=AppPos;
repeat // read till semicolon or end
if ReadNextUpAtomIs(APropertyUpCase) and ReadNextUpAtomIs(':=') then
begin
// Found Application.APropertyUpCase:=
StartPos:=AppPos;
ReadNextAtom;
if ConstStartPos<1 then
ConstStartPos:=CurPos.StartPos;
ConstStartPos:=CurPos.StartPos;
// find end of assignment
ReadTilStatementEnd(true,false);
EndPos:=CurPos.EndPos;
if CurPos.Flag in [cafEnd,cafSemicolon] then
exit(true);
until CurPos.StartPos>SrcLen;
end;
end
else // Application:=TMyApplication.Create(nil);
if UpAtomIs(':=') and ReadNextUpAtomIs('TMYAPPLICATION')
and ReadNextAtomIsChar('.') and ReadNextUpAtomIs('CREATE') then
repeat // read till semicolon or end
ReadNextAtom;
StartPos:=CurPos.EndPos; // Insert point behind the TMyApplication.Create line.
exit(true);
end;
end
else // Application:=TMyApplication.Create(nil);
if CurPos.Flag=cafAssignment then begin
// Application:=
ReadTilStatementEnd(true,false);
if CurPos.Flag in [cafEnd,cafSemicolon] then
break;
until CurPos.StartPos>SrcLen;
StartPos:=CurPos.EndPos;
end;
end;
cafRoundBracketOpen,cafEdgedBracketOpen:
ReadTilBracketCloseOrUnexpected(true,[]);
end; // UpAtomIs('APPLICATION')
until (CurPos.StartPos>SrcLen);
// The statement was not found. Return a good place for insertion.
if StartPos=-1 then
if FirstAppPos <> -1 then
if StartPos=-1 then begin
if FirstAppPos>0 then
StartPos:=FirstAppPos // Before first Application statement if there is one
else begin
MoveCursorToNodeStart(MainBeginNode);
ReadNextAtom;
StartPos:=CurPos.EndPos; // or after the main Begin.
end;
end;
EndPos:=StartPos; // Both StartPos and EndPos return the same insert point.
end;

87
components/codetools/tests/teststdcodetools.pas
View File

@ -45,6 +45,7 @@ type
procedure TestCTAddWarn5025_Program;
procedure TestCTAddWarn5025_ProgramNoName;
procedure TestCTAddWarn5025_Unit;
procedure TestCTSetApplicationTitleStatement;
end;
implementation
@ -512,6 +513,92 @@ begin
,'end.'],'5025','',false);
end;
procedure TTestCTStdCodetools.TestCTSetApplicationTitleStatement;
procedure TestSrc(NewTitle, OldBeginEnd, NewBeginEnd: string);
var
Header, OldSrc, ExpectedSrc, ActualSrc: String;
Code: TCodeBuffer;
begin
Header:='program TestStdCodeTools;'+LineEnding;
OldSrc:=Header+OldBeginEnd;
ExpectedSrc:=Header+NewBeginEnd;
Code:=CodeToolBoss.CreateFile('TestStdCodeTools.pas');
Code.Source:=OldSrc;
if not CodeToolBoss.SetApplicationTitleStatement(Code,NewTitle) then
begin
writeln('Src=[');
writeln(OldSrc,']');
AssertEquals('SetApplicationTitleStatement failed: '+CodeToolBoss.ErrorMessage,true,false);
end else begin
ActualSrc:=Code.Source;
if ActualSrc=ExpectedSrc then exit;
writeln('TTestCTStdCodetools.TestCTSetApplicationTitleStatement OldSrc:');
writeln(OldSrc);
writeln('TTestCTStdCodetools.TestCTSetApplicationTitleStatement NewTitle="',NewTitle,'" ExpectedSrc:');
writeln(ExpectedSrc);
writeln('TTestCTStdCodetools.TestCTSetApplicationTitleStatement But found NewSrc:');
writeln(ActualSrc);
Fail('SetApplicationTitleStatement with Title="'+NewTitle+'"');
end;
end;
procedure TestLines(NewTitle: string; OldBeginEnd, NewBeginEnd: array of string);
var
OldSrc, NewSrc: String;
i: Integer;
begin
OldSrc:='';
for i:=Low(OldBeginEnd) to High(OldBeginEnd) do
OldSrc+=OldBeginEnd[i]+LineEnding;
NewSrc:='';
for i:=Low(NewBeginEnd) to High(NewBeginEnd) do
NewSrc+=NewBeginEnd[i]+LineEnding;
TestSrc(NewTitle,OldSrc,NewSrc);
end;
begin
TestLines('TitleNew',
['begin',
'end.'],
['begin',
' Application.Title:=''TitleNew'';',
'end.']);
// test replace
TestLines('TitleNew',
['begin',
' Application.Title:=''TitleOld'';',
'end.'],
['begin',
' Application.Title:=''TitleNew'';',
'end.']);
// test add, ignoring Application as param
TestLines('TitleNew',
['begin',
' Client:=TClient.Create(Application);',
' if not Client.ReadParams then exit;',
'end.'],
['begin',
' Application.Title:=''TitleNew'';',
' Client:=TClient.Create(Application);',
' if not Client.ReadParams then exit;',
'end.']);
// test add, behind Application:=Something; statement
TestLines('TitleNew',
['begin',
' Application:=TMyApplication.Create;',
' if not Client.ReadParams then exit;',
'end.'],
['begin',
' Application:=TMyApplication.Create;',
' Application.Title:=''TitleNew'';',
' if not Client.ReadParams then exit;',
'end.']);
end;
initialization
RegisterTest(TTestCTStdCodetools);