codetools: renamed CompleteComponent to AddPublishedVariables, added tests

components/codetools/codetoolmanager.pas

@@ -834,8 +834,10 @@ type
       out AncestorClassName: string; DirtySearch: boolean): boolean;
 
     // form components
-    function CompleteComponent(Code: TCodeBuffer;
+    function AddPublishedVariables(Code: TCodeBuffer;
           AComponent, AncestorComponent: TComponent): boolean;
+    function CompleteComponent(Code: TCodeBuffer;
+          AComponent, AncestorComponent: TComponent): boolean; deprecated 'use AddPublishedVariables';
     function PublishedVariableExists(Code: TCodeBuffer;
           const AClassName, AVarName: string;
           ErrorOnClassNotFound: boolean): boolean;
@@ -5793,8 +5795,8 @@ begin
   end;
 end;
 
-function TCodeToolManager.CompleteComponent(Code: TCodeBuffer;
-  AComponent, AncestorComponent: TComponent): boolean;
+function TCodeToolManager.AddPublishedVariables(Code: TCodeBuffer; AComponent,
+  AncestorComponent: TComponent): boolean;
 begin
   Result:=false;
   {$IFDEF CTDEBUG}
@@ -5802,13 +5804,19 @@ begin
   {$ENDIF}
   if not InitCurCodeTool(Code) then exit;
   try
-    Result:=FCurCodeTool.CompleteComponent(AComponent,AncestorComponent,
+    Result:=FCurCodeTool.AddPublishedVariables(AComponent,AncestorComponent,
                                            SourceChangeCache);
   except
     on e: Exception do Result:=HandleException(e);
   end;
 end;
 
+function TCodeToolManager.CompleteComponent(Code: TCodeBuffer; AComponent,
+  AncestorComponent: TComponent): boolean;
+begin
+  Result:=AddPublishedVariables(Code,AComponent,AncestorComponent);
+end;
+
 function TCodeToolManager.PublishedVariableExists(Code: TCodeBuffer;
   const AClassName, AVarName: string; ErrorOnClassNotFound: boolean): boolean;
 begin

components/codetools/eventcodetool.pas

@@ -65,9 +65,11 @@ type
     function CollectPublishedMethods(Params: TFindDeclarationParams;
       const FoundContext: TFindContext): TIdentifierFoundResult;
   public
-    function CompleteComponent(AComponent, AncestorComponent: TComponent;
+    function AddPublishedVariables(AComponent, AncestorComponent: TComponent;
         SourceChangeCache: TSourceChangeCache): boolean;
-  
+    function CompleteComponent(AComponent, AncestorComponent: TComponent;
+        SourceChangeCache: TSourceChangeCache): boolean; deprecated 'use AddPublishedVariables';
+
     function GetCompatiblePublishedMethods(const AClassName: string;
         PropInstance: TPersistent; const PropName: string;
         const Proc: TGetStrProc): boolean;
@@ -1370,8 +1372,9 @@ begin
   Result:=ifrProceedSearch;
 end;
 
-function TEventsCodeTool.CompleteComponent(AComponent, AncestorComponent: TComponent;
-  SourceChangeCache: TSourceChangeCache): boolean;
+function TEventsCodeTool.AddPublishedVariables(AComponent,
+  AncestorComponent: TComponent; SourceChangeCache: TSourceChangeCache
+  ): boolean;
 { - Adds all missing published variable declarations to the class definition
     in the source
 }
@@ -1422,6 +1425,13 @@ begin
   end;
 end;
 
+function TEventsCodeTool.CompleteComponent(AComponent,
+  AncestorComponent: TComponent; SourceChangeCache: TSourceChangeCache
+  ): boolean;
+begin
+  Result:=AddPublishedVariables(AComponent,AncestorComponent,SourceChangeCache);
+end;
+
 function TEventsCodeTool.GetCompatiblePublishedMethods(
   const AClassName: string; PropInstance: TPersistent; const PropName: string;
   const Proc: TGetStrProc): boolean;

components/codetools/tests/moduletests/dsgn_bearbuttons.pas

@@ -0,0 +1,37 @@
+unit Dsgn_BearButtons;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Dsgn_BearControls;
+
+type
+
+  { TBearCustomButton }
+
+  TBearCustomButton = class(TBearControl)
+  private
+    FOnClick: TNotifyEvent;
+  public
+    property OnClick: TNotifyEvent read FOnClick write FOnClick;
+  end;
+
+  { TBearButton }
+
+  TBearButton = class(TBearCustomButton)
+  published
+    property Caption;
+    property Height;
+    property Left;
+    property OnClick;
+    property Top;
+    property Visible;
+    property Width;
+  end;
+
+implementation
+
+end.
+

components/codetools/tests/moduletests/dsgn_bearcontrols.pas

@@ -0,0 +1,221 @@
+{
+  Simple components for testing the RTTI capabilities of codetools
+
+}
+unit Dsgn_BearControls;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+
+  { TBearComponent }
+
+  TBearComponent = class(TComponent)
+
+  end;
+
+  TBearCaption = type string;
+
+  { TBearControl }
+
+  TBearControl = class(TBearComponent)
+  private
+    FCaption: TBearCaption;
+    FControls: TFPList; // list of TBearControl
+    FHeight: integer;
+    FLeft: integer;
+    FParent: TBearControl;
+    FTop: integer;
+    FVisible: boolean;
+    FWidth: integer;
+    function GetControlCount: integer;
+    function GetControls(Index: integer): TBearControl;
+    procedure SetParent(const AValue: TBearControl);
+    procedure SetVisible(const AValue: boolean);
+  protected
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation);
+      override;
+    procedure SetParentComponent(Value: TComponent); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    function GetParentComponent: TComponent; override;
+    function IsParentOf(AControl: TBearControl): boolean;
+    function HasParent: Boolean; override;
+    property Caption: TBearCaption read FCaption write FCaption;
+    property ControlCount: integer read GetControlCount;
+    property Controls[Index: integer]: TBearControl read GetControls;
+    property Height: integer read FHeight write FHeight;
+    property Left: integer read FLeft write FLeft;
+    property Parent: TBearControl read FParent write SetParent;
+    property Top: integer read FTop write FTop;
+    property Visible: boolean read FVisible write SetVisible;
+    property Width: integer read FWidth write FWidth;
+  end;
+
+  { TBearCustomForm }
+
+  TBearCustomForm = class(TBearControl)
+
+  end;
+
+  { TBearForm }
+
+  TBearForm = class(TBearCustomForm)
+  published
+    property Caption;
+    property Height;
+    property Left;
+    property Top;
+    property Visible;
+    property Width;
+  end;
+
+  { TBearCustomLabel }
+
+  TBearCustomLabel = class(TBearControl)
+
+  end;
+
+  { TBearLabel }
+
+  TBearLabel = class(TBearCustomLabel)
+  published
+    property Caption;
+    property Height;
+    property Left;
+    property Top;
+    property Visible;
+    property Width;
+  end;
+
+  { TBearCustomPanel }
+
+  TBearCustomPanel = class(TBearControl)
+  private
+    FBevelWidth: word;
+  public
+    property BevelWidth: word read FBevelWidth write FBevelWidth;
+  end;
+
+  { TBearPanel }
+
+  TBearPanel = class(TBearCustomPanel)
+  published
+    property BevelWidth;
+    property Height;
+    property Left;
+    property Top;
+    property Visible;
+    property Width;
+  end;
+
+implementation
+
+{ TBearControl }
+
+function TBearControl.GetControlCount: integer;
+begin
+  Result:=FControls.Count;
+end;
+
+function TBearControl.GetControls(Index: integer): TBearControl;
+begin
+  Result:=TBearControl(FControls[Index]);
+end;
+
+procedure TBearControl.SetParent(const AValue: TBearControl);
+begin
+  if FParent=AValue then Exit;
+  if AValue=Self then
+    raise Exception.Create('TBearControl.SetParent Self');
+  if (AValue<>nil) and IsParentOf(AValue) then
+    raise Exception.Create('TBearControl.SetParent cycle');
+  if FParent<>nil then
+    FParent.FControls.Remove(Self);
+  FParent:=AValue;
+  if FParent<>nil then begin
+    FParent.FControls.Add(Self);
+    FreeNotification(FParent);
+  end;
+end;
+
+procedure TBearControl.SetVisible(const AValue: boolean);
+begin
+  if FVisible=AValue then Exit;
+  FVisible:=AValue;
+end;
+
+procedure TBearControl.GetChildren(Proc: TGetChildProc; Root: TComponent);
+var
+  I: Integer;
+  Control: TBearControl;
+begin
+  for I := 0 to ControlCount-1 do
+  begin
+    Control := Controls[i];
+    if Control.Owner = Root then Proc(Control);
+  end;
+end;
+
+procedure TBearControl.SetParentComponent(Value: TComponent);
+begin
+  if Value is TBearControl then
+    Parent:=TBearControl(Value);
+end;
+
+procedure TBearControl.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation=opRemove then
+  begin
+    if AComponent=FParent then
+      FParent:=nil
+    else
+      FControls.Remove(AComponent);
+  end;
+end;
+
+constructor TBearControl.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FControls:=TFPList.Create;
+end;
+
+destructor TBearControl.Destroy;
+begin
+  Parent:=nil;
+  FreeAndNil(FControls);
+  inherited Destroy;
+end;
+
+function TBearControl.GetParentComponent: TComponent;
+begin
+  Result:=Parent;
+end;
+
+function TBearControl.IsParentOf(AControl: TBearControl): boolean;
+begin
+  Result := False;
+  while Assigned(AControl) do
+  begin
+    AControl := AControl.Parent;
+    if Self = AControl then
+      Exit(True);
+  end;
+end;
+
+function TBearControl.HasParent: Boolean;
+begin
+  Result:=Parent<>nil;
+end;
+
+end.
+

components/codetools/tests/runtestscodetools.lpi

@@ -37,7 +37,7 @@
         <PackageName Value="fpcunitconsolerunner"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="17">
+    <Units Count="20">
       <Unit0>
         <Filename Value="runtestscodetools.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -119,6 +119,21 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TestLFMTrees"/>
       </Unit16>
+      <Unit17>
+        <Filename Value="testdesignerformtools.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TestDesignerFormTools"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="moduletests/dsgn_bearcontrols.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Dsgn_BearControls"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="moduletests/dsgn_bearbuttons.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Dsgn_BearButtons"/>
+      </Unit19>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

components/codetools/tests/runtestscodetools.lpr

@@ -39,7 +39,8 @@ uses
   TestBasicCodetools, TestCTRangeScan, TestPascalParser, TestMethodJumpTool,
   TestStdCodetools, TestFindDeclaration, TestIdentCompletion, TestCompleteBlock,
   TestRefactoring, TestCodeCompletion, TestCompReaderWriterPas,
-  fdt_arrays, TestCTPas2js, testchangedeclaration, testlfmtrees;
+  fdt_arrays, TestCTPas2js, TestChangeDeclaration, TestLFMTrees, 
+  TestDesignerFormTools, Dsgn_BearButtons;
 
 const
   ConfigFilename = 'codetools.config';

components/codetools/tests/testcodecompletion.pas

@@ -18,15 +18,7 @@ type
     procedure Test(Title: string; Src: array of string; Line, Col: integer;
       Expected: array of string);
   published
-    procedure TestIntfProcUpdateArgName;
-    procedure TestIntfCompleteMethodBody_ResultGenericObjFPC;
-    procedure TestIntfCompleteMethodBody_ResultGenericDelphi;
-    procedure TestMethodUpdateArgName_GenericObjFPC;
-    procedure TestMethodUpdateArgName_GenericDelphi;
-    procedure TestCompleteMethodSignature_Def_GenericObjFPC;
-    procedure TestCompleteMethodSignature_Body_GenericObjFPC;
-    procedure TestCompleteMethodSignature_Def_GenericDelphi;
-    procedure TestCompleteMethodSignature_Body_GenericDelphi; // todo
+    // class completion: add missing method body
     procedure TestCompleteMethodBody_GenericObjFPC;
     procedure TestCompleteMethodBody_GenericDelphi;
     procedure TestCompleteMethodBody_GenericMethod;
@@ -34,22 +26,40 @@ type
     procedure TestCompleteMethodBody_GenericFunctionResultDelphi;
     procedure TestCompleteMethodBody_ParamGenericObjFPC;
     procedure TestCompleteMethodBody_ParamGenericDelphi;
+    // class completion: sync method arg name to body
+    procedure TestMethodUpdateArgName_GenericObjFPC;
+    procedure TestMethodUpdateArgName_GenericDelphi;
+    procedure TestCompleteMethodSignature_Def_GenericObjFPC;
+    procedure TestCompleteMethodSignature_Body_GenericObjFPC;
+    procedure TestCompleteMethodSignature_Def_GenericDelphi;
+    procedure TestCompleteMethodSignature_Body_GenericDelphi; // todo
+    // class completion: sync method parentheses to body
+    procedure TestCompleteMethodSignature_Empty_Parentheses;
+    procedure TestCompleteMethodSignature_Without_Parentheses;
+    // class completion: property
     procedure TestCompleteProperty_TypeWithUnitname;
     procedure TestCompleteProperty_TypeGenericObjFPC;
     procedure TestCompleteProperty_TypeGenericDelphi;
     procedure TestCompleteProperty_GenericObjFPC;
     procedure TestCompleteProperty_GenericDelphi;
-    procedure TestCompleteVariableWithSpecializedType;
-    procedure TestCompleteMethodSignature_Empty_Parentheses;
-    procedure TestCompleteMethodSignature_Without_Parentheses;
-    procedure TestCompleteEventAssignmentDelphi;
-    procedure TestCompleteEventAssignmentObjFPC;
-    procedure TestCompleteEventAssignmentObjFPC_AtName;
+    // class completion: insert first method body between other classes
     procedure TestCompleteClass_Unit_NewClass;
     procedure TestCompleteClass_Unit_NewClass_BehindOldClass;
     procedure TestCompleteClass_Unit_NewClass_InFrontOfOldClass;
     procedure TestCompleteClass_Unit_NewClass_BetweenOldClasses;
     procedure TestCompleteNestedClass_Unit_NewClass_BehindParentClass;
+
+    // procedure completion: sync interface procedure to body
+    procedure TestIntfProcUpdateArgName;
+    procedure TestIntfCompleteMethodBody_ResultGenericObjFPC;
+    procedure TestIntfCompleteMethodBody_ResultGenericDelphi;
+
+    // declare local variable
+    procedure TestCompleteVariableWithSpecializedType;
+    // complete event assignment
+    procedure TestCompleteEventAssignmentDelphi;
+    procedure TestCompleteEventAssignmentObjFPC;
+    procedure TestCompleteEventAssignmentObjFPC_AtName;
   end;
 
 implementation
@@ -1299,7 +1309,6 @@ begin
     ,'end.']);
 end;
 
-
 initialization
   RegisterTests([TTestCodeCompletion]);
 end.

components/codetools/tests/testdesignerformtools.pas

@@ -0,0 +1,151 @@
+unit TestDesignerFormTools;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, CodeToolManager, CodeCache, DefineTemplates,
+  LazLogger, LazFileUtils, fpcunit, testregistry,
+  TestFinddeclaration, TestStdCodetools, Dsgn_BearControls, Dsgn_BearButtons;
+
+type
+  TBearForm1 = class(TBearForm)
+  end;
+
+  { TTestDesignerFormTools }
+
+  TTestDesignerFormTools = class(TCustomTestCTStdCodetools)
+  private
+    procedure TestAddPublishedBearVars(Title: string; Src: array of string;
+      Expected: array of string);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  public
+    BearForm1: TBearForm1;
+  published
+    // add published variables
+    procedure TestAddPublishedVariables_Empty;
+    procedure TestAddPublishedVariables_Button1;
+  end;
+
+implementation
+
+{ TTestDesignerFormTools }
+
+procedure TTestDesignerFormTools.TestAddPublishedBearVars(Title: string;
+  Src: array of string; Expected: array of string);
+var
+  i, NewX, NewY: Integer;
+  s, Dir: String;
+  NewCode, Code: TCodeBuffer;
+  DefTemp: TDefineTemplate;
+begin
+  Code:=CodeToolBoss.CreateFile('test1.pas');
+  s:='';
+  for i:=Low(Src) to High(Src) do
+    s+=Src[i]+LineEnding;
+  Code.Source:=s;
+
+  Dir:=AppendPathDelim(GetCurrentDir)+'moduletests';
+  DefTemp:=TDefineTemplate.Create('unitpath','add moduletests',UnitPathMacroName,Dir,da_Define);
+  try
+    CodeToolBoss.DefineTree.Add(DefTemp);
+
+    //debugln(['TTestFindDeclaration.TestFindDeclaration_UnitSearch_CurrentDir ',CodeToolBoss.GetUnitPathForDirectory('')]);
+
+    if not CodeToolBoss.AddPublishedVariables(Code,BearForm1,nil)
+    and (CodeToolBoss.ErrorDbgMsg<>'') then
+    begin
+      NewCode:=Code;
+      NewY:=1;
+      NewX:=1;
+      if (CodeToolBoss.ErrorCode<>nil) and (CodeToolBoss.ErrorLine>0) then begin
+        NewY:=CodeToolBoss.ErrorLine;
+        NewX:=CodeToolBoss.ErrorColumn;
+        NewCode:=CodeToolBoss.ErrorCode;
+      end;
+      WriteSource(NewCode.Filename,NewY,NewX);
+      Fail(Title+': call CompleteCode failed: "'+CodeToolBoss.ErrorDbgMsg+'"');
+    end;
+    s:='';
+    for i:=Low(Expected) to High(Expected) do
+      s+=Expected[i]+LineEnding;
+    CheckDiff(Title,s,Code.Source);
+  finally
+    CodeToolBoss.DefineTree.RemoveDefineTemplate(DefTemp);
+  end;
+end;
+
+procedure TTestDesignerFormTools.SetUp;
+begin
+  inherited SetUp;
+  BearForm1:=TBearForm1.Create(nil);
+end;
+
+procedure TTestDesignerFormTools.TearDown;
+begin
+  FreeAndNil(BearForm1);
+  inherited TearDown;
+end;
+
+procedure TTestDesignerFormTools.TestAddPublishedVariables_Empty;
+begin
+  TestAddPublishedBearVars('TestAddPublishedVariables_Empty',
+    ['unit test1;'
+    ,'{$mode objfpc}{$H+}'
+    ,'interface'
+    ,'uses Dsgn_BearControls;'
+    ,'type'
+    ,'  TBearForm1 = class(TBearForm)'
+    ,'  end;'
+    ,'implementation'
+    ,'end.'],
+    ['unit test1;'
+    ,'{$mode objfpc}{$H+}'
+    ,'interface'
+    ,'uses Dsgn_BearControls;'
+    ,'type'
+    ,'  { TBearForm1 }'
+    ,'  TBearForm1 = class(TBearForm)'
+    ,'  end;'
+    ,'implementation'
+    ,'end.']);
+end;
+
+procedure TTestDesignerFormTools.TestAddPublishedVariables_Button1;
+var
+  Btn: TBearButton;
+begin
+  Btn:=TBearButton.Create(BearForm1);
+  Btn.Name:='Button1';
+
+  TestAddPublishedBearVars('TestAddPublishedVariables_Empty',
+    ['unit test1;'
+    ,'{$mode objfpc}{$H+}'
+    ,'interface'
+    ,'uses Dsgn_BearControls, Dsgn_BearButtons;'
+    ,'type'
+    ,'  TBearForm1 = class(TBearForm)'
+    ,'  end;'
+    ,'implementation'
+    ,'end.'],
+    ['unit test1;'
+    ,'{$mode objfpc}{$H+}'
+    ,'interface'
+    ,'uses Dsgn_BearControls, Dsgn_BearButtons;'
+    ,'type'
+    ,'  { TBearForm1 }'
+    ,'  TBearForm1 = class(TBearForm)'
+    ,'    Button1: TBearButton;'
+    ,'  end;'
+    ,'implementation'
+    ,'end.']);
+end;
+
+initialization
+  RegisterTests([TTestDesignerFormTools]);
+
+end.
+

ide/main.pp

@@ -12403,8 +12403,8 @@ begin
     SourceEditorManager.AddJumpPointClicked(Self);
     // Add component definitions to form's source code
     Ancestor:=GetAncestorLookupRoot(FComponentAddedUnit);
-    CodeToolBoss.CompleteComponent(FComponentAddedUnit.Source,
-                                   FComponentAddedDesigner.LookupRoot, Ancestor);
+    CodeToolBoss.AddPublishedVariables(FComponentAddedUnit.Source,
+                                  FComponentAddedDesigner.LookupRoot, Ancestor);
     FComponentAddedDesigner:=nil;
   end;