paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-22 10:09:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: test write custom properties

Browse Source 
git-svn-id: trunk@56211 -
This commit is contained in:
mattias 2017-10-26 17:29:39 +00:00
parent 6548ec54ea
commit 7ac2fd7bf4
1 changed files with 65 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,7 +4,6 @@
./runtests --format=plain --suite=TTestCompReaderWriterPas.TestBaseTypesMaxValues ./runtests --format=plain --suite=TTestCompReaderWriterPas.TestBaseTypesMaxValues
ToDo: ToDo:
- RegisterPascalProperties(aClass,@);
- enum: add unit, avoid nameclash with-do - enum: add unit, avoid nameclash with-do
- custom integer TColor, add unit, avoid nameclash with-do - custom integer TColor, add unit, avoid nameclash with-do
- method, avoid nameclash with-do - method, avoid nameclash with-do
@ -440,9 +439,11 @@ type
FStream: TMemoryStream; FStream: TMemoryStream;
FWriter: TCompWriterPas; FWriter: TCompWriterPas;
FAncestors: TPointerToPointerTree; FAncestors: TPointerToPointerTree;
procedure OnWriterFindAncestor(Sender: TObject; Component: TComponent; procedure OnDefinePropertiesTStrings(Writer: TCompWriterPas;
Instance: TPersistent; const Identifier: string; var Handled: boolean);
procedure OnWriterFindAncestor(Sender: TCompWriterPas; Component: TComponent;
const Name: string; var Ancestor, RootAncestor: TComponent); const Name: string; var Ancestor, RootAncestor: TComponent);
procedure OnWriterGetParentProperty(Sender: TObject; Component: TComponent; procedure OnWriterGetParentProperty(Sender: TCompWriterPas; Component: TComponent;
var PropName: string); var PropName: string);
protected protected
procedure SetUp; override; procedure SetUp; override;
@ -477,9 +478,8 @@ type
procedure TestInlineDescendant; // e.g. a Form with a Frame, Frame is inherited from another Frame procedure TestInlineDescendant; // e.g. a Form with a Frame, Frame is inherited from another Frame
procedure TestDesignInfo; procedure TestDesignInfo;
procedure TestDefineProperites_ListOfStrings; // ToDo procedure TestDefineProperties_ListOfStrings;
// ToDo: WriteUnicodeString, WriteWideString, WriteInteger, Write procedure Test_TStrings;
// ToDo: DefineBinaryProperty
procedure TestFindComponentInit; // ToDo procedure TestFindComponentInit; // ToDo
end; end;
@ -849,7 +849,7 @@ end;
{ TTestCompReaderWriterPas } { TTestCompReaderWriterPas }
procedure TTestCompReaderWriterPas.OnWriterFindAncestor(Sender: TObject; procedure TTestCompReaderWriterPas.OnWriterFindAncestor(Sender: TCompWriterPas;
Component: TComponent; const Name: string; var Ancestor, Component: TComponent; const Name: string; var Ancestor,
RootAncestor: TComponent); RootAncestor: TComponent);
var var
@ -863,8 +863,37 @@ begin
RootAncestor:=C; RootAncestor:=C;
end; end;
procedure TTestCompReaderWriterPas.OnWriterGetParentProperty(Sender: TObject; procedure TTestCompReaderWriterPas.OnDefinePropertiesTStrings(
Component: TComponent; var PropName: string); Writer: TCompWriterPas; Instance: TPersistent; const Identifier: string;
var Handled: boolean);
var
List: TStrings;
HasData: Boolean;
i: Integer;
begin
if not (Instance is TStrings) then exit;
List:=TStrings(Instance);
if Assigned(Writer.Ancestor) then
// Only serialize if string list is different from ancestor
if Writer.Ancestor.InheritsFrom(TStrings) then
HasData := not Equals(TStrings(Writer.Ancestor))
else
HasData := True
else
HasData := List.Count > 0;
if not HasData then exit;
Writer.WriteStatement('with '+Identifier+' do begin');
Writer.Indent;
Writer.WriteStatement('Clear;');
for i:=0 to List.Count-1 do
Writer.WriteStatement('Add('+Writer.GetStringLiteral(List[i])+');');
Writer.Unindent;
Writer.WriteStatement('end;');
Handled:=true;
end;
procedure TTestCompReaderWriterPas.OnWriterGetParentProperty(
Sender: TCompWriterPas; Component: TComponent; var PropName: string);
begin begin
if Component is TSimpleControl then if Component is TSimpleControl then
PropName:='Parent'; PropName:='Parent';
@ -1960,7 +1989,7 @@ begin
end; end;
end; end;
procedure TTestCompReaderWriterPas.TestDefineProperites_ListOfStrings; procedure TTestCompReaderWriterPas.TestDefineProperties_ListOfStrings;
var var
ARoot: TSimpleControlWithStrings; ARoot: TSimpleControlWithStrings;
Expected: String; Expected: String;
@ -1990,6 +2019,32 @@ begin
end; end;
end; end;
procedure TTestCompReaderWriterPas.Test_TStrings;
var
ARoot: TSimpleControlWithStrings;
begin
ARoot:=TSimpleControlWithStrings.Create(nil);
try
with ARoot do begin
Name:=CreateRootName(ARoot);
Lines:=TStringList.Create;
Lines.Text:='First'+LineEnding+'Second';
end;
Writer.OnDefineProperties:=@OnDefinePropertiesTStrings;
TestWriteDescendant('Test_TStrings',ARoot,nil,[
'with Lines do begin',
' Clear;',
' Add(''First'');',
' Add(''Second'');',
'end;',
'']);
finally
FreeAndNil(ARoot.FLines);
ARoot.Free;
end;
end;
procedure TTestCompReaderWriterPas.TestFindComponentInit; procedure TTestCompReaderWriterPas.TestFindComponentInit;
var var
Code: TCodeBuffer; Code: TCodeBuffer;