paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 12:16:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: test writing collection

Browse Source 
git-svn-id: trunk@56176 -
This commit is contained in:
mattias 2017-10-23 18:30:56 +00:00
parent a9cf1443c7
commit 49c15efbde
3 changed files with 139 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1005,6 +1005,7 @@ components/codetools/tests/laztests/tunitdots.main.pas svneol=native#text/plain
components/codetools/tests/laztests/unit_order_a.pas svneol=native#text/plain
components/codetools/tests/laztests/unit_order_b.pas svneol=native#text/plain
components/codetools/tests/laztests/unitdots.dot.pas svneol=native#text/plain
components/codetools/tests/laztests/unitdots.nsa.nsaa.nsaaa.pas svneol=native#text/plain
components/codetools/tests/laztests/unitdots.pas svneol=native#text/plain
components/codetools/tests/moduletests/fdt_arrays.pas svneol=native#text/plain
components/codetools/tests/moduletests/fdt_basic.pas svneol=native#text/plain

12
components/codetools/tests/laztests/unitdots.nsa.nsaa.nsaaa.pas Normal file
View File

@ -0,0 +1,12 @@
unit unitdots.nsA.nsAA.nsAAA;
{$mode objfpc}{$H+}
interface
var AAA: integer;
implementation
end.

136
components/codetools/tests/testcompreaderwriterpas.pas
View File

@ -90,6 +90,7 @@ type
procedure WriteChildren(Component: TComponent);
procedure WriteProperty(Instance: TPersistent; PropInfo: PPropInfo);
procedure WriteProperties(Instance: TPersistent);
procedure WriteCollection(PropName: string; Collection: TCollection);
function GetComponentPath(Component: TComponent): string;
function GetBoolLiteral(b: boolean): string;
function GetStringLiteral(const s: string): string;
@ -387,7 +388,7 @@ type
FSize: longint;
FSub: TPersistentSimple;
published
property Size: longint read FSize write FSize;
property Size: longint read FSize write FSize default 0;
property Sub: TPersistentSimple read FSub write FSub;
end;
@ -405,11 +406,11 @@ type
FSub: TPersistentSimple;
FSub2: TPersistentSimple;
published
property Before: longint read FBefore write FBefore;
property Before: longint read FBefore write FBefore default 0;
property Sub: TPersistentSimple read FSub write FSub;
property Middle: longint read FMiddle write FMiddle;
property Middle: longint read FMiddle write FMiddle default 0;
property Sub2: TPersistentSimple read FSub2 write FSub2;
property After: longint read FAfter write FAfter;
property After: longint read FAfter write FAfter default 0;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
end;
@ -438,6 +439,39 @@ type
property OnClick: TNotifyEvent read FOnClick write FOnClick;
end;
{ TSimpleCollectionItem }
TSimpleCollectionItem = class(TCollectionItem)
private
FBefore: longint;
FOnClick: TNotifyEvent;
FSub: TPersistentSimple;
published
property Before: longint read FBefore write FBefore default 0;
property Sub: TPersistentSimple read FSub write FSub;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
end;
TSimpleCollection = class(TCollection)
private
function GetThings(Index: integer): TSimpleCollectionItem;
public
property Things[Index: integer]: TSimpleCollectionItem read GetThings; default;
end;
{ TSimpleControlWithCollection }
TSimpleControlWithCollection = class(TSimpleControl)
private
FItems: TSimpleCollection;
procedure SetItems(const AValue: TSimpleCollection);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Items: TSimpleCollection read FItems write SetItems;
end;
{ TTestCompReaderWriterPas }
TTestCompReaderWriterPas = class(TCustomTestCTStdCodetools)
@ -463,6 +497,7 @@ type
procedure TestVariant;
procedure TestPropPersistent;
procedure TestChildComponent;
procedure TestCollection;
end;
implementation
@ -550,6 +585,34 @@ Type
constructor Create(APos: Integer; AComponent: TComponent);
end;
{ TSimpleCollection }
function TSimpleCollection.GetThings(Index: integer): TSimpleCollectionItem;
begin
Result:=TSimpleCollectionItem(Items[Index]);
end;
{ TSimpleControlWithCollection }
procedure TSimpleControlWithCollection.SetItems(const AValue: TSimpleCollection
);
begin
if FItems=AValue then Exit;
FItems.Assign(AValue);
end;
constructor TSimpleControlWithCollection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FItems:=TSimpleCollection.Create(TSimpleCollectionItem);
end;
destructor TSimpleControlWithCollection.Destroy;
begin
FreeAndNil(FItems);
inherited Destroy;
end;
{ TSimpleControl }
procedure TSimpleControl.OnA(Sender: TObject);
@ -1247,15 +1310,10 @@ begin
TCollection(GetObjectProp(Ancestor, PropInfo)),Root,RootAncestor)) then
begin
// create collection items
{$IFDEF VerboseCompWriterPas}
debugln(['TCompWriterPas.WriteProperty Property="',PropName,'" Kind=',PropType^.Kind,' ObjValue=',DbgSName(ObjValue)]);
raise EWriteError.Create('storing collection not yet supported');
{$ENDIF}
//Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
SavedPropPath := FPropPath;
try
SetLength(FPropPath, 0);
//WriteCollection(TCollection(ObjValue));
WriteCollection(PropName,TCollection(ObjValue));
finally
FPropPath := SavedPropPath;
end;
@ -1314,6 +1372,27 @@ begin
// ToDo: Instance.DefineProperties(Self);
end;
procedure TCompWriterPas.WriteCollection(PropName: string;
Collection: TCollection);
var
i: Integer;
Item: TCollectionItem;
begin
for i:=0 to Collection.Count-1 do
begin
Item:=Collection.Items[i];
WriteIndent;
Write('with '+Item.ClassName+'('+PropName+'.Add) do begin');
WriteLn;
Indent;
WriteProperties(Item);
Unindent;
WriteIndent;
Write('end;');
WriteLn;
end;
end;
function TCompWriterPas.GetComponentPath(Component: TComponent): string;
begin
if Component=LookupRoot then
@ -2122,6 +2201,43 @@ begin
end;
end;
procedure TTestCompReaderWriterPas.TestCollection;
var
aRoot: TSimpleControlWithCollection;
begin
aRoot:=TSimpleControlWithCollection.Create(nil);
try
with aRoot do begin
Name:=CreateRootName(aRoot);
Tag:=1;
with TSimpleCollectionItem(Items.Add) do begin
OnClick:=@OnA;
Sub:=TPersistentSimple.Create;
Sub.Size:=11;
end;
with TSimpleCollectionItem(Items.Add) do begin
Sub:=TPersistentSimple.Create;
Sub.Size:=12;
end;
end;
TestWriteDescendant('TestCollection',aRoot,nil,[
'Tag:=1;',
'with TSimpleCollectionItem(Items.Add) do begin',
' Sub.Size:=11;',
' OnClick:=@OnA;',
'end;',
'with TSimpleCollectionItem(Items.Add) do begin',
' Sub.Size:=12;',
'end;',
'']);
finally
FreeAndNil(aRoot.Items[0].FSub);
FreeAndNil(aRoot.Items[1].FSub);
aRoot.Free;
end;
end;
initialization
RegisterTest(TTestCompReaderWriterPas);
end.