mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 14:29:36 +02:00
codetools: test reference foreign component
git-svn-id: trunk@56179 -
This commit is contained in:
parent
5f84987ee3
commit
a8df3d1f7d
@ -18,6 +18,7 @@ Working:
|
|||||||
- collection
|
- collection
|
||||||
- with ancestor
|
- with ancestor
|
||||||
- ancestor: change ComponentIndex -> call SetChildPos
|
- ancestor: change ComponentIndex -> call SetChildPos
|
||||||
|
- reference foreign root, reference foreign component
|
||||||
|
|
||||||
ToDo:
|
ToDo:
|
||||||
- enum: add unit, avoid nameclash with-do
|
- enum: add unit, avoid nameclash with-do
|
||||||
@ -25,13 +26,11 @@ ToDo:
|
|||||||
- method, avoid nameclash with-do
|
- method, avoid nameclash with-do
|
||||||
- reference not yet created child component -> delay property setter
|
- reference not yet created child component -> delay property setter
|
||||||
- inline component
|
- inline component
|
||||||
- reference foreign root
|
|
||||||
- reference foreign component
|
|
||||||
- TComponent.Left/Right
|
- TComponent.Left/Right
|
||||||
- DefineProperties
|
- DefineProperties
|
||||||
- tkInterface
|
- tkInterface
|
||||||
- optional: use SetParentComponent instead of Parent:=
|
- optional: use SetParentComponent instead of Parent:=
|
||||||
- report bug: WriteChildren restore FAncestorPos
|
- insert/update code and helper class into unit/program
|
||||||
}
|
}
|
||||||
unit TestCompReaderWriterPas;
|
unit TestCompReaderWriterPas;
|
||||||
|
|
||||||
@ -532,7 +531,7 @@ type
|
|||||||
procedure TearDown; override;
|
procedure TearDown; override;
|
||||||
function WriteDescendant(Component: TComponent; Ancestor: TComponent = nil): string;
|
function WriteDescendant(Component: TComponent; Ancestor: TComponent = nil): string;
|
||||||
procedure TestWriteDescendant(Msg: string; Component: TComponent;
|
procedure TestWriteDescendant(Msg: string; Component: TComponent;
|
||||||
Ancestor: TComponent; const Expected: array of string);
|
Ancestor: TComponent; const Expected: array of string; NeedAccessClass: boolean = false);
|
||||||
property Writer: TCompWriterPas read FWriter write FWriter;
|
property Writer: TCompWriterPas read FWriter write FWriter;
|
||||||
published
|
published
|
||||||
procedure TestBaseTypesSkipDefaultValue;
|
procedure TestBaseTypesSkipDefaultValue;
|
||||||
@ -548,6 +547,7 @@ type
|
|||||||
procedure TestAncestor;
|
procedure TestAncestor;
|
||||||
procedure TestAncestorChildPos;
|
procedure TestAncestorChildPos;
|
||||||
procedure TestChildComponent;
|
procedure TestChildComponent;
|
||||||
|
procedure TestForeignReference;
|
||||||
procedure TestCollection;
|
procedure TestCollection;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -990,8 +990,10 @@ var
|
|||||||
|
|
||||||
procedure WriteSetParent;
|
procedure WriteSetParent;
|
||||||
begin
|
begin
|
||||||
if HasAncestor then exit;
|
if HasAncestor then
|
||||||
|
exit; // descendants cannot change parent
|
||||||
if Parent=nil then exit;
|
if Parent=nil then exit;
|
||||||
|
if Instance.GetParentComponent=nil then exit;
|
||||||
WriteAssign('Parent',GetComponentPath(Parent));
|
WriteAssign('Parent',GetComponentPath(Parent));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1015,17 +1017,17 @@ begin
|
|||||||
WriteSetParent;
|
WriteSetParent;
|
||||||
end;
|
end;
|
||||||
WriteProperties(Instance);
|
WriteProperties(Instance);
|
||||||
|
if not (cwpoSetParentFirst in Options) then
|
||||||
|
WriteSetParent;
|
||||||
|
if not IgnoreChildren then
|
||||||
|
WriteChildren(Instance);
|
||||||
if Instance<>LookupRoot then
|
if Instance<>LookupRoot then
|
||||||
begin
|
begin
|
||||||
if not (cwpoSetParentFirst in Options) then
|
|
||||||
WriteSetParent;
|
|
||||||
Unindent;
|
Unindent;
|
||||||
WriteIndent;
|
WriteIndent;
|
||||||
Write('end;');
|
Write('end;');
|
||||||
WriteLn;
|
WriteLn;
|
||||||
end;
|
end;
|
||||||
if not IgnoreChildren then
|
|
||||||
WriteChildren(Instance);
|
|
||||||
if HasAncestor and (FCurrentPos<>FAncestorPos) then
|
if HasAncestor and (FCurrentPos<>FAncestorPos) then
|
||||||
begin
|
begin
|
||||||
WriteIndent;
|
WriteIndent;
|
||||||
@ -1905,7 +1907,8 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestCompReaderWriterPas.TestWriteDescendant(Msg: string;
|
procedure TTestCompReaderWriterPas.TestWriteDescendant(Msg: string;
|
||||||
Component: TComponent; Ancestor: TComponent; const Expected: array of string);
|
Component: TComponent; Ancestor: TComponent; const Expected: array of string;
|
||||||
|
NeedAccessClass: boolean);
|
||||||
var
|
var
|
||||||
Actual, ExpS, s: String;
|
Actual, ExpS, s: String;
|
||||||
begin
|
begin
|
||||||
@ -1915,6 +1918,7 @@ begin
|
|||||||
for s in Expected do
|
for s in Expected do
|
||||||
ExpS:=ExpS+s+LineEnding;
|
ExpS:=ExpS+s+LineEnding;
|
||||||
CheckDiff(Msg,ExpS,Actual);
|
CheckDiff(Msg,ExpS,Actual);
|
||||||
|
AssertEquals(Msg+' NeedAccessClass',NeedAccessClass,Writer.NeedAccessClass);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestCompReaderWriterPas.TestBaseTypesSkipDefaultValue;
|
procedure TTestCompReaderWriterPas.TestBaseTypesSkipDefaultValue;
|
||||||
@ -2410,7 +2414,7 @@ procedure TTestCompReaderWriterPas.TestAncestorChildPos;
|
|||||||
|
|
||||||
procedure InitAncestor(C: TSimpleControl);
|
procedure InitAncestor(C: TSimpleControl);
|
||||||
var
|
var
|
||||||
Button1, Button2: TSimpleControl;
|
Button1, Panel2, Button21, Button22: TSimpleControl;
|
||||||
begin
|
begin
|
||||||
C.Tag:=1;
|
C.Tag:=1;
|
||||||
Button1:=TSimpleControl.Create(C);
|
Button1:=TSimpleControl.Create(C);
|
||||||
@ -2419,11 +2423,23 @@ procedure TTestCompReaderWriterPas.TestAncestorChildPos;
|
|||||||
Tag:=11;
|
Tag:=11;
|
||||||
Parent:=C;
|
Parent:=C;
|
||||||
end;
|
end;
|
||||||
Button2:=TSimpleControl.Create(C);
|
Panel2:=TSimpleControl.Create(C);
|
||||||
with Button2 do begin
|
with Panel2 do begin
|
||||||
Name:='Button2';
|
Name:='Panel2';
|
||||||
Tag:=12;
|
Tag:=12;
|
||||||
Parent:=C;
|
Parent:=C;
|
||||||
|
Button21:=TSimpleControl.Create(C);
|
||||||
|
with Button21 do begin
|
||||||
|
Name:='Button21';
|
||||||
|
Tag:=121;
|
||||||
|
Parent:=Panel2;
|
||||||
|
end;
|
||||||
|
Button22:=TSimpleControl.Create(C);
|
||||||
|
with Button22 do begin
|
||||||
|
Name:='Button22';
|
||||||
|
Tag:=122;
|
||||||
|
Parent:=Panel2;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -2442,15 +2458,25 @@ begin
|
|||||||
Name:='Descendant';
|
Name:='Descendant';
|
||||||
end;
|
end;
|
||||||
InitAncestor(aRoot);
|
InitAncestor(aRoot);
|
||||||
|
|
||||||
|
// switch Button21 and Button22
|
||||||
|
aRoot.Controls[1].FChildren.Move(0,1);
|
||||||
|
|
||||||
|
// switch Button1 and Panel2
|
||||||
aRoot.FChildren.Move(0,1);
|
aRoot.FChildren.Move(0,1);
|
||||||
|
|
||||||
TestWriteDescendant('TestAncestorChildPos',aRoot,Ancestor,[
|
TestWriteDescendant('TestAncestorChildPos',aRoot,Ancestor,[
|
||||||
'with Button2 do begin',
|
'with Panel2 do begin',
|
||||||
|
' with Button22 do begin',
|
||||||
|
' end;',
|
||||||
|
' TPasStreamAccess(Panel2).SetChildOrder(Button22,0);',
|
||||||
|
' with Button21 do begin',
|
||||||
|
' end;',
|
||||||
'end;',
|
'end;',
|
||||||
'SetChildOrder(Button2,0);',
|
'SetChildOrder(Panel2,0);',
|
||||||
'with Button1 do begin',
|
'with Button1 do begin',
|
||||||
'end;',
|
'end;',
|
||||||
'']);
|
''],true);
|
||||||
finally
|
finally
|
||||||
aRoot.Free;
|
aRoot.Free;
|
||||||
Ancestor.Free;
|
Ancestor.Free;
|
||||||
@ -2459,7 +2485,7 @@ end;
|
|||||||
|
|
||||||
procedure TTestCompReaderWriterPas.TestChildComponent;
|
procedure TTestCompReaderWriterPas.TestChildComponent;
|
||||||
var
|
var
|
||||||
aRoot, Button1: TSimpleControl;
|
aRoot, Button1, Panel1: TSimpleControl;
|
||||||
begin
|
begin
|
||||||
aRoot:=TSimpleControl.Create(nil);
|
aRoot:=TSimpleControl.Create(nil);
|
||||||
try
|
try
|
||||||
@ -2467,24 +2493,85 @@ begin
|
|||||||
Name:=CreateRootName(aRoot);
|
Name:=CreateRootName(aRoot);
|
||||||
Tag:=1;
|
Tag:=1;
|
||||||
end;
|
end;
|
||||||
Button1:=TSimpleControl.Create(aRoot);
|
Panel1:=TSimpleControl.Create(aRoot);
|
||||||
with Button1 do begin
|
with Panel1 do begin
|
||||||
Name:='Button1';
|
Name:='Panel1';
|
||||||
Tag:=2;
|
Tag:=2;
|
||||||
Parent:=aRoot;
|
Parent:=aRoot;
|
||||||
|
Button1:=TSimpleControl.Create(aRoot);
|
||||||
|
with Button1 do begin
|
||||||
|
Name:='Button1';
|
||||||
|
Tag:=3;
|
||||||
|
Parent:=Panel1;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TestWriteDescendant('TestChildComponent',aRoot,nil,[
|
TestWriteDescendant('TestChildComponent',aRoot,nil,[
|
||||||
'Tag:=1;',
|
'Tag:=1;',
|
||||||
|
'Panel1:=TSimpleControl.Create(Self);',
|
||||||
|
'with Panel1 do begin',
|
||||||
|
' Name:=''Panel1'';',
|
||||||
|
' Tag:=2;',
|
||||||
|
' Parent:=Self;',
|
||||||
|
' Button1:=TSimpleControl.Create(Self);',
|
||||||
|
' with Button1 do begin',
|
||||||
|
' Name:=''Button1'';',
|
||||||
|
' Tag:=3;',
|
||||||
|
' Parent:=Panel1;',
|
||||||
|
' end;',
|
||||||
|
'end;',
|
||||||
|
'']);
|
||||||
|
finally
|
||||||
|
aRoot.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestCompReaderWriterPas.TestForeignReference;
|
||||||
|
var
|
||||||
|
aRoot, Button1, aRoot2, Button2: TSimpleControl;
|
||||||
|
begin
|
||||||
|
aRoot:=TSimpleControl.Create(nil);
|
||||||
|
aRoot2:=TSimpleControl.Create(nil);
|
||||||
|
try
|
||||||
|
with aRoot do begin
|
||||||
|
Name:=CreateRootName(aRoot);
|
||||||
|
Tag:=11;
|
||||||
|
end;
|
||||||
|
Button1:=TSimpleControl.Create(aRoot);
|
||||||
|
with Button1 do begin
|
||||||
|
Name:='Button1';
|
||||||
|
Tag:=12;
|
||||||
|
Parent:=aRoot;
|
||||||
|
end;
|
||||||
|
|
||||||
|
with aRoot2 do begin
|
||||||
|
Name:='OtherRoot';
|
||||||
|
Tag:=21;
|
||||||
|
end;
|
||||||
|
Button2:=TSimpleControl.Create(aRoot2);
|
||||||
|
with Button2 do begin
|
||||||
|
Name:='Button2';
|
||||||
|
Tag:=22;
|
||||||
|
Parent:=aRoot2;
|
||||||
|
end;
|
||||||
|
|
||||||
|
aRoot.Next:=aRoot2;
|
||||||
|
Button1.Next:=Button2;
|
||||||
|
|
||||||
|
TestWriteDescendant('TestForeignReference',aRoot,nil,[
|
||||||
|
'Tag:=11;',
|
||||||
|
'Next:=OtherRoot;',
|
||||||
'Button1:=TSimpleControl.Create(Self);',
|
'Button1:=TSimpleControl.Create(Self);',
|
||||||
'with Button1 do begin',
|
'with Button1 do begin',
|
||||||
' Name:=''Button1'';',
|
' Name:=''Button1'';',
|
||||||
' Tag:=2;',
|
' Tag:=12;',
|
||||||
|
' Next:=OtherRoot.Button2;',
|
||||||
' Parent:=Self;',
|
' Parent:=Self;',
|
||||||
'end;',
|
'end;',
|
||||||
'']);
|
'']);
|
||||||
finally
|
finally
|
||||||
aRoot.Free;
|
aRoot.Free;
|
||||||
|
aRoot2.Free;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user