paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-23 10:39:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: added GatherPublishedVarTypes, CompleteComponent with optional CheckUnits

Browse Source
This commit is contained in:
mattias 2023-04-11 10:49:42 +02:00
parent db82372e4b
commit 37d638661f
9 changed files with 432 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
components/codetools/codetoolmanager.pas
View File

@ -834,13 +834,13 @@ type
out AncestorClassName: string; DirtySearch: boolean): boolean;
// form components
function AddPublishedVariables(Code: TCodeBuffer;
AComponent, AncestorComponent: TComponent): boolean;
function CompleteComponent(Code: TCodeBuffer;
AComponent, AncestorComponent: TComponent): boolean; deprecated 'use AddPublishedVariables';
AComponent, AncestorComponent: TComponent; CheckUnits: boolean): boolean;
function PublishedVariableExists(Code: TCodeBuffer;
const AClassName, AVarName: string;
ErrorOnClassNotFound: boolean): boolean;
function GatherPublishedVarTypes(Code: TCodeBuffer; const AClassName: string;
out VarNameToType: TStringToStringTree): boolean;
function AddPublishedVariable(Code: TCodeBuffer;
const AClassName,VarName, VarType: string): boolean;
function RemovePublishedVariable(Code: TCodeBuffer;
@ -5795,8 +5795,8 @@ begin
end;
end;
function TCodeToolManager.AddPublishedVariables(Code: TCodeBuffer; AComponent,
AncestorComponent: TComponent): boolean;
function TCodeToolManager.CompleteComponent(Code: TCodeBuffer; AComponent,
AncestorComponent: TComponent; CheckUnits: boolean): boolean;
begin
Result:=false;
{$IFDEF CTDEBUG}
@ -5804,19 +5804,13 @@ begin
{$ENDIF}
if not InitCurCodeTool(Code) then exit;
try
Result:=FCurCodeTool.AddPublishedVariables(AComponent,AncestorComponent,
SourceChangeCache);
Result:=FCurCodeTool.CompleteComponent(AComponent,AncestorComponent,
SourceChangeCache,CheckUnits);
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
@ -5833,6 +5827,21 @@ begin
end;
end;
function TCodeToolManager.GatherPublishedVarTypes(Code: TCodeBuffer;
const AClassName: string; out VarNameToType: TStringToStringTree): boolean;
begin
Result:=false;
{$IFDEF CTDEBUG}
DebugLn('TCodeToolManager.GatherPublishedVarTypes A ',Code.Filename,' ',AClassName);
{$ENDIF}
if not InitCurCodeTool(Code) then exit;
try
Result:=FCurCodeTool.GatherPublishedVarTypes(AClassName,VarNameToType);
except
on e: Exception do Result:=HandleException(e);
end;
end;
function TCodeToolManager.AddPublishedVariable(Code: TCodeBuffer;
const AClassName, VarName, VarType: string): boolean;
begin

106
components/codetools/eventcodetool.pas
View File

@ -65,10 +65,8 @@ type
function CollectPublishedMethods(Params: TFindDeclarationParams;
const FoundContext: TFindContext): TIdentifierFoundResult;
public
function AddPublishedVariables(AComponent, AncestorComponent: TComponent;
SourceChangeCache: TSourceChangeCache): boolean;
function CompleteComponent(AComponent, AncestorComponent: TComponent;
SourceChangeCache: TSourceChangeCache): boolean; deprecated 'use AddPublishedVariables';
SourceChangeCache: TSourceChangeCache; CheckUnits: boolean): boolean;
function GetCompatiblePublishedMethods(const AClassName: string;
PropInstance: TPersistent; const PropName: string;
@ -1372,20 +1370,74 @@ begin
Result:=ifrProceedSearch;
end;
function TEventsCodeTool.AddPublishedVariables(AComponent,
AncestorComponent: TComponent; SourceChangeCache: TSourceChangeCache
): boolean;
function TEventsCodeTool.CompleteComponent(AComponent,
AncestorComponent: TComponent; SourceChangeCache: TSourceChangeCache;
CheckUnits: boolean): boolean;
{ - Adds all missing published variable declarations to the class definition
in the source
- If CheckUnits=true then check used units for ambiguous classnames and add unitnames
}
var
MissingClassTypes, ClassesNeedingUnitName: TFPList; // list of TComponentClass
procedure CheckAmbiguity;
var
UsesNode, UseUnitNode: TCodeTreeNode;
AnUnitName, InFilename, CompClassName, CompUnitName, SourceName: string;
NewCodeTool: TFindDeclarationTool;
Params: TFindDeclarationParams;
i, NewTopLine, BlockTopLine, BlockBottomLine: integer;
aCompClass: TComponentClass;
NewPos: TCodeXYPosition;
begin
if MissingClassTypes.Count=0 then exit;
// search classtypes in used units
UsesNode:=FindMainUsesNode;
if UsesNode=nil then exit;
Params:=TFindDeclarationParams.Create(nil);
try
UseUnitNode:=UsesNode.LastChild;
while UseUnitNode<>nil do begin
AnUnitName:=ExtractUsedUnitName(UseUnitNode,@InFilename);
UseUnitNode:=UseUnitNode.PriorBrother;
if AnUnitName='' then continue;
NewCodeTool:=FindCodeToolForUsedUnit(AnUnitName,InFilename,false);
if NewCodeTool=nil then continue;
SourceName:=ExtractFileNameOnly(NewCodeTool.MainFilename);
// search the classtypes in the interface of the used unit
for i:=0 to MissingClassTypes.Count-1 do begin
aCompClass:=TComponentClass(MissingClassTypes[i]);
if ClassesNeedingUnitName.IndexOf(aCompClass)>=0 then continue;
CompClassName:=aCompClass.ClassName;
CompUnitName:=aCompClass.UnitName;
if SameText(CompUnitName,SourceName) then
continue; // this is the unit of the component class
if not NewCodeTool.FindDeclarationInInterface(CompClassName,
NewPos, NewTopLine, BlockTopLine, BlockBottomLine) then continue;
// found component classtype in another unit -> needs unitname
ClassesNeedingUnitName.Add(aCompClass);
end;
end;
finally
Params.Free;
end;
end;
var
i: Integer;
CurComponent: TComponent;
VarName, VarType: String;
UpperClassName, UpperCompName: String;
UpperClassName: String;
MissingComponents: TFPList; // list of TComponent
begin
Result:=false;
ClassesNeedingUnitName:=TFPList.Create;
MissingComponents:=TFPList.Create;
MissingClassTypes:=TFPList.Create;
try
Result:=false;
ClearIgnoreErrorAfter;
BuildTree(lsrImplementationStart);
UpperClassName:=UpperCaseStr(AComponent.ClassName);
@ -1395,7 +1447,8 @@ begin
// initialize class for code completion
CodeCompleteClassNode:=FindClassNodeInInterface(UpperClassName,true,false,true);
CodeCompleteSrcChgCache:=SourceChangeCache;
// complete all child components
// collect all missing component variables
for i:=0 to AComponent.ComponentCount-1 do begin
CurComponent:=AComponent.Components[i];
{$IFDEF CTDEBUG}
@ -1404,15 +1457,28 @@ begin
VarName:=CurComponent.Name;
if VarName='' then continue;
if (AncestorComponent<>nil)
and (AncestorComponent.FindComponent(VarName)<>nil) then continue;
UpperCompName:=UpperCaseStr(VarName);
VarType:=CurComponent.ClassName;
and (AncestorComponent.FindComponent(VarName)<>nil) then continue;
// add missing published variable
if not VarExistsInCodeCompleteClass(UpperCompName) then begin
//DebugLn('[TEventsCodeTool.CompleteComponent] ADDING variable ',CurComponent.Name,':',CurComponent.ClassName);
AddClassInsertion(UpperCompName,VarName+':'+VarType+';',VarName,ncpPublishedVars);
if not VarExistsInCodeCompleteClass(UpperCaseStr(VarName)) then begin
MissingComponents.Add(CurComponent);
if MissingClassTypes.IndexOf(Pointer(CurComponent.ClassType))<0 then
MissingClassTypes.Add(CurComponent.ClassType);
end;
end;
if CheckUnits then
CheckAmbiguity;
// add component variable declarations
for i:=0 to MissingComponents.Count-1 do begin
CurComponent:=AComponent.Components[i];
VarName:=CurComponent.Name;
VarType:=CurComponent.ClassName;
if ClassesNeedingUnitName.IndexOf(CurComponent.ClassType)>=0 then
VarType:=CurComponent.UnitName+'.'+VarType;
//DebugLn('[TEventsCodeTool.CompleteComponent] ADDING variable ',CurComponent.Name,':',CurComponent.ClassName);
AddClassInsertion(UpperCaseStr(VarName),VarName+':'+VarType+';',VarName,ncpPublishedVars);
end;
{$IFDEF CTDEBUG}
DebugLn('[TEventsCodeTool.CompleteComponent] invoke class completion');
{$ENDIF}
@ -1421,17 +1487,13 @@ begin
DebugLn('[TEventsCodeTool.CompleteComponent] END');
{$ENDIF}
finally
MissingClassTypes.Free;
MissingComponents.Free;
ClassesNeedingUnitName.Free;
FreeClassInsertionList;
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;

1
components/codetools/finddeclarationtool.pas
View File

@ -1108,7 +1108,6 @@ type
FUnitName: string;
FFound: Boolean;
FResults: TStringList;
procedure Iterate(const AFilename: string);
public
constructor Create;

94
components/codetools/stdcodetools.pas
View File

@ -225,6 +225,8 @@ type
// published variables
function FindPublishedVariable(const AClassName, AVarName: string;
ExceptionOnClassNotFound: boolean): TCodeTreeNode;
function GatherPublishedVarTypes(const AClassName: string;
out VarNameToType: TStringToStringTree): boolean;
function AddPublishedVariable(const AClassName,VarName, VarType: string;
SourceChangeCache: TSourceChangeCache): boolean; virtual;
function RemovePublishedVariable(const AClassName, AVarName: string;
@ -374,6 +376,7 @@ type
SourceChangeCache: TSourceChangeCache;
const Filter: TOnIDEDirectiveFilter = nil): boolean;
// debugging
procedure CalcMemSize(Stats: TCTMemStats); override;
end;
@ -4550,6 +4553,97 @@ begin
end;
end;
function TStandardCodeTool.GatherPublishedVarTypes(const AClassName: string;
out VarNameToType: TStringToStringTree): boolean;
var
ClassNode, SectionNode, Node, VarNode, TypeNode: TCodeTreeNode;
SimpleTypes: TStringToStringTree;
VarName, NewType, VarType, CurUnitName: String;
Params: TFindDeclarationParams;
aContext: TFindContext;
begin
Result:=true;
VarNameToType:=nil;
// search class
if (AClassName='') or (length(AClassName)>255) then
RaiseExceptionFmt(20230411091809,ctsinvalidClassName, [AClassName]);
BuildTree(lsrImplementationStart);
ClassNode:=FindClassNodeInInterface(AClassName,true,false,false);
if ClassNode=nil then
RaiseExceptionFmt(20230411091811,ctsclassNotFound, [AClassName]);
// traverse class declaration
SimpleTypes:=TStringToStringTree.Create(false);
try
SectionNode:=ClassNode.FirstChild;
while (SectionNode<>nil) do begin
if SectionNode.Desc=ctnClassPublished then begin
Node:=SectionNode.FirstChild;
while Node<>nil do begin
VarNode:=Node;
Node:=Node.NextBrother;
if (VarNode.Desc<>ctnVarDefinition) then continue;
// published variable
TypeNode:=FindTypeNodeOfDefinition(VarNode);
if TypeNode=nil then continue;
if TypeNode.Desc<>ctnIdentifier then continue;
// read variable name
VarName:=GetIdentifier(@Src[VarNode.StartPos]);
//debugln(['TStandardCodeTool.GatherPublishedVarTypes VarName="',VarName,'"']);
// read variable type
MoveCursorToNodeStart(TypeNode);
ReadNextAtom;
if not AtomIsIdentifier then
continue;
VarType:=GetAtom;
while ReadNextAtomIs('.') do begin
ReadNextAtom;
if not AtomIsIdentifier then
break;
VarType:=VarType+'.'+GetAtom;
end;
//debugln(['TStandardCodeTool.GatherPublishedVarTypes VarType="',VarType,'"']);
if (CurPos.Flag<>cafSemicolon) then begin
//debugln(['TStandardCodeTool.GatherPublishedVarTypes WARNING not a simple type: ',VarName]);
continue; // e.g. specialize A<B>
end;
if (Pos('.',VarType)<1) then begin
// simple type without unitname
NewType:=SimpleTypes[VarType];
if NewType='' then
begin
// resolve simple type
Params:=TFindDeclarationParams.Create;
try
Params.ContextNode:=TypeNode;
// resolve alias
aContext:=FindBaseTypeOfNode(Params,TypeNode);
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Type "',VarType,'" found at ',FindContextToString(aContext,false)]);
if aContext.Node.Desc=ctnClass then
VarType:=aContext.Tool.ExtractClassName(aContext.Node,false);
CurUnitName:=aContext.Tool.GetSourceName(false);
// unitname.vartype
NewType:=CurUnitName+'.'+VarType;
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Resolved: "',VarType,'" = "',NewType,'"']);
SimpleTypes[VarType]:=NewType;
finally
Params.Free;
end;
end;
VarType:=NewType;
end;
//debugln(['TStandardCodeTool.GatherPublishedVarTypes Added ',VarName,':',VarType]);
if VarNameToType=nil then
VarNameToType:=TStringToStringTree.Create(false);
VarNameToType[VarName]:=VarType;
end;
end;
SectionNode:=SectionNode.NextBrother;
end;
finally
SimpleTypes.Free;
end;
end;
function TStandardCodeTool.AddPublishedVariable(const AClassName,
VarName, VarType: string; SourceChangeCache: TSourceChangeCache): boolean;
var ClassNode, SectionNode: TCodeTreeNode;

20
components/codetools/tests/moduletests/dsgn_ambigbearbtn.pas Normal file
View File

@ -0,0 +1,20 @@
unit Dsgn_AmbigBearBtn;
{$mode ObjFPC}{$H+}
interface
uses
Classes, SysUtils;
type
{ TBearButton }
TBearButton = class(TComponent)
end;
implementation
end.

7
components/codetools/tests/runtestscodetools.lpi
View File

@ -37,7 +37,7 @@
<PackageName Value="fpcunitconsolerunner"/>
</Item2>
</RequiredPackages>
<Units Count="20">
<Units Count="21">
<Unit0>
<Filename Value="runtestscodetools.lpr"/>
<IsPartOfProject Value="True"/>
@ -134,6 +134,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="Dsgn_BearButtons"/>
</Unit19>
<Unit20>
<Filename Value="moduletests/dsgn_ambigbearbtn.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Dsgn_AmbigBearBtn"/>
</Unit20>
</Units>
</ProjectOptions>
<CompilerOptions>

2
components/codetools/tests/runtestscodetools.lpr
View File

@ -40,7 +40,7 @@ uses
TestStdCodetools, TestFindDeclaration, TestIdentCompletion, TestCompleteBlock,
TestRefactoring, TestCodeCompletion, TestCompReaderWriterPas,
fdt_arrays, TestCTPas2js, TestChangeDeclaration, TestLFMTrees,
TestDesignerFormTools, Dsgn_BearButtons;
TestDesignerFormTools, Dsgn_BearButtons, Dsgn_AmbigBearBtn;
const
ConfigFilename = 'codetools.config';

215
components/codetools/tests/testdesignerformtools.pas
View File

@ -6,8 +6,9 @@ interface
uses
Classes, SysUtils, CodeToolManager, CodeCache, DefineTemplates,
LazLogger, LazFileUtils, fpcunit, testregistry,
TestFinddeclaration, TestStdCodetools, Dsgn_BearControls, Dsgn_BearButtons;
LazLogger, LazFileUtils, AvgLvlTree, Laz_AVL_Tree, fpcunit, testregistry,
TestFinddeclaration, TestStdCodetools,
Dsgn_AmbigBearBtn, Dsgn_BearControls, Dsgn_BearButtons;
type
TBearForm1 = class(TBearForm)
@ -17,8 +18,8 @@ type
TTestDesignerFormTools = class(TCustomTestCTStdCodetools)
private
procedure TestAddPublishedBearVars(Title: string; Src: array of string;
Expected: array of string);
procedure TestCompleteComponent(const Title: string; CheckUnits: boolean; const Src, Expected: array of string);
procedure TestGatherPublishedVarType(const Title, aClassName: string; const Src, ExpectedVars: array of string);
protected
procedure SetUp; override;
procedure TearDown; override;
@ -28,14 +29,20 @@ type
// add published variables
procedure TestAddPublishedVariables_Empty;
procedure TestAddPublishedVariables_Button1;
procedure TestAddPublishedVariables_AmbiguousButtons1;
procedure TestAddPublishedVariables_AmbiguousButtons2;
// gather published variable types
procedure TestGatherPublishedVarTypes_Empty;
procedure TestGatherPublishedVarTypes_Button1;
procedure TestGatherPublishedVarTypes_Button2;
end;
implementation
{ TTestDesignerFormTools }
procedure TTestDesignerFormTools.TestAddPublishedBearVars(Title: string;
Src: array of string; Expected: array of string);
procedure TTestDesignerFormTools.TestCompleteComponent(const Title: string;
CheckUnits: boolean; const Src, Expected: array of string);
var
i, NewX, NewY: Integer;
s, Dir: String;
@ -53,9 +60,7 @@ begin
try
CodeToolBoss.DefineTree.Add(DefTemp);
//debugln(['TTestFindDeclaration.TestFindDeclaration_UnitSearch_CurrentDir ',CodeToolBoss.GetUnitPathForDirectory('')]);
if not CodeToolBoss.AddPublishedVariables(Code,BearForm1,nil)
if not CodeToolBoss.CompleteComponent(Code,BearForm1,nil,CheckUnits)
and (CodeToolBoss.ErrorDbgMsg<>'') then
begin
NewCode:=Code;
@ -67,7 +72,7 @@ begin
NewCode:=CodeToolBoss.ErrorCode;
end;
WriteSource(NewCode.Filename,NewY,NewX);
Fail(Title+': call CompleteCode failed: "'+CodeToolBoss.ErrorDbgMsg+'"');
Fail(Title+': call CompleteComponent failed: "'+CodeToolBoss.ErrorDbgMsg+'"');
end;
s:='';
for i:=Low(Expected) to High(Expected) do
@ -78,6 +83,63 @@ begin
end;
end;
procedure TTestDesignerFormTools.TestGatherPublishedVarType(const Title,
aClassName: string; const Src, ExpectedVars: array of string);
var
Code, NewCode: TCodeBuffer;
VarNameToToType: TStringToStringTree;
Expected, Actual, Dir: String;
i, NewY, NewX: Integer;
DefTemp: TDefineTemplate;
begin
Code:=CodeToolBoss.CreateFile('test1.pas');
Actual:='';
for i:=Low(Src) to High(Src) do
Actual+=Src[i]+LineEnding;
Code.Source:=Actual;
Dir:=AppendPathDelim(GetCurrentDir)+'moduletests';
DefTemp:=TDefineTemplate.Create('unitpath','add moduletests',UnitPathMacroName,Dir,da_Define);
VarNameToToType:=nil;
try
CodeToolBoss.DefineTree.Add(DefTemp);
if not CodeToolBoss.GatherPublishedVarTypes(Code,aClassName,VarNameToToType)
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 GatherPublishedVarTypes failed: "'+CodeToolBoss.ErrorDbgMsg+'"');
end;
Actual:='';
if VarNameToToType<>nil then begin
Actual:=VarNameToToType.AsText;
Actual:=StringReplace(Actual,'=',':',[rfReplaceAll]);
end;
Expected:='';
for i:=Low(ExpectedVars) to High(ExpectedVars) do
Expected+=ExpectedVars[i]+LineEnding;
if Actual<>Expected then begin
debugln(['TTestDesignerFormTools.TestGatherPublishedVarType Expected:']);
debugln(Expected);
debugln(['TTestDesignerFormTools.TestGatherPublishedVarType Actual:']);
debugln(Actual);
Fail('VarNameToToType differ');
end;
finally
VarNameToToType.Free;
CodeToolBoss.DefineTree.RemoveDefineTemplate(DefTemp);
end;
end;
procedure TTestDesignerFormTools.SetUp;
begin
inherited SetUp;
@ -92,7 +154,7 @@ end;
procedure TTestDesignerFormTools.TestAddPublishedVariables_Empty;
begin
TestAddPublishedBearVars('TestAddPublishedVariables_Empty',
TestCompleteComponent('TestAddPublishedVariables_Empty',true,
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
@ -116,12 +178,12 @@ end;
procedure TTestDesignerFormTools.TestAddPublishedVariables_Button1;
var
Btn: TBearButton;
Btn: Dsgn_BearButtons.TBearButton;
begin
Btn:=TBearButton.Create(BearForm1);
Btn:=Dsgn_BearButtons.TBearButton.Create(BearForm1);
Btn.Name:='Button1';
TestAddPublishedBearVars('TestAddPublishedVariables_Empty',
TestCompleteComponent('TestAddPublishedVariables_Button1',true,
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
@ -144,6 +206,131 @@ begin
,'end.']);
end;
procedure TTestDesignerFormTools.TestAddPublishedVariables_AmbiguousButtons1;
var
Btn1: Dsgn_BearButtons.TBearButton;
begin
Btn1:=Dsgn_BearButtons.TBearButton.Create(BearForm1);
Btn1.Name:='Button1';
TestCompleteComponent('TestAddPublishedVariables_AmbiguousButtons1',true,
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
,'uses Dsgn_BearControls, Dsgn_BearButtons, Dsgn_AmbigBearBtn;'
,'type'
,' TBearForm1 = class(TBearForm)'
,' end;'
,'implementation'
,'end.'],
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
,'uses Dsgn_BearControls, Dsgn_BearButtons, Dsgn_AmbigBearBtn;'
,'type'
,' { TBearForm1 }'
,' TBearForm1 = class(TBearForm)'
,' Button1: Dsgn_BearButtons.TBearButton;'
,' end;'
,'implementation'
,'end.']);
end;
procedure TTestDesignerFormTools.TestAddPublishedVariables_AmbiguousButtons2;
var
Btn1: Dsgn_BearButtons.TBearButton;
Btn2: Dsgn_AmbigBearBtn.TBearButton;
Label1: TBearLabel;
begin
Btn1:=Dsgn_BearButtons.TBearButton.Create(BearForm1);
Btn1.Name:='Button1';
Btn2:=Dsgn_AmbigBearBtn.TBearButton.Create(BearForm1);
Btn2.Name:='Button2';
Label1:=TBearLabel.Create(BearForm1);
Label1.Name:='Label1';
TestCompleteComponent('TestAddPublishedVariables_AmbiguousButtons2',true,
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
,'uses Dsgn_BearControls, Dsgn_BearButtons, Dsgn_AmbigBearBtn;'
,'type'
,' TBearForm1 = class(TBearForm)'
,' end;'
,'implementation'
,'end.'],
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
,'uses Dsgn_BearControls, Dsgn_BearButtons, Dsgn_AmbigBearBtn;'
,'type'
,' { TBearForm1 }'
,' TBearForm1 = class(TBearForm)'
,' Button1: Dsgn_BearButtons.TBearButton;'
,' Button2: Dsgn_AmbigBearBtn.TBearButton;'
,' Label1: TBearLabel;'
,' end;'
,'implementation'
,'end.']);
end;
procedure TTestDesignerFormTools.TestGatherPublishedVarTypes_Empty;
begin
TestGatherPublishedVarType('TestGatherPublishedVarTypes_Empty',
'TBearForm1',
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
,'uses Dsgn_BearControls, Dsgn_BearButtons, Dsgn_AmbigBearBtn;'
,'type'
,' TBearForm1 = class(TBearForm)'
,' end;'
,'implementation'
,'end.'],
[]
);
end;
procedure TTestDesignerFormTools.TestGatherPublishedVarTypes_Button1;
begin
TestGatherPublishedVarType('TestGatherPublishedVarTypes_Empty',
'TBearForm1',
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
,'uses Dsgn_BearControls, Dsgn_BearButtons, Dsgn_AmbigBearBtn;'
,'type'
,' TBearForm1 = class(TBearForm)'
,' Button1: TBearButton;'
,' end;'
,'implementation'
,'end.'],
['Button1:Dsgn_AmbigBearBtn.TBearButton']
);
end;
procedure TTestDesignerFormTools.TestGatherPublishedVarTypes_Button2;
begin
TestGatherPublishedVarType('TestGatherPublishedVarTypes_Empty',
'TBearForm1',
['unit test1;'
,'{$mode objfpc}{$H+}'
,'interface'
,'uses Dsgn_BearControls, Dsgn_BearButtons, Dsgn_AmbigBearBtn;'
,'type'
,' TBearForm1 = class(TBearForm)'
,' Button1: TBearButton;'
,' Button2: Dsgn_BearButtons.TBearButton;'
,' Label1: TBearLabel;'
,' end;'
,'implementation'
,'end.'],
['Button1:Dsgn_AmbigBearBtn.TBearButton',
'Button2:Dsgn_BearButtons.TBearButton',
'Label1:Dsgn_BearControls.TBearLabel']
);
end;
initialization
RegisterTests([TTestDesignerFormTools]);

7
ide/main.pp
View File

@ -12388,7 +12388,7 @@ var
Ancestor: TComponent;
AnUnitInfo: TUnitInfo;
AnIDesigner: TIDesigner;
HasResources: Boolean;
HasResources, CheckUnits: Boolean;
FileItem: PStringToStringItem;
begin
GetDefaultProcessList.FreeStoppedProcesses;
@ -12403,8 +12403,9 @@ begin
SourceEditorManager.AddJumpPointClicked(Self);
// Add component definitions to form's source code
Ancestor:=GetAncestorLookupRoot(FComponentAddedUnit);
CodeToolBoss.AddPublishedVariables(FComponentAddedUnit.Source,
FComponentAddedDesigner.LookupRoot, Ancestor);
CheckUnits:=false;
CodeToolBoss.CompleteComponent(FComponentAddedUnit.Source,
FComponentAddedDesigner.LookupRoot, Ancestor, CheckUnits);
FComponentAddedDesigner:=nil;
end;