codetools: fixed SetApplicationTitleStatement for Application as param

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
+    case CurPos.Flag of
-    begin
+    cafWord:
-      AppPos:=CurPos.StartPos;
+      if UpAtomIs('APPLICATION')
-      if FirstAppPos=-1 then
+        and ((Last=cafSemicolon)
-        FirstAppPos:=AppPos;
+          or ((Last=cafWord) and LastAtomIs(1,'begin'))) then
-      ReadNextAtom;
+      begin
-      if AtomIsChar('.') then
+        AppPos:=CurPos.StartPos;
-      begin                    // Application.APropertyUpCase:=XYZ;
+        if FirstAppPos=-1 then
-        if ReadNextUpAtomIs(APropertyUpCase) and ReadNextUpAtomIs(':=') then
+          FirstAppPos:=AppPos;
+        ReadNextAtom;
+        if CurPos.Flag=cafPoint then
         begin
-          StartPos:=AppPos;
+          if ReadNextUpAtomIs(APropertyUpCase) and ReadNextUpAtomIs(':=') then
-          repeat               // read till semicolon or end
+          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);
-              exit(true);
+          end;
-          until CurPos.StartPos>SrcLen;
+        end
-        end;
+        else // Application:=TMyApplication.Create(nil);
-      end
+        if CurPos.Flag=cafAssignment then begin
-      else                     // Application:=TMyApplication.Create(nil);
+          // Application:=
-      if UpAtomIs(':=') and ReadNextUpAtomIs('TMYAPPLICATION')
+          ReadTilStatementEnd(true,false);
-      and ReadNextAtomIsChar('.') and ReadNextUpAtomIs('CREATE') then
-        repeat                 // read till semicolon or end
-          ReadNextAtom;
-          StartPos:=CurPos.EndPos; // Insert point behind the TMyApplication.Create line.
           if CurPos.Flag in [cafEnd,cafSemicolon] then
-            break;
+            StartPos:=CurPos.EndPos;
-        until CurPos.StartPos>SrcLen;
+        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 StartPos=-1 then begin
-    if FirstAppPos <> -1 then
+    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;
 

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);