codetools: added FindWithBlockStatement

git-svn-id: trunk@50264 -

components/codetools/pascalreadertool.pas

@@ -242,13 +242,15 @@ type
     function MoveCursorToParameterSpecifier(DefinitionNode: TCodeTreeNode
                                             ): boolean;
     function GetFirstGroupVarNode(VarNode: TCodeTreeNode): TCodeTreeNode;
-    function FindEndOfWithVar(WithVarNode: TCodeTreeNode): integer;
     function NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
     function NodeCanHaveForwardType(TypeNode: TCodeTreeNode): boolean;
     function NodeIsForwardType(TypeNode: TCodeTreeNode): boolean;
     function FindForwardTypeNode(TypeNode: TCodeTreeNode;
                                  SearchFirst: boolean): TCodeTreeNode;
     function FindTypeOfForwardNode(TypeNode: TCodeTreeNode): TCodeTreeNode;
+    function FindEndOfWithExpr(WithVarNode: TCodeTreeNode): integer;
+    function ExtractWithBlockExpression(WithVarNode: TCodeTreeNode; Attr: TProcHeadAttributes = []): string;
+    function FindWithBlockStatement(WithVarNode: TCodeTreeNode): TCodeTreeNode;
 
     // arrays
     function ExtractArrayRange(ArrayNode: TCodeTreeNode;
@@ -2830,14 +2832,41 @@ begin
   end;
 end;
 
-function TPascalReaderTool.FindEndOfWithVar(WithVarNode: TCodeTreeNode): integer;
+function TPascalReaderTool.FindEndOfWithExpr(WithVarNode: TCodeTreeNode): integer;
 begin
+  if WithVarNode.Desc<>ctnWithVariable then exit(-1);
   MoveCursorToCleanPos(WithVarNode.StartPos);
+  ReadNextAtom;
   if not ReadTilVariableEnd(true,true) then exit(-1);
   UndoReadNextAtom;
   Result:=CurPos.EndPos;
 end;
 
+function TPascalReaderTool.ExtractWithBlockExpression(
+  WithVarNode: TCodeTreeNode; Attr: TProcHeadAttributes): string;
+var
+  EndPos: Integer;
+begin
+  EndPos:=FindEndOfWithExpr(WithVarNode);
+  if EndPos<1 then exit('');
+  Result:=ExtractCode(WithVarNode.StartPos,EndPos,Attr);
+end;
+
+function TPascalReaderTool.FindWithBlockStatement(WithVarNode: TCodeTreeNode
+  ): TCodeTreeNode;
+begin
+  Result:=WithVarNode;
+  repeat
+    if Result=nil then exit;
+    if Result.Desc<>ctnWithVariable then exit(nil);
+    if Result.FirstChild<>nil then begin
+      Result:=Result.FirstChild;
+      if Result.Desc=ctnWithStatement then exit;
+      exit(nil);
+    end;
+  until false;
+end;
+
 function TPascalReaderTool.NodeIsIdentifierInInterface(Node: TCodeTreeNode): boolean;
 // true if identifier is visible from other units (without prefixing)
 begin

components/codetools/sourcechanger.pas

@@ -297,8 +297,7 @@ type
     function Apply: boolean;
     function FindEntryInRange(FromPos, ToPos: integer): TSourceChangeCacheEntry;
     function FindEntryAtPos(APos: integer): TSourceChangeCacheEntry;
-    property BuffersToModify[Index: integer]: TCodeBuffer
-                                                        read GetBuffersToModify;
+    property BuffersToModify[Index: integer]: TCodeBuffer read GetBuffersToModify;
     function BuffersToModifyCount: integer;
     function BufferIsModified(ACode: TCodeBuffer): boolean;
     property OnBeforeApplyChanges: TOnBeforeApplyChanges
@@ -642,7 +641,8 @@ end;
 
 function TSourceChangeCache.FindEntryInRange(
   FromPos, ToPos: integer): TSourceChangeCacheEntry;
-var ANode: TAVLTreeNode;
+var
+  ANode: TAVLTreeNode;
   NextNode: TAVLTreeNode;
 begin
   ANode:=FEntries.Root;

components/codetools/tests/refactoringtests.pas

@@ -10,9 +10,12 @@ unit RefactoringTests;
 interface
 
 uses
-  Classes, SysUtils, CodeToolManager, CodeCache, CodeTree, LazLogger,
-  LazFileUtils, fpcunit, testregistry, FindDeclarationTests;
+  Classes, SysUtils, CodeToolManager, CodeCache, CodeTree,
+  BasicCodeTools, LazLogger, LazFileUtils, fpcunit, testregistry,
+  FindDeclarationTests;
 
+const
+  ExplodeWithMarker = 'explodewith:';
 type
 
   { TTestRefactoring }
@@ -31,49 +34,107 @@ implementation
 { TTestRefactoring }
 
 procedure TTestRefactoring.TestExplodeWith;
+type
+  TWithBlock = record
+    CodeXYPos: TCodeXYPosition;
+    WithExpr: string;
+    StatementStartPos: integer;
+    StatementEndPos: integer;
+  end;
+  PWithBlock = ^TWithBlock;
 var
   Code: TCodeBuffer;
   Tool: TCodeTool;
-  Node: TCodeTreeNode;
+  Node, StatementNode: TCodeTreeNode;
   CodeXYPos: TCodeXYPosition;
-  ListOfPCodeXYPosition: TFPList;
-  i: Integer;
-  Filename, OldSource: String;
+  ListOfWiths: array of TWithBlock;
+  i, NewStartPos, NewEndPos, p, CommentStartPos, CommentEndPos: Integer;
+  Filename, OldSource, Src, ID, ExpectedInsertion: String;
+  aWith: PWithBlock;
 begin
   Filename:=ExpandFileNameUTF8('rt_explodewith.pas');
   Code:=CodeToolBoss.LoadFile(Filename,true,false);
   AssertEquals('Load file error: '+Filename,true,Code<>nil);
   if not CodeToolBoss.Explore(Code,Tool,true) then
     AssertEquals('Parse error: ','',CodeToolBoss.ErrorMessage);
-  ListOfPCodeXYPosition:=nil;
-  try
-    // collect all With-Blocks
-    Node:=Tool.Tree.Root;
-    while Node<>nil do begin
-      if Node.Desc=ctnWithVariable then begin
-        Tool.CleanPosToCaret(Node.StartPos,CodeXYPos);
-        AddCodePosition(ListOfPCodeXYPosition,CodeXYPos);
+  // collect all With-Blocks
+  Node:=Tool.Tree.Root;
+  SetLength(ListOfWiths,0);
+  while Node<>nil do begin
+    if Node.Desc=ctnWithVariable then begin
+      Tool.CleanPosToCaret(Node.StartPos,CodeXYPos);
+      StatementNode:=Tool.FindWithBlockStatement(Node);
+      if StatementNode<>nil then begin
+        SetLength(ListOfWiths,length(ListOfWiths)+1);
+        aWith:=@ListOfWiths[High(ListOfWiths)];
+        aWith^.CodeXYPos:=CodeXYPos;
+        aWith^.WithExpr:=Tool.ExtractWithBlockExpression(Node,[]);
+        aWith^.StatementStartPos:=FindPrevNonSpace(Code.Source,StatementNode.StartPos);
+        aWith^.StatementEndPos:=StatementNode.EndPos;
       end;
-      Node:=Node.Next;
     end;
+    Node:=Node.Next;
+  end;
 
-    for i:=0 to ListOfPCodeXYPosition.Count-1 do begin
-      CodeXYPos:=PCodeXYPosition(ListOfPCodeXYPosition[i])^;
-      debugln(['TTestRefactoring.TestExplodeWith ',dbgs(CodeXYPos)]);
-      OldSource:=Code.Source;
-      try
-        if CodeToolBoss.RemoveWithBlock(Code,CodeXYPos.X,CodeXYPos.Y) then begin
-          // check changes
-
-        end else begin
-          AssertEquals('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos),'',CodeToolBoss.ErrorMessage);
+  for i:=0 to High(ListOfWiths) do begin
+    aWith:=@ListOfWiths[i];
+    CodeXYPos:=aWith^.CodeXYPos;
+    //debugln(['TTestRefactoring.TestExplodeWith ',dbgs(CodeXYPos)]);
+    OldSource:=Code.Source;
+    try
+      if CodeToolBoss.RemoveWithBlock(Code,CodeXYPos.X,CodeXYPos.Y) then begin
+        // success
+        // => check changes
+        // get new bounds
+        NewStartPos:=aWith^.StatementStartPos;
+        NewEndPos:=aWith^.StatementEndPos;
+        Code.AdjustPosition(NewStartPos);
+        Code.AdjustPosition(NewEndPos);
+        if (NewStartPos<1) or (NewStartPos>Code.SourceLength)
+        or (NewEndPos<1) or (NewEndPos>Code.SourceLength)
+        or (NewEndPos<NewStartPos)
+        then begin
+          debugln(['TTestRefactoring.TestExplodeWith WrongCode: ']);
+          debugln(Code.Source);
+          Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos));
         end;
-      finally
-        Code.Source:=OldSource;
+        // check each marker
+        Src:=Code.Source;
+        //debugln(['TTestRefactoring.TestExplodeWith ',copy(Src,NewStartPos,NewEndPos-NewStartPos)]);
+        p:=NewStartPos;
+        repeat
+          CommentStartPos:=FindNextComment(Src,p,NewEndPos);
+          if CommentStartPos>=NewEndPos then break;
+          p:=CommentStartPos;
+          CommentEndPos:=FindCommentEnd(Src,CommentStartPos,Tool.Scanner.NestedComments);
+          if Src[p]='{' then begin
+            inc(p);
+            if copy(Src,p,length(ExplodeWithMarker))=ExplodeWithMarker then begin
+              inc(p,length(ExplodeWithMarker));
+              ID:=copy(Src,p,CommentEndPos-p-1);
+              if ID=aWith^.WithExpr then begin
+                // this marker expects an insertion
+                ExpectedInsertion:=Id+'.';
+                if copy(Src,CommentEndPos,length(ExpectedInsertion))<>ExpectedInsertion
+                then begin
+                  Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos)
+                    +': Expected insertion "'+ExpectedInsertion+'"'
+                    +' at '+Code.AbsoluteToLineColStr(CommentEndPos)
+                    +', but found "'+dbgstr(Src,CommentStartPos,20)+'"');
+                end;
+              end;
+            end;
+          end;
+          p:=CommentEndPos;
+        until false;
+
+
+      end else begin
+        Fail('CodeToolBoss.RemoveWithBlock failed at '+dbgs(CodeXYPos)+': '+CodeToolBoss.ErrorMessage);
       end;
+    finally
+      Code.Source:=OldSource;
     end;
-  finally
-    FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
   end;
 end;