{ Test with: ./runtests --format=plain --suite=TTestCompReaderWriterPas ./runtests --format=plain --suite=TTestCompReaderWriterPas.TestBaseTypesMaxValues ToDo: - enum: add unit - enum: avoid nameclash with-do - custom integer TColor: add unit - custom integer: avoid nameclash with-do - method: avoid nameclash with-do - insert/update code and helper class into unit/program - find call init proc - find old init code - error if init proc is behind call - add call in existing constructor - add constructor with call - add new init code - replace init code - add missing units } unit TestCompReaderWriterPas; {$mode objfpc}{$H+} {off $DEFINE VerboseCompWriterPas} interface uses Classes, SysUtils, typinfo, LazLoggerBase, LazUTF8, LazLogger, CompWriterPas, LazPasReadUtil, fpcunit, testregistry, CodeToolManager, LinkScanner, CodeToolsStructs, TestStdCodetools, variants; // Tests ======================================================================= const MinSafeIntCurrency = Low(Int64) div 10000; MaxSafeIntCurrency = High(Int64) div 10000; MinSafeIntSingle = -16777216; MaxSafeIntSingle = 16777216; MaskUIntSingle = $3fffff; MinSafeIntDouble = -$10000000000000; MaxSafeIntDouble = $fffffffffffff; MaskUIntDouble = $fffffffffffff; type TEnum = (red, green, blue, white, black); TEnumRg = green..white; TSetOfEnum = set of TEnum; TSetOfEnumRg = set of TEnumRg; TSetOfBool = set of boolean; TMyInt = 1..7; TSetOfMyInt = set of TMyInt; TMyChar = #3..#10; TSetOfMyChar = set of TMyChar; { TCompBaseTypes } TCompBaseTypes = class(TComponent) private FABoolean: Boolean; FAByte: Byte; FAByteBool: ByteBool; FAChar: Char; FACurrency: Currency; FADouble: Double; FAExtended: Extended; FAInt64: Int64; FALongBool: LongBool; FALongInt: LongInt; FALongWord: LongWord; FAQWord: QWord; FAShortInt: ShortInt; FAShortString: ShortString; FASingle: Single; FASmallInt: SmallInt; FAString: String; FAUnicodeString: UnicodeString; FAWideChar: WideChar; FAWideString: WideString; FAWord: Word; FAWordBool: WordBool; FEnum: TEnum; FEnumRg: TEnumRg; FMyChar: TMyChar; FMyInt: TMyInt; FSetOfBool: TSetOfBool; FSetOfEnum: TSetOfEnum; FSetOfEnumRg: TSetOfEnumRg; FSetOfMyChar: TSetOfMyChar; FSetOfMyInt: TSetOfMyInt; function isACurrencyStored: Boolean; function isADoubleStored: Boolean; function isAExtendedStored: Boolean; function isAShortStringStored: Boolean; function isASingleStored: Boolean; function isAStringStored: Boolean; function isAUnicodeStringStored: Boolean; function isAWideStringStored: Boolean; published constructor Create(AOwner: TComponent); override; property ABoolean: Boolean read FABoolean write FABoolean default false; property AByteBool: ByteBool read FAByteBool write FAByteBool default false; property AWordBool: WordBool read FAWordBool write FAWordBool default false; property ALongBool: LongBool read FALongBool write FALongBool default false; property AByte: Byte read FAByte write FAByte default 0; property AShortInt: ShortInt read FAShortInt write FAShortInt default 0; property AWord: Word read FAWord write FAWord default 0; property ASmallInt: SmallInt read FASmallInt write FASmallInt default 0; property ALongWord: LongWord read FALongWord write FALongWord default 0; property ALongInt: LongInt read FALongInt write FALongInt default 0; property AQWord: QWord read FAQWord write FAQWord default 0; property AInt64: Int64 read FAInt64 write FAInt64 default 0; property ACurrency: Currency read FACurrency write FACurrency stored isACurrencyStored; property ASingle: Single read FASingle write FASingle stored isASingleStored; property ADouble: Double read FADouble write FADouble stored isADoubleStored; property AExtended: Extended read FAExtended write FAExtended stored isAExtendedStored; property AChar: Char read FAChar write FAChar default #0; property AWideChar: WideChar read FAWideChar write FAWideChar default #0; property AString: String read FAString write FAString stored isAStringStored; property AShortString: ShortString read FAShortString write FAShortString stored isAShortStringStored; property AWideString: WideString read FAWideString write FAWideString stored isAWideStringStored; property AUnicodeString: UnicodeString read FAUnicodeString write FAUnicodeString stored isAUnicodeStringStored; property Enum: TEnum read FEnum write FEnum default low(TEnum); property EnumRg: TEnumRg read FEnumRg write FEnumRg default low(TEnumRg); property SetOfEnum: TSetOfEnum read FSetOfEnum write FSetOfEnum default []; property SetOfEnumRg: TSetOfEnumRg read FSetOfEnumRg write FSetOfEnumRg default []; property SetOfBool: TSetOfBool read FSetOfBool write FSetOfBool default []; property MyInt: TMyInt read FMyInt write FMyInt default low(TMyInt); property SetOfMyInt: TSetOfMyInt read FSetOfMyInt write FSetOfMyInt default []; property MyChar: TMyChar read FMyChar write FMyChar default low(TMyChar); property SetOfMyChar: TSetOfMyChar read FSetOfMyChar write FSetOfMyChar default []; end; { TCompBaseTypesCustomStored } TCompBaseTypesCustomStored = class(TComponent) procedure OnClick(Sender: TObject); private FABoolean: Boolean; FAByte: Byte; FAByteBool: ByteBool; FAChar: Char; FACurrency: Currency; FADouble: Double; FAExtended: Extended; FAInt64: Int64; FALongBool: LongBool; FALongInt: LongInt; FALongWord: LongWord; FAQWord: QWord; FAShortInt: ShortInt; FAShortString: ShortString; FASingle: Single; FASmallInt: SmallInt; FAString: String; FAUnicodeString: UnicodeString; FAWideChar: WideChar; FAWideString: WideString; FAWord: Word; FAWordBool: WordBool; FEnum: TEnum; FEnumRg: TEnumRg; FEvent: TNotifyEvent; FMyChar: TMyChar; FMyInt: TMyInt; FSetOfBool: TSetOfBool; FSetOfEnum: TSetOfEnum; FSetOfEnumRg: TSetOfEnumRg; FSetOfMyChar: TSetOfMyChar; FSetOfMyInt: TSetOfMyInt; function ABooleanIsStored: Boolean; function AByteBoolIsStored: Boolean; function AByteIsStored: Boolean; function ACharIsStored: Boolean; function ACurrencyIsStored: Boolean; function ADoubleIsStored: Boolean; function AExtendedIsStored: Boolean; function AInt64IsStored: Boolean; function ALongBoolIsStored: Boolean; function ALongIntIsStored: Boolean; function ALongWordIsStored: Boolean; function AQWordIsStored: Boolean; function AShortIntIsStored: Boolean; function AShortStringIsStored: Boolean; function ASingleIsStored: Boolean; function ASmallIntIsStored: Boolean; function AStringIsStored: Boolean; function AUnicodeStringIsStored: Boolean; function AWideCharIsStored: Boolean; function AWideStringIsStored: Boolean; function AWordBoolIsStored: Boolean; function AWordIsStored: Boolean; function EnumIsStored: Boolean; function EnumRgIsStored: Boolean; function EventIsStored: Boolean; function MyCharIsStored: Boolean; function MyIntIsStored: Boolean; function SetOfBoolIsStored: Boolean; function SetOfEnumIsStored: Boolean; function SetOfEnumRgIsStored: Boolean; function SetOfMyCharIsStored: Boolean; function SetOfMyIntIsStored: Boolean; public DefABoolean: Boolean; DefAByteBool: ByteBool; DefAWordBool: WordBool; DefALongBool: LongBool; DefAByte: Byte; DefAShortInt: ShortInt; DefAWord: Word; DefASmallInt: SmallInt; DefALongWord: LongWord; DefALongInt: LongInt; DefAQWord: QWord; DefAInt64: Int64; DefACurrency: Currency; DefASingle: Single; DefADouble: Double; DefAExtended: Extended; DefAChar: Char; DefAWideChar: WideChar; DefAString: String; DefAShortString: ShortString; DefAWideString: WideString; DefAUnicodeString: UnicodeString; DefEnum: TEnum; DefEnumRg: TEnumRg; DefSetOfEnum: TSetOfEnum; DefSetOfEnumRg: TSetOfEnumRg; DefSetOfBool: TSetOfBool; DefMyInt: TMyInt; DefSetOfMyInt: TSetOfMyInt; DefMyChar: TMyChar; DefSetOfMyChar: TSetOfMyChar; DefEvent: TNotifyEvent; constructor Create(AOwner: TComponent); override; published property ABoolean: Boolean read FABoolean write FABoolean stored ABooleanIsStored; property AByteBool: ByteBool read FAByteBool write FAByteBool stored AByteBoolIsStored; property AWordBool: WordBool read FAWordBool write FAWordBool stored AWordBoolIsStored; property ALongBool: LongBool read FALongBool write FALongBool stored ALongBoolIsStored; property AByte: Byte read FAByte write FAByte stored AByteIsStored; property AShortInt: ShortInt read FAShortInt write FAShortInt stored AShortIntIsStored; property AWord: Word read FAWord write FAWord stored AWordIsStored; property ASmallInt: SmallInt read FASmallInt write FASmallInt stored ASmallIntIsStored; property ALongWord: LongWord read FALongWord write FALongWord stored ALongWordIsStored; property ALongInt: LongInt read FALongInt write FALongInt stored ALongIntIsStored; property AQWord: QWord read FAQWord write FAQWord stored AQWordIsStored; property AInt64: Int64 read FAInt64 write FAInt64 stored AInt64IsStored; property ACurrency: Currency read FACurrency write FACurrency stored ACurrencyIsStored; property ASingle: Single read FASingle write FASingle stored ASingleIsStored nodefault; property ADouble: Double read FADouble write FADouble stored ADoubleIsStored nodefault; property AExtended: Extended read FAExtended write FAExtended stored AExtendedIsStored; property AChar: Char read FAChar write FAChar stored ACharIsStored; property AWideChar: WideChar read FAWideChar write FAWideChar stored AWideCharIsStored; property AString: String read FAString write FAString stored AStringIsStored; property AShortString: ShortString read FAShortString write FAShortString stored AShortStringIsStored; property AWideString: WideString read FAWideString write FAWideString stored AWideStringIsStored; property AUnicodeString: UnicodeString read FAUnicodeString write FAUnicodeString stored AUnicodeStringIsStored; property Enum: TEnum read FEnum write FEnum stored EnumIsStored; property EnumRg: TEnumRg read FEnumRg write FEnumRg stored EnumRgIsStored; property SetOfEnum: TSetOfEnum read FSetOfEnum write FSetOfEnum stored SetOfEnumIsStored; property SetOfEnumRg: TSetOfEnumRg read FSetOfEnumRg write FSetOfEnumRg stored SetOfEnumRgIsStored; property SetOfBool: TSetOfBool read FSetOfBool write FSetOfBool stored SetOfBoolIsStored; property MyInt: TMyInt read FMyInt write FMyInt stored MyIntIsStored; property SetOfMyInt: TSetOfMyInt read FSetOfMyInt write FSetOfMyInt stored SetOfMyIntIsStored; property MyChar: TMyChar read FMyChar write FMyChar stored MyCharIsStored; property SetOfMyChar: TSetOfMyChar read FSetOfMyChar write FSetOfMyChar stored SetOfMyCharIsStored; property Event: TNotifyEvent read FEvent write FEvent stored EventIsStored; end; { TCompVariants } TCompVariants = class(TComponent) private FV1: variant; FV10: variant; FV11: variant; FV12: variant; FV13: variant; FV14: variant; FV15: variant; FV16: variant; FV17: variant; FV18: variant; FV19: variant; FV2: variant; FV20: variant; FV3: variant; FV4: variant; FV5: variant; FV6: variant; FV7: variant; FV8: variant; FV9: variant; published property V1: variant read FV1 write FV1; property V2: variant read FV2 write FV2; property V3: variant read FV3 write FV3; property V4: variant read FV4 write FV4; property V5: variant read FV5 write FV5; property V6: variant read FV6 write FV6; property V7: variant read FV7 write FV7; property V8: variant read FV8 write FV8; property V9: variant read FV9 write FV9; property V10: variant read FV10 write FV10; property V11: variant read FV11 write FV11; property V12: variant read FV12 write FV12; property V13: variant read FV13 write FV13; property V14: variant read FV14 write FV14; property V15: variant read FV15 write FV15; property V16: variant read FV16 write FV16; property V17: variant read FV17 write FV17; property V18: variant read FV18 write FV18; property V19: variant read FV19 write FV19; property V20: variant read FV20 write FV20; end; { TPersistentSimple } TPersistentSimple = class(TPersistent) private FSize: longint; FSub: TPersistentSimple; published property Size: longint read FSize write FSize default 0; property Sub: TPersistentSimple read FSub write FSub; end; { TCompPropPersistent } TCompPropPersistent = class(TComponent) procedure OnA(Sender: TObject); procedure OnB(Sender: TObject); procedure OnC(Sender: TObject); private FAfter: longint; FBefore: longint; FMiddle: longint; FOnClick: TNotifyEvent; FSub: TPersistentSimple; FSub2: TPersistentSimple; published property Before: longint read FBefore write FBefore default 0; property Sub: TPersistentSimple read FSub write FSub; property Middle: longint read FMiddle write FMiddle default 0; property Sub2: TPersistentSimple read FSub2 write FSub2; property After: longint read FAfter write FAfter default 0; property OnClick: TNotifyEvent read FOnClick write FOnClick; end; { TSimpleControl } TSimpleControl = class(TComponent) procedure OnA(Sender: TObject); procedure OnB(Sender: TObject); procedure OnC(Sender: TObject); private FChildren: TFPList; FNext: TSimpleControl; FOnClick: TNotifyEvent; FParent: TSimpleControl; FSub: TPersistentSimple; function GetControls(Index: integer): TSimpleControl; procedure SetParent(const AValue: TSimpleControl); protected procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; procedure SetParentComponent(Value: TComponent); override; procedure SetChildOrder(Child: TComponent; Order: Integer); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetParentComponent: TComponent; override; property Parent: TSimpleControl read FParent write SetParent; function ControlCount: integer; property Controls[Index: integer]: TSimpleControl read GetControls; published property Next: TSimpleControl read FNext write FNext; property Sub: TPersistentSimple read FSub write FSub; 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; { TSimpleControlWithInterface } TSimpleControlWithInterface = class(TSimpleControl, IInterfaceComponentReference) private FIntf: IInterfaceComponentReference; public function GetComponent: TComponent; published property Intf: IInterfaceComponentReference read FIntf write FIntf; end; { TSimpleControlWithStrings } TSimpleControlWithStrings = class(TSimpleControl) private FLines: TStrings; published property Lines: TStrings read FLines write FLines; end; { TTestCompReaderWriterPas } TTestCompReaderWriterPas = class(TCustomTestCTStdCodetools) private FStream: TMemoryStream; FWriter: TCompWriterPas; FAncestors: TPointerToPointerTree; 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); procedure OnWriterGetParentProperty(Sender: TCompWriterPas; Component: TComponent; var PropName: string); protected procedure SetUp; override; procedure TearDown; override; function WriteDescendant(Component: TComponent; Ancestor: TComponent = nil): string; procedure TestWriteDescendant(Msg: string; Component: TComponent; Ancestor: TComponent; const Expected: array of string; NeedAccessClass: boolean = false); property Writer: TCompWriterPas read FWriter write FWriter; public constructor Create; override; destructor Destroy; override; procedure AddAncestor(Component, Ancestor: TComponent); published procedure TestBaseTypesSkipDefaultValue; procedure TestBaseTypesZeroes; procedure TestBaseTypesMinValues; procedure TestBaseTypesMaxValues; procedure TestStringASCII; procedure TestStringUTF8; procedure TestWideString_SrcCodePageSystem; procedure TestWideString_SrcCodePageUTF8; procedure TestVariant; procedure TestPropPersistent; procedure TestInterface; procedure TestAncestor; procedure TestAncestorChildPos; procedure TestWithLookupRootName; procedure TestChildComponents; procedure TestChildComponentsNoWith; procedure TestForeignReference; procedure TestCollection; procedure TestInline; // e.g. a Frame on a Form procedure TestAncestorWithInline; // e.g. a Form inherited from a Form with a Frame procedure TestInlineDescendant; // e.g. a Form with a Frame, Frame is inherited from another Frame procedure TestDesignInfo; procedure TestDefineProperties_ListOfStrings; procedure Test_TStrings; end; implementation type TAccessComp = class(TComponent); function CreateRootName(aComponent: TComponent): string; begin Result:=aComponent.ClassName; Delete(Result,1,1); Result:=Result+'1'; end; { TSimpleControlWithInterface } function TSimpleControlWithInterface.GetComponent: TComponent; begin Result:=Self; 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); begin if Sender=nil then ; end; procedure TSimpleControl.OnB(Sender: TObject); begin if Sender=nil then ; end; procedure TSimpleControl.OnC(Sender: TObject); begin if Sender=nil then ; end; procedure TSimpleControl.SetParent(const AValue: TSimpleControl); begin if FParent=AValue then Exit; if FParent<>nil then FParent.FChildren.Remove(Self); FParent:=AValue; if FParent<>nil then FParent.FChildren.Add(Self); end; function TSimpleControl.GetControls(Index: integer): TSimpleControl; begin Result:=TSimpleControl(FChildren[INdex]); end; procedure TSimpleControl.GetChildren(Proc: TGetChildProc; Root: TComponent); var i: Integer; begin if Root=nil then ; for i:=0 to ControlCount-1 do Proc(Controls[i]); end; procedure TSimpleControl.SetParentComponent(Value: TComponent); begin Parent:=Value as TSimpleControl; end; procedure TSimpleControl.SetChildOrder(Child: TComponent; Order: Integer); begin FChildren.Move(FChildren.IndexOf(Child),Order); end; constructor TSimpleControl.Create(AOwner: TComponent); begin inherited Create(AOwner); FChildren:=TFPList.Create; end; destructor TSimpleControl.Destroy; var i: Integer; begin for i:=FChildren.Count-1 downto 0 do TSimpleControl(FChildren[i]).Parent:=nil; FreeAndNil(FChildren); inherited Destroy; end; function TSimpleControl.GetParentComponent: TComponent; begin Result:=FParent; end; function TSimpleControl.ControlCount: integer; begin Result:=FChildren.Count; end; { TCompPropPersistent } procedure TCompPropPersistent.OnA(Sender: TObject); begin if Sender=nil then ; end; procedure TCompPropPersistent.OnB(Sender: TObject); begin if Sender=nil then ; end; procedure TCompPropPersistent.OnC(Sender: TObject); begin if Sender=nil then ; end; { TCompBaseTypesCustomStored } procedure TCompBaseTypesCustomStored.OnClick(Sender: TObject); begin if Sender=nil then ; end; function TCompBaseTypesCustomStored.ABooleanIsStored: Boolean; begin Result:=FABoolean<>DefABoolean; end; function TCompBaseTypesCustomStored.AByteBoolIsStored: Boolean; begin Result:=FAByteBool<>DefAByteBool; end; function TCompBaseTypesCustomStored.AByteIsStored: Boolean; begin Result:=FAByte<>DefAByte; end; function TCompBaseTypesCustomStored.ACharIsStored: Boolean; begin Result:=FAChar<>DefAChar; end; function TCompBaseTypesCustomStored.ACurrencyIsStored: Boolean; begin Result:=FACurrency<>DefACurrency; end; function TCompBaseTypesCustomStored.ADoubleIsStored: Boolean; begin Result:=FADouble<>DefADouble; end; function TCompBaseTypesCustomStored.AExtendedIsStored: Boolean; begin Result:=FAExtended<>DefAExtended; end; function TCompBaseTypesCustomStored.AInt64IsStored: Boolean; begin Result:=FAInt64<>DefAInt64; end; function TCompBaseTypesCustomStored.ALongBoolIsStored: Boolean; begin Result:=FALongBool<>DefALongBool; end; function TCompBaseTypesCustomStored.ALongIntIsStored: Boolean; begin Result:=FALongInt<>DefALongInt; end; function TCompBaseTypesCustomStored.ALongWordIsStored: Boolean; begin Result:=FALongWord<>DefALongWord; end; function TCompBaseTypesCustomStored.AQWordIsStored: Boolean; begin Result:=FAWord<>DefAWord; end; function TCompBaseTypesCustomStored.AShortIntIsStored: Boolean; begin Result:=FAShortInt<>DefAShortInt; end; function TCompBaseTypesCustomStored.AShortStringIsStored: Boolean; begin Result:=FAShortString<>DefAShortString; end; function TCompBaseTypesCustomStored.ASingleIsStored: Boolean; begin Result:=FASingle<>DefASingle; end; function TCompBaseTypesCustomStored.ASmallIntIsStored: Boolean; begin Result:=FASmallInt<>DefASmallInt; end; function TCompBaseTypesCustomStored.AStringIsStored: Boolean; begin Result:=FAString<>DefAString; end; function TCompBaseTypesCustomStored.AUnicodeStringIsStored: Boolean; begin Result:=FAUnicodeString<>DefAUnicodeString; end; function TCompBaseTypesCustomStored.AWideCharIsStored: Boolean; begin Result:=FAWideChar<>DefAWideChar; end; function TCompBaseTypesCustomStored.AWideStringIsStored: Boolean; begin Result:=FAWideString<>DefAWideString; end; function TCompBaseTypesCustomStored.AWordBoolIsStored: Boolean; begin Result:=FAWordBool<>DefAWordBool; end; function TCompBaseTypesCustomStored.AWordIsStored: Boolean; begin Result:=FAWord<>DefAWord; end; function TCompBaseTypesCustomStored.EnumIsStored: Boolean; begin Result:=FEnum<>DefEnum; end; function TCompBaseTypesCustomStored.EnumRgIsStored: Boolean; begin Result:=FEnumRg<>DefEnumRg; end; function TCompBaseTypesCustomStored.EventIsStored: Boolean; begin Result:=TMethod(FEvent).Code<>TMethod(DefEvent).Code; end; function TCompBaseTypesCustomStored.MyCharIsStored: Boolean; begin Result:=MyChar<>DefMyChar; end; function TCompBaseTypesCustomStored.MyIntIsStored: Boolean; begin Result:=FMyInt<>DefMyInt; end; function TCompBaseTypesCustomStored.SetOfBoolIsStored: Boolean; begin Result:=FSetOfBool<>DefSetOfBool; end; function TCompBaseTypesCustomStored.SetOfEnumIsStored: Boolean; begin Result:=FSetOfEnum<>DefSetOfEnum; end; function TCompBaseTypesCustomStored.SetOfEnumRgIsStored: Boolean; begin Result:=FSetOfEnumRg<>DefSetOfEnumRg; end; function TCompBaseTypesCustomStored.SetOfMyCharIsStored: Boolean; begin Result:=SetOfMyChar<>DefSetOfMyChar; end; function TCompBaseTypesCustomStored.SetOfMyIntIsStored: Boolean; begin Result:=FSetOfMyInt<>DefSetOfMyInt; end; constructor TCompBaseTypesCustomStored.Create(AOwner: TComponent); begin inherited Create(AOwner); end; { TCompBaseTypes } function TCompBaseTypes.isACurrencyStored: Boolean; begin Result:=ACurrency<>0; end; function TCompBaseTypes.isADoubleStored: Boolean; begin Result:=ADouble<>0; end; function TCompBaseTypes.isAExtendedStored: Boolean; begin Result:=AExtended<>0; end; function TCompBaseTypes.isAShortStringStored: Boolean; begin Result:=AShortString<>''; end; function TCompBaseTypes.isASingleStored: Boolean; begin Result:=ASingle<>0; end; function TCompBaseTypes.isAStringStored: Boolean; begin Result:=AString<>''; end; function TCompBaseTypes.isAUnicodeStringStored: Boolean; begin Result:=AUnicodeString<>''; end; function TCompBaseTypes.isAWideStringStored: Boolean; begin Result:=AWideString<>''; end; constructor TCompBaseTypes.Create(AOwner: TComponent); begin inherited Create(AOwner); EnumRg:=low(TEnumRg); MyInt:=low(TMyInt); MyChar:=low(TMyChar); end; { TTestCompReaderWriterPas } procedure TTestCompReaderWriterPas.OnWriterFindAncestor(Sender: TCompWriterPas; Component: TComponent; const Name: string; var Ancestor, RootAncestor: TComponent); var C: TComponent; begin if Name='' then ; C:=TComponent(FAncestors[Component]); if C=nil then exit; Ancestor:=C; if C.Owner=nil then RootAncestor:=C; end; procedure TTestCompReaderWriterPas.OnDefinePropertiesTStrings( 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 List.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 if Component is TSimpleControl then PropName:='Parent'; end; procedure TTestCompReaderWriterPas.SetUp; begin inherited SetUp; FStream:=TMemoryStream.Create; FWriter:=TCompWriterPas.Create(FStream); FWriter.OnFindAncestor:=@OnWriterFindAncestor; FWriter.OnGetParentProperty:=@OnWriterGetParentProperty; end; procedure TTestCompReaderWriterPas.TearDown; begin FAncestors.Clear; FreeAndNil(FWriter); FreeAndNil(FStream); inherited TearDown; end; function TTestCompReaderWriterPas.WriteDescendant(Component: TComponent; Ancestor: TComponent): string; begin Writer.WriteDescendant(Component,Ancestor); FStream.Position:=0; SetLength(Result{%H-},FStream.size); if Result<>'' then FStream.Read(Result[1],length(Result)); {$IFDEF VerboseCompWriterPas} writeln('TTestCompReaderWriterPas.WriteDescendant "',Result,'"'); {$ENDIF} end; procedure TTestCompReaderWriterPas.TestWriteDescendant(Msg: string; Component: TComponent; Ancestor: TComponent; const Expected: array of string; NeedAccessClass: boolean); var Actual, ExpS, s: String; begin Actual:=WriteDescendant(Component,Ancestor); ExpS:=CSPDefaultSignatureBegin+LineEnding; ExpS:=ExpS+Writer.GetVersionStatement+LineEnding; if cwpoNoSelf in Writer.Options then begin ExpS:=ExpS+'with '+Component.Name+' do begin'+LineEnding; ExpS:=ExpS+' Name:='''+Component.Name+''';'+LineEnding; end else ExpS:=ExpS+'Name:='''+Component.Name+''';'+LineEnding; for s in Expected do ExpS:=ExpS+s+LineEnding; if cwpoNoSelf in Writer.Options then ExpS:=ExpS+'end;'+LineEnding; ExpS:=ExpS+CSPDefaultSignatureEnd+LineEnding; //writeln('TTestCompReaderWriterPas.TestWriteDescendant ACTUAL=',Actual); //writeln('TTestCompReaderWriterPas.TestWriteDescendant EXP=',ExpS); CheckDiff(Msg,ExpS,Actual); AssertEquals(Msg+' NeedAccessClass',NeedAccessClass,Writer.NeedAccessClass); end; constructor TTestCompReaderWriterPas.Create; begin inherited Create; FAncestors:=TPointerToPointerTree.Create; end; destructor TTestCompReaderWriterPas.Destroy; begin FreeAndNil(FAncestors); inherited Destroy; end; procedure TTestCompReaderWriterPas.AddAncestor(Component, Ancestor: TComponent); begin FAncestors[Component]:=Ancestor; end; procedure TTestCompReaderWriterPas.TestBaseTypesSkipDefaultValue; var AComponent: TCompBaseTypes; begin AComponent:=TCompBaseTypes.Create(nil); try AComponent.Name:=CreateRootName(AComponent); TestWriteDescendant('TestBaseTypesSkipDefaultValue',AComponent,nil,[ ]); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestBaseTypesZeroes; var AComponent: TCompBaseTypesCustomStored; begin AComponent:=TCompBaseTypesCustomStored.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); AByte:=0; DefAByte:=AByte+1; AShortInt:=0; DefAShortInt:=AShortInt+1; AWord:=0; DefAWord:=AWord+1; ASmallInt:=0; DefASmallInt:=ASmallInt+1; ALongWord:=0; DefALongWord:=ALongWord+1; ALongInt:=0; DefALongInt:=ALongInt+1; AQWord:=0; DefAQWord:=AQWord+1; AInt64:=0; DefAInt64:=AInt64+1; ACurrency:=0; DefACurrency:=ACurrency+1; ASingle:=0; DefASingle:=ASingle+1; ADouble:=0; DefADouble:=ADouble+1; // ToDo: extended AChar:=#0; DefAChar:=succ(AChar); AWideChar:=#0; DefAWideChar:=succ(AWideChar); Enum:=TEnum(0); DefEnum:=succ(Enum); EnumRg:={%H-}TEnumRg(0); DefEnumRg:=succ(EnumRg); SetOfEnum:=[]; DefSetOfEnum:=[red]; SetOfEnumRg:=[]; DefSetOfEnumRg:=[red]; SetOfBool:=[]; DefSetOfBool:=[true]; MyInt:={%H-}TMyInt(0); DefMyInt:=MyInt+1; SetOfMyInt:=[]; DefSetOfMyInt:=[2]; MyChar:={%H-}TMyChar(0); DefMyChar:=succ(MyChar); SetOfMyChar:=[]; DefSetOfMyChar:=[#4]; Event:=nil; DefEvent:=@OnClick; end; TestWriteDescendant('TestBaseTypesZeroes',AComponent,nil,[ 'AByte:=0;', 'AShortInt:=0;', 'AWord:=0;', 'ASmallInt:=0;', 'ALongWord:=0;', 'ALongInt:=0;', 'ACurrency:= 0.0;', 'ASingle:= 0.0;', 'ADouble:= 0.0;', 'AChar:=#0;', 'AWideChar:=#0;', 'Enum:=red;', 'EnumRg:=TEnumRg(0);', 'SetOfEnum:=[];', 'SetOfEnumRg:=[];', 'SetOfBool:=[];', 'MyInt:=0;', 'SetOfMyInt:=[];', 'MyChar:=#0;', 'SetOfMyChar:=[];', //'Event:=nil;', must not be written '']); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestBaseTypesMinValues; var AComponent: TCompBaseTypesCustomStored; begin AComponent:=TCompBaseTypesCustomStored.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); ABoolean:=low(boolean); DefABoolean:=not ABoolean; AByteBool:=boolean(low(byte)); DefAByteBool:=not AByteBool; AWordBool:=boolean(low(word)); DefAWordBool:=not AWordBool; ALongBool:=boolean(low(longword)); DefALongBool:=not ALongBool; AByte:=low(byte); DefAByte:=AByte+1; AShortInt:=low(ShortInt); DefAShortInt:=AShortInt+1; AWord:=low(word); DefAWord:=AWord+1; ASmallInt:=low(SmallInt); DefASmallInt:=ASmallInt+1; ALongWord:=low(LongWord); DefALongWord:=ALongWord+1; ALongInt:=low(LongInt); DefALongInt:=ALongInt+1; AQWord:=low(qword); DefAQWord:=AQWord+1; AInt64:=low(Int64); DefAInt64:=AInt64+1; ACurrency:=MinSafeIntCurrency; DefACurrency:=ACurrency+1; ASingle:=MinSafeIntSingle; DefASingle:=ASingle+1; ADouble:=MinSafeIntDouble; DefADouble:=ADouble+1; // ToDo: extended AChar:=low(char); DefAChar:=succ(AChar); AWideChar:=low(WideChar); DefAWideChar:=succ(AWideChar); Enum:=low(TEnum); DefEnum:=succ(Enum); EnumRg:=low(TEnumRg); DefEnumRg:=succ(EnumRg); SetOfEnum:=[]; DefSetOfEnum:=[red]; SetOfEnumRg:=[]; DefSetOfEnumRg:=[red]; SetOfBool:=[]; DefSetOfBool:=[true]; MyInt:=low(TMyInt); DefMyInt:=MyInt+1; SetOfMyInt:=[]; DefSetOfMyInt:=[2]; MyChar:=low(TMyChar); DefMyChar:=succ(MyChar); SetOfMyChar:=[]; DefSetOfMyChar:=[#4]; Event:=@OnClick; DefEvent:=nil; end; TestWriteDescendant('TestBaseTypesMinValues',AComponent,nil,[ 'ABoolean:=False;', 'AByteBool:=False;', 'AWordBool:=False;', 'ALongBool:=False;', 'AByte:=0;', 'AShortInt:=-128;', 'AWord:=0;', 'ASmallInt:=-32768;', 'ALongWord:=0;', 'ALongInt:=-2147483648;', 'AInt64:=-9223372036854775808;', 'ACurrency:=-9.22337203685477E14;', 'ASingle:=-1.6777216E7;', 'ADouble:=-4.503599627370496E15;', 'AChar:=#0;', 'AWideChar:=#0;', 'Enum:=red;', 'EnumRg:=green;', 'SetOfEnum:=[];', 'SetOfEnumRg:=[];', 'SetOfBool:=[];', 'MyInt:=1;', 'SetOfMyInt:=[];', 'MyChar:=#3;', 'SetOfMyChar:=[];', 'Event:=@OnClick;', '']); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestBaseTypesMaxValues; var AComponent: TCompBaseTypesCustomStored; begin AComponent:=TCompBaseTypesCustomStored.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); ABoolean:=high(boolean); DefABoolean:=not ABoolean; AByteBool:=boolean(high(byte)); DefAByteBool:=not AByteBool; AWordBool:=wordbool(high(word)); DefAWordBool:=not AWordBool; ALongBool:=longbool(high(longword)); DefALongBool:=not ALongBool; AByte:=high(byte); DefAByte:=AByte-1; AShortInt:=high(ShortInt); DefAShortInt:=AShortInt-1; AWord:=high(word); DefAWord:=AWord-1; ASmallInt:=high(SmallInt); DefASmallInt:=ASmallInt-1; ALongWord:=high(LongWord); DefALongWord:=ALongWord-1; ALongInt:=high(LongInt); DefALongInt:=ALongInt-1; AQWord:=high(qword); DefAQWord:=AQWord-1; AInt64:=high(Int64); DefAInt64:=AInt64-1; ACurrency:=MaxSafeIntCurrency; DefACurrency:=ACurrency-1; ASingle:=MaxSafeIntSingle; DefASingle:=ASingle-1; ADouble:=MaxSafeIntDouble; DefADouble:=ADouble-1; // ToDo: extended AChar:=high(char); DefAChar:=pred(AChar); AWideChar:=high(WideChar); DefAWideChar:=pred(AWideChar); Enum:=high(TEnum); DefEnum:=pred(Enum); EnumRg:=high(TEnumRg); DefEnumRg:=pred(EnumRg); SetOfEnum:=[low(SetOfEnum)..high(SetOfEnum)]; DefSetOfEnum:=[red]; SetOfEnumRg:=[low(SetOfEnumRg)..high(SetOfEnumRg)]; DefSetOfEnumRg:=[red]; SetOfBool:=[low(Boolean)..high(Boolean)]; DefSetOfBool:=[true]; MyInt:=high(TMyInt); DefMyInt:=pred(MyInt); SetOfMyInt:=[low(MyInt)..high(MyInt)]; DefSetOfMyInt:=[3]; MyChar:=high(TMyChar); DefMyChar:=pred(MyChar); SetOfMyChar:=[low(MyChar)..high(MyChar)]; DefSetOfMyChar:=[#5]; end; TestWriteDescendant('TestBaseTypesMaxValues',AComponent,nil,[ 'ABoolean:=True;', 'AByteBool:=True;', 'AWordBool:=True;', 'ALongBool:=True;', 'AByte:=255;', 'AShortInt:=127;', 'AWord:=65535;', 'ASmallInt:=32767;', 'ALongWord:=4294967295;', 'ALongInt:=2147483647;', 'AQWord:=18446744073709551615;', 'AInt64:=9223372036854775807;', 'ACurrency:=9.22337203685477E14;', 'ASingle:=1.6777216E7;', 'ADouble:=4.503599627370495E15;', 'AChar:=#255;', 'AWideChar:=#65535;', 'Enum:=black;', 'EnumRg:=white;', 'SetOfEnum:=[red..black];', 'SetOfEnumRg:=[green..white];', 'SetOfBool:=[False..True];', 'MyInt:=7;', 'SetOfMyInt:=[1..7];', 'MyChar:=#10;', 'SetOfMyChar:=[#3..#10];', '']); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestStringASCII; var AComponent: TCompBaseTypes; begin AComponent:=TCompBaseTypes.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); AString:=#9'A'#13#10; AShortString:=#9'A'#13#10; end; TestWriteDescendant('TestStringASCII',AComponent,nil,[ 'AString:=#9''A''#13#10;', 'AShortString:=#9''A''#13#10;']); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestStringUTF8; var AComponent: TCompBaseTypes; begin AComponent:=TCompBaseTypes.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); AString:='äöü'; AShortString:='äöü'; end; TestWriteDescendant('TestStringUTF8',AComponent,nil,[ 'AString:=''äöü'';', 'AShortString:=''äöü'';', '']); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestWideString_SrcCodePageSystem; var AComponent: TCompBaseTypes; begin AComponent:=TCompBaseTypes.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); AWideString:=UTF8ToUTF16('äAöü'); AUnicodeString:=UTF8ToUTF16('äöBCü'); end; TestWriteDescendant('TestWideString_SrcCodePageSystem',AComponent,nil,[ 'AWideString:=#0228''A''#0246#0252;', 'AUnicodeString:=#0228#0246''BC''#0252;', '']); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestWideString_SrcCodePageUTF8; var AComponent: TCompBaseTypes; begin Writer.Options:=Writer.Options+[cwpoSrcCodepageUTF8]; AComponent:=TCompBaseTypes.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); AWideString:=UTF8ToUTF16('äöü'); AUnicodeString:=UTF8ToUTF16('äöü'); end; TestWriteDescendant('TestWideString_SrcCodePageUTF8',AComponent,nil,[ 'AWideString:=''äöü'';', 'AUnicodeString:=''äöü'';', '']); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestVariant; var AComponent: TCompVariants; begin Writer.Options:=Writer.Options+[cwpoSrcCodepageUTF8]; AComponent:=TCompVariants.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); V1:=high(byte); V2:=low(ShortInt); V3:=high(Word); V4:=low(SmallInt); V5:=high(LongWord){%H-}; V6:=low(LongInt); V7:=high(QWord); V8:=low(int64); V9:=true; V10:='äöü'; V11:=single(-1.25); V12:=double(1.5); V13:=currency(17.0001); end; TestWriteDescendant('TestVariant',AComponent,nil,[ 'V1:=Byte(255);', 'V2:=ShortInt(-128);', 'V3:=Word(65535);', 'V4:=SmallInt(-32768);', 'V5:=LongWord(4294967295);', 'V6:=LongInt(-2147483648);', 'V7:=QWord(18446744073709551615);', 'V8:=Int64(-9223372036854775808);', 'V9:=True;', 'V10:=''äöü'';', 'V11:=Double(-1.25);', 'V12:=Double(1.5);', 'V13:=Currency(17.0001);', '']); finally AComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestPropPersistent; var aRoot: TCompPropPersistent; begin aRoot:=TCompPropPersistent.Create(nil); try with aRoot do begin Name:=CreateRootName(aRoot); Before:=1; Sub:=TPersistentSimple.Create; Sub.Size:=11; Middle:=2; Sub2:=TPersistentSimple.Create; Sub2.Size:=21; Sub2.Sub:=TPersistentSimple.Create; Sub2.Sub.Size:=211; After:=3; end; TestWriteDescendant('TestPropPersistent',aRoot,nil,[ 'Before:=1;', 'Sub.Size:=11;', 'Middle:=2;', 'Sub2.Size:=21;', 'Sub2.Sub.Size:=211;', 'After:=3;', '']); finally FreeAndNil(aRoot.FSub2.FSub); FreeAndNil(aRoot.FSub2); FreeAndNil(aRoot.FSub); aRoot.Free; end; end; procedure TTestCompReaderWriterPas.TestInterface; var aRoot: TSimpleControl; Button1, Label1: TSimpleControlWithInterface; begin aRoot:=TSimpleControl.Create(nil); try with aRoot do begin Name:=CreateRootName(aRoot); Button1:=TSimpleControlWithInterface.Create(aRoot); with Button1 do begin Name:='Button1'; Parent:=aRoot; end; Label1:=TSimpleControlWithInterface.Create(aRoot); with Label1 do begin Name:='Label1'; Parent:=aRoot; Intf:=Button1; end; Button1.Intf:=Label1; end; TestWriteDescendant('TestInterface',aRoot,nil,[ 'Button1:=TSimpleControlWithInterface.Create(Self);', 'Label1:=TSimpleControlWithInterface.Create(Self);', 'with Button1 do begin', ' Name:=''Button1'';', ' Intf:=Label1;', ' Parent:=Self;', 'end;', 'with Label1 do begin', ' Name:=''Label1'';', ' Intf:=Button1;', ' Parent:=Self;', 'end;', '']); finally aRoot.Free; end; end; procedure TTestCompReaderWriterPas.TestAncestor; procedure InitAncestor(C: TSimpleControl); var Button1: TSimpleControl; begin C.Tag:=1; Button1:=TSimpleControl.Create(C); with Button1 do begin Name:='Button1'; Tag:=2; OnClick:=@C.OnA; Parent:=C; end; end; var aRoot, Ancestor: TSimpleControl; begin Ancestor:=TSimpleControl.Create(nil); aRoot:=TSimpleControl.Create(nil); try with Ancestor do begin Name:='Ancestor'; end; InitAncestor(Ancestor); with aRoot do begin Name:='Descendant'; end; InitAncestor(aRoot); TestWriteDescendant('TestAncestor',aRoot,Ancestor,[ 'with Button1 do begin', 'end;', '']); finally aRoot.Free; Ancestor.Free; end; end; procedure TTestCompReaderWriterPas.TestAncestorChildPos; procedure InitAncestor(C: TSimpleControl); var Button1, Panel2, Button21, Button22: TSimpleControl; begin C.Tag:=1; Button1:=TSimpleControl.Create(C); with Button1 do begin Name:='Button1'; Tag:=11; Parent:=C; end; Panel2:=TSimpleControl.Create(C); with Panel2 do begin Name:='Panel2'; Tag:=12; 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; var aRoot, Ancestor: TSimpleControl; begin Ancestor:=TSimpleControl.Create(nil); aRoot:=TSimpleControl.Create(nil); try with Ancestor do begin Name:='Ancestor'; end; InitAncestor(Ancestor); with aRoot do begin Name:='Descendant'; end; InitAncestor(aRoot); // switch Button21 and Button22 aRoot.Controls[1].FChildren.Move(0,1); // switch Button1 and Panel2 aRoot.FChildren.Move(0,1); TestWriteDescendant('TestAncestorChildPos',aRoot,Ancestor,[ 'with Panel2 do begin', ' with Button22 do begin', ' end;', ' TPasStreamAccess(TComponent(Panel2)).SetChildOrder(Button22,0);', ' with Button21 do begin', ' end;', ' TPasStreamAccess(TComponent(Panel2)).SetChildOrder(Button21,1);', 'end;', 'SetChildOrder(Panel2,0);', 'with Button1 do begin', 'end;', 'SetChildOrder(Button1,1);', ''],true); finally aRoot.Free; Ancestor.Free; end; end; procedure TTestCompReaderWriterPas.TestWithLookupRootName; procedure InitAncestor(C: TSimpleControl); var Button1, Panel2, Button21, Button22: TSimpleControl; begin C.Tag:=1; Button1:=TSimpleControl.Create(C); with Button1 do begin Name:='Button1'; Tag:=11; Parent:=C; end; Panel2:=TSimpleControl.Create(C); with Panel2 do begin Name:='Panel2'; Tag:=12; 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; var aRoot, Ancestor, Label1: TSimpleControl; begin Ancestor:=TSimpleControl.Create(nil); aRoot:=TSimpleControl.Create(nil); try with Ancestor do begin Name:='Ancestor'; end; InitAncestor(Ancestor); with aRoot do begin Name:='Descendant'; end; InitAncestor(aRoot); aRoot.Controls[0].Next:=aRoot; aRoot.Next:=aRoot.Controls[0]; Label1:=TSimpleControl.Create(aRoot); with Label1 do begin Name:='Label1'; Parent:=aRoot; end; // switch Button21 and Button22 aRoot.Controls[1].FChildren.Move(0,1); // switch Button1 and Panel2 aRoot.FChildren.Move(0,1); Writer.Options:=Writer.Options+[cwpoNoSelf]; TestWriteDescendant('TestWithLookupRootName',aRoot,Ancestor,[ ' Label1:=TSimpleControl.Create(Descendant);', ' Next:=Button1;', ' with Panel2 do begin', ' with Button22 do begin', ' end;', ' TPasStreamAccess(TComponent(Panel2)).SetChildOrder(Button22,0);', ' with Button21 do begin', ' end;', ' TPasStreamAccess(TComponent(Panel2)).SetChildOrder(Button21,1);', ' end;', ' TPasStreamAccess(TComponent(Descendant)).SetChildOrder(Panel2,0);', ' with Button1 do begin', ' Next:=Descendant;', ' end;', ' TPasStreamAccess(TComponent(Descendant)).SetChildOrder(Button1,1);', ' with Label1 do begin', ' Name:=''Label1'';', ' Parent:=Descendant;', ' end;', ''],true); finally aRoot.Free; Ancestor.Free; end; end; procedure TTestCompReaderWriterPas.TestChildComponents; var aRoot, Button1, Panel1: TSimpleControl; begin aRoot:=TSimpleControl.Create(nil); try with aRoot do begin Name:=CreateRootName(aRoot); Tag:=1; end; Panel1:=TSimpleControl.Create(aRoot); with Panel1 do begin Name:='Panel1'; Tag:=2; Parent:=aRoot; Button1:=TSimpleControl.Create(aRoot); with Button1 do begin Name:='Button1'; Tag:=3; Parent:=Panel1; end; end; TestWriteDescendant('TestChildComponent',aRoot,nil,[ 'Panel1:=TSimpleControl.Create(Self);', 'Button1:=TSimpleControl.Create(Self);', 'Tag:=1;', 'with Panel1 do begin', ' Name:=''Panel1'';', ' Tag:=2;', ' Parent:=Self;', ' with Button1 do begin', ' Name:=''Button1'';', ' Tag:=3;', ' Parent:=Panel1;', ' end;', 'end;', '']); finally aRoot.Free; end; end; procedure TTestCompReaderWriterPas.TestChildComponentsNoWith; var aRoot, Button1, Panel1: TSimpleControl; begin aRoot:=TSimpleControl.Create(nil); try with aRoot do begin Name:='Root'; Tag:=1; end; Panel1:=TSimpleControl.Create(aRoot); with Panel1 do begin Name:='Panel1'; Tag:=2; Parent:=aRoot; Button1:=TSimpleControl.Create(aRoot); with Button1 do begin Name:='Button1'; Tag:=3; Parent:=Panel1; end; end; Writer.Options:=Writer.Options+[cwpoNoWithBlocks]; TestWriteDescendant('TestChildComponent',aRoot,nil,[ 'Panel1:=TSimpleControl.Create(Self);', 'Button1:=TSimpleControl.Create(Self);', 'Tag:=1;', ' Panel1.Name:=''Panel1'';', ' Panel1.Tag:=2;', ' Panel1.Parent:=Self;', ' Button1.Name:=''Button1'';', ' Button1.Tag:=3;', ' Button1.Parent:=Panel1;', '']); 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,[ 'Button1:=TSimpleControl.Create(Self);', 'Tag:=11;', 'Next:=OtherRoot;', 'with Button1 do begin', ' Name:=''Button1'';', ' Tag:=12;', ' Next:=OtherRoot.Button2;', ' Parent:=Self;', 'end;', '']); finally aRoot.Free; aRoot2.Free; 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;', 'Items.Clear;', '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; procedure TTestCompReaderWriterPas.TestInline; procedure InitFrame(Frame: TSimpleControl); var FrameButton1: TSimpleControl; begin with Frame do begin Tag:=12; FrameButton1:=TSimpleControl.Create(Frame); with FrameButton1 do begin Name:='FrameButton1'; Tag:=123; Parent:=Frame; end; end; end; var aRoot, Button1, Frame1, AncestorFrame: TSimpleControl; begin // e.g. a form with a frame // the form has no ancestor // the frame has an ancestor aRoot:=TSimpleControl.Create(nil); AncestorFrame:=TSimpleControl.Create(nil); try AncestorFrame.Name:='AncestorFrame'; InitFrame(AncestorFrame); with aRoot do begin Name:=CreateRootName(aRoot); Tag:=1; end; Button1:=TSimpleControl.Create(aRoot); with Button1 do begin Name:='Button1'; Parent:=aRoot; end; Frame1:=TSimpleControl.Create(aRoot); TAccessComp(TComponent(Frame1)).SetInline(true); InitFrame(Frame1); with Frame1 do begin Name:='Frame1'; Parent:=aRoot; end; AddAncestor(Frame1,AncestorFrame); TestWriteDescendant('TestInline',aRoot,nil,[ 'Button1:=TSimpleControl.Create(Self);', 'Frame1:=TSimpleControl.Create(Self);', CSPDefaultAccessClass+'(TComponent(Frame1)).SetInline(True);', 'Tag:=1;', 'with Button1 do begin', ' Name:=''Button1'';', ' Parent:=Self;', 'end;', 'with Frame1 do begin', ' Name:=''Frame1'';', ' Parent:=Self;', ' with FrameButton1 do begin', ' end;', 'end;', ''],true); finally AncestorFrame.Free; aRoot.Free; end; end; procedure TTestCompReaderWriterPas.TestAncestorWithInline; procedure InitFrame(Frame: TSimpleControl); var FrameButton1, FrameButton2: TSimpleControl; begin with Frame do begin Tag:=1; FrameButton1:=TSimpleControl.Create(Frame); with FrameButton1 do begin Name:='FrameButton1'; Tag:=11; Parent:=Frame; end; FrameButton2:=TSimpleControl.Create(Frame); with FrameButton2 do begin Name:='FrameButton2'; Tag:=12; Parent:=Frame; end; end; end; procedure InitForm(Form: TSimpleControl; out Frame1: TSimpleControl); var Button1: TSimpleControl; begin with Form do begin // add a button Button1:=TSimpleControl.Create(Form); with Button1 do begin Name:='Button1'; Tag:=21; Parent:=Form; end; // add a frame Frame1:=TSimpleControl.Create(Form); TAccessComp(TComponent(Frame1)).SetInline(true); InitFrame(Frame1); with Frame1 do begin Name:='Frame1'; Tag:=22; Parent:=Form; end; end; end; var Frame1, AncestorFrame, AncestorForm, Form, Frame2, Label1: TSimpleControl; begin // e.g. a form inherited from with a frame AncestorFrame:=nil; AncestorForm:=nil; Form:=nil; try AncestorFrame:=TSimpleControl.Create(nil); AncestorFrame.Name:='AncestorFrame'; InitFrame(AncestorFrame); AncestorForm:=TSimpleControl.Create(nil); AncestorForm.Name:='AncestorForm'; InitForm(AncestorForm,Frame1); AddAncestor(Frame1,AncestorFrame); Form:=TSimpleControl.Create(nil); Form.Name:='Form'; InitForm(Form,Frame2); Frame2.Tag:=32; Frame2.Controls[0].Tag:=421; // change Z order of buttons in frame Form.FChildren.Move(0,1); // change Z order of frame in Form Frame2.FChildren.Move(0,1); // add a label Label1:=TSimpleControl.Create(Form); with Label1 do begin Name:='Label1'; Tag:=33; Parent:=Form; end; TestWriteDescendant('TestAncestorWithInline',Form,AncestorForm,[ 'Label1:=TSimpleControl.Create(Self);', 'with Frame1 do begin', ' Tag:=32;', ' with FrameButton2 do begin', ' end;', ' TPasStreamAccess(TComponent(Frame1)).SetChildOrder(Frame1.FrameButton2,0);', ' with FrameButton1 do begin', ' Tag:=421;', ' end;', ' TPasStreamAccess(TComponent(Frame1)).SetChildOrder(Frame1.FrameButton1,1);', 'end;', 'SetChildOrder(Frame1,0);', 'with Button1 do begin', 'end;', 'SetChildOrder(Button1,1);', 'with Label1 do begin', ' Name:=''Label1'';', ' Tag:=33;', ' Parent:=Self;', 'end;', ''],true); finally Form.Free; AncestorForm.Free; AncestorFrame.Free; end; end; procedure TTestCompReaderWriterPas.TestInlineDescendant; procedure InitFrame(Frame: TSimpleControl); var FrameButton1, FrameButton2: TSimpleControl; begin with Frame do begin Tag:=1; FrameButton1:=TSimpleControl.Create(Frame); with FrameButton1 do begin Name:='FrameButton1'; Tag:=11; Parent:=Frame; end; FrameButton2:=TSimpleControl.Create(Frame); with FrameButton2 do begin Name:='FrameButton2'; Tag:=12; Parent:=Frame; end; end; end; procedure InitForm(Form: TSimpleControl; out Frame1: TSimpleControl); var Button1: TSimpleControl; begin with Form do begin // add a button Button1:=TSimpleControl.Create(Form); with Button1 do begin Name:='Button1'; Tag:=21; Parent:=Form; end; // add a frame Frame1:=TSimpleControl.Create(Form); TAccessComp(TComponent(Frame1)).SetInline(true); InitFrame(Frame1); with Frame1 do begin Name:='Frame1'; Tag:=22; Parent:=Form; end; end; end; var AncestorFrame, DescendantFrame, Form, Frame: TSimpleControl; begin // e.g. a form inherited from with a frame AncestorFrame:=nil; DescendantFrame:=nil; Form:=nil; try AncestorFrame:=TSimpleControl.Create(nil); AncestorFrame.Name:='AncestorFrame'; InitFrame(AncestorFrame); DescendantFrame:=TSimpleControl.Create(nil); DescendantFrame.Name:='DescendantFrame'; InitFrame(DescendantFrame); AddAncestor(DescendantFrame,AncestorFrame); Form:=TSimpleControl.Create(nil); Form.Name:='Form'; InitForm(Form,Frame); AddAncestor(Frame,DescendantFrame); TestWriteDescendant('TestInlineDescendant',Form,nil,[ 'Button1:=TSimpleControl.Create(Self);', 'Frame1:=TSimpleControl.Create(Self);', 'TPasStreamAccess(TComponent(Frame1)).SetInline(True);', 'with Button1 do begin', ' Name:=''Button1'';', ' Tag:=21;', ' Parent:=Self;', 'end;', 'with Frame1 do begin', ' Name:=''Frame1'';', ' Tag:=22;', ' Parent:=Self;', ' with FrameButton1 do begin', ' end;', ' with FrameButton2 do begin', ' end;', 'end;', ''],true); finally Form.Free; DescendantFrame.Free; AncestorFrame.Free; end; end; procedure TTestCompReaderWriterPas.TestDesignInfo; var AComponent: TComponent; begin AComponent:=TComponent.Create(nil); try with AComponent do begin Name:=CreateRootName(AComponent); DesignInfo:=12345678; end; TestWriteDescendant('TestDesignInfo',AComponent,nil,[ 'DesignInfo:=12345678;', '']); finally aComponent.Free; end; end; procedure TTestCompReaderWriterPas.TestDefineProperties_ListOfStrings; var ARoot: TSimpleControlWithStrings; Expected: String; Lines2: TStringList; begin ARoot:=TSimpleControlWithStrings.Create(nil); Lines2:=nil; try with ARoot do begin Name:=CreateRootName(ARoot); Lines:=TStringList.Create; Lines.Text:='First'+LineEnding+'Second'; end; Expected:=#7'Strings'#1#6#5'First'#6#6'Second'#0#0; TestWriteDescendant('TestDefineProperites_ListOfStrings',ARoot,nil,[ CSPDefaultExecCustomProc+'(Lines,[#7''Strings''#1#6#5''First''#6#6''Second''#0#0]);', '']); Lines2:=TStringList.Create; ExecCustomCSP(Lines2,[Expected]); AssertEquals('read TStrings.Text',ARoot.Lines.Text,Lines2.Text); AssertEquals('NeededUnits.Count',1,Writer.NeededUnits.Count); AssertEquals('NeededUnits[0]',Writer.ExecCustomProcUnit,Writer.NeededUnits[0]); finally Lines2.Free; FreeAndNil(ARoot.FLines); ARoot.Free; 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; initialization RegisterTest(TTestCompReaderWriterPas); end.