diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index c96181d2f8..de17ed9838 100644 --- a/components/codetools/stdcodetools.pas +++ b/components/codetools/stdcodetools.pas @@ -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; diff --git a/components/codetools/tests/teststdcodetools.pas b/components/codetools/tests/teststdcodetools.pas index 8c2d9b46e4..b83d9a22b3 100644 --- a/components/codetools/tests/teststdcodetools.pas +++ b/components/codetools/tests/teststdcodetools.pas @@ -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);