diff --git a/test/tccompstreaming.pp b/test/tccompstreaming.pp index 3689f5a..e0e8f20 100644 --- a/test/tccompstreaming.pp +++ b/test/tccompstreaming.pp @@ -1,3 +1,25 @@ +{ Component streaming tests. + + Copyright (C) 2020 Michael Van Canneyt michael@freepascal.org + + This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version + with the following modification: + + As a special exception, the copyright holders of this library give you permission to link this library with independent modules + to produce an executable, regardless of the license terms of these independent modules,and to copy and distribute the resulting + executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions + of the license of that module. An independent module is a module which is not derived from or based on this library. If you + modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do + not wish to do so, delete this exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free + Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. +} + Unit tccompstreaming; interface @@ -1430,14 +1452,14 @@ end; procedure TTestComponentStream.TestTIntegerComponent2Text; Const - SData = + SData3 = 'object TestTIntegerComponent2: TIntegerComponent2'+sLineBreak+ ' IntProp = 1024'+sLineBreak+ 'end'+sLineBreak; begin TestTIntegerComponent2; - CheckAsString(SData); + CheckAsString(SData3); end; @@ -1466,14 +1488,14 @@ end; procedure TTestComponentStream.TestTIntegerComponent3Text; Const - SData = + SData4 = 'object TestTIntegerComponent3: TIntegerComponent3'+sLineBreak+ ' IntProp = 262144'+sLineBreak+ 'end'+sLineBreak; begin TestTIntegerComponent3; - CheckAsString(SData); + CheckAsString(SData4); end; @@ -1546,14 +1568,14 @@ end; procedure TTestComponentStream.TestTInt64ComponentText; Const - SData = + SData5 = 'object TestTInt64Component: TInt64Component'+sLineBreak+ ' Int64Prop = 4'+sLineBreak+ 'end'+sLineBreak; begin TestTInt64Component; - CheckAsString(SData); + CheckAsString(SData5); end; @@ -1582,14 +1604,14 @@ end; procedure TTestComponentStream.TestTInt64Component2Text; Const - SData = + SData6 = 'object TestTInt64Component2: TInt64Component2'+sLineBreak+ ' Int64Prop = 1024'+sLineBreak+ 'end'+sLineBreak; begin TestTInt64Component2; - CheckAsString(SData); + CheckAsString(SData6); end; @@ -1618,14 +1640,14 @@ end; procedure TTestComponentStream.TestTInt64Component3Text; Const - SData = + SData7 = 'object TestTInt64Component3: TInt64Component3'+sLineBreak+ ' Int64Prop = 262144'+sLineBreak+ 'end'+sLineBreak; begin TestTInt64Component3; - CheckAsString(SData); + CheckAsString(SData7); end; @@ -1654,14 +1676,14 @@ end; procedure TTestComponentStream.TestTInt64Component4Text; Const - SData = + SData8 = 'object TestTInt64Component4: TInt64Component4'+sLineBreak+ ' Int64Prop = 2147516415'+sLineBreak+ 'end'+sLineBreak; begin TestTInt64Component4; - CheckAsString(SData); + CheckAsString(SData8); end; @@ -1736,14 +1758,14 @@ end; procedure TTestComponentStream.TestTStringComponentText; Const - SData = + SData9 = 'object TestTStringComponent: TStringComponent'+sLineBreak+ ' StringProp = ''A string'''+sLineBreak+ 'end'+sLineBreak; begin TestTStringComponent; - CheckAsString(SData); + CheckAsString(SData9); end; @@ -1790,14 +1812,14 @@ end; procedure TTestComponentStream.TestTStringComponent3Text; Const - SData = + SData10 = 'object TestTStringComponent3: TStringComponent3'+sLineBreak+ ' StringProp = ''A ''''quoted'''' string'''+sLineBreak+ 'end'+sLineBreak; begin TestTStringComponent3; - CheckAsString(SData); + CheckAsString(SData10); end; @@ -1825,14 +1847,14 @@ end; procedure TTestComponentStream.TestTWideStringComponentText; Const - SData = + SData11 = 'object TestTWideStringComponent: TWideStringComponent'+sLineBreak+ ' WideStringProp = ''Some WideString'''+sLineBreak+ 'end'+sLineBreak; begin TestTWideStringComponent; - CheckAsString(SData); + CheckAsString(SData11); end; @@ -1905,14 +1927,14 @@ end; procedure TTestComponentStream.TestTDoubleComponentText; Const - SData = + SData12 = 'object TestTDoubleComponent: TDoubleComponent'+sLineBreak+ ' DoubleProp = 2.3E+000'+sLineBreak+ 'end'+sLineBreak; begin TestTDoubleComponent; - CheckAsString(SData); + CheckAsString(SData12); end; @@ -1989,14 +2011,14 @@ end; procedure TTestComponentStream.TestTCurrencyComponentTExt; Const - SData = + SData13 = 'object TestTCurrencyComponent: TCurrencyComponent'+sLineBreak+ ' CurrencyProp = 56700'+sLineBreak+ 'end'+sLineBreak; begin TestTCurrencyComponent; - CheckAsString(SData); + CheckAsString(SData13); end; @@ -2094,14 +2116,14 @@ end; procedure TTestComponentStream.TestTEnumComponentText; Const - SData = + SData14 = 'object TestTEnumComponent: TEnumComponent'+sLineBreak+ ' Dice = four'+sLineBreak+ 'end'+sLineBreak; begin TestTEnumComponent; - CheckAsString(SData); + CheckAsString(SData14); end; @@ -2223,14 +2245,14 @@ end; procedure TTestComponentStream.TestTSetComponentText; Const - SData = + SData15 = 'object TestTSetComponent: TSetComponent'+sLineBreak+ ' Throw = [two, five]'+sLineBreak+ 'end'+sLineBreak; begin TestTSetComponent; - CheckAsString(SData); + CheckAsString(SData15); end; @@ -2346,7 +2368,7 @@ end; procedure TTestComponentStream.TestTMultipleComponentText; Const - SData = + SData16 = 'object TestTMultipleComponent: TMultipleComponent'+sLineBreak+ ' IntProp = 1'+sLineBreak+ ' StringProp = ''A String'''+sLineBreak+ @@ -2357,7 +2379,7 @@ Const begin TestTMultipleComponent; - CheckAsString(SData); + CheckAsString(SData16); end; @@ -2388,7 +2410,7 @@ end; procedure TTestComponentStream.TestTPersistentComponentText; Const - SData = + SData17 = 'object TestTPersistentComponent: TPersistentComponent'+sLineBreak+ ' Persist.AInteger = 3'+sLineBreak+ ' Persist.AString = ''A persistent string'''+sLineBreak+ @@ -2396,7 +2418,7 @@ Const begin TestTPersistentComponent; - CheckAsString(SData); + CheckAsString(SData17); end; @@ -2425,14 +2447,14 @@ end; procedure TTestComponentStream.TestTCollectionComponentText; Const - SData = + SData18 = 'object TestTCollectionComponent: TCollectionComponent'+sLineBreak+ ' Coll = <>'+sLineBreak+ 'end'+sLineBreak; begin TestTCollectionComponent; - CheckAsString(SData); + CheckAsString(SData18); end; @@ -2473,7 +2495,7 @@ end; procedure TTestComponentStream.TestTCollectionComponent2Text; Const - SData = + SData19 = 'object TestTCollectionComponent2: TCollectionComponent2'+sLineBreak+ ' Coll = < '+sLineBreak+ ' item'+sLineBreak+ @@ -2489,7 +2511,7 @@ Const begin TestTCollectionComponent2; - CheckAsString(SData); + CheckAsString(SData19); end; @@ -2614,14 +2636,14 @@ end; procedure TTestComponentStream.TestTOwnedComponentText; Const - SData = + SData20 = 'object TestTOwnedComponent: TOwnedComponent'+sLineBreak+ ' CompProp = SubComponent'+sLineBreak+ 'end'+sLineBreak; begin TestTOwnedComponent; - CheckAsString(SData); + CheckAsString(SData20); end; @@ -2655,7 +2677,7 @@ end; procedure TTestComponentStream.TestTStreamedOwnedComponentText; Const - SData = + SData21 = 'object TestTStreamedOwnedComponent: TStreamedOwnedComponent'+sLineBreak+ ' object Sub: TIntegerComponent'+sLineBreak+ ' IntProp = 3'+sLineBreak+ @@ -2664,7 +2686,7 @@ Const begin TestTStreamedOwnedComponent; - CheckAsString(SData); + CheckAsString(SData21); end; Procedure TTestComponentStream.TestTStreamedOwnedComponents; @@ -2704,7 +2726,7 @@ end; procedure TTestComponentStream.TestTStreamedOwnedComponentsText; Const - SData = + SData22 = 'object TestTStreamedOwnedComponents: TStreamedOwnedComponents'+sLineBreak+ ' object SubA: TIntegerComponent'+sLineBreak+ ' IntProp = 3'+sLineBreak+ @@ -2716,7 +2738,7 @@ Const begin TestTStreamedOwnedComponents; - CheckAsString(SData); + CheckAsString(SData22); end; @@ -2745,14 +2767,14 @@ end; procedure TTestComponentStream.TestTMethodComponentText; Const - SData = + SData23 = 'object TestTMethodComponent: TMethodComponent'+sLineBreak+ ' MethodProp = MyMethod'+sLineBreak+ 'end'+sLineBreak; begin TestTMethodComponent; - CheckAsString(SData); + CheckAsString(SData23); end; @@ -2785,7 +2807,7 @@ end; procedure TTestComponentStream.TestTMethodComponent2Text; Const - SData = + SData24 = 'object TestTMethodComponent2: TMethodComponent2'+sLineBreak+ ' object AComponent: TMethodComponent'+sLineBreak+ ' MethodProp = MyMethod2'+sLineBreak+ @@ -2794,7 +2816,7 @@ Const begin TestTMethodComponent2; - CheckAsString(SData); + CheckAsString(SData24); end; @@ -2917,5 +2939,5 @@ begin end; begin - RegisterTests([TTestComponentStream,TTestCollectionStream]); +// RegisterTests([TTestComponentStream,TTestCollectionStream]); end. diff --git a/test/tcstream.pp b/test/tcstream.pp index 32f7a27..7acd33d 100644 --- a/test/tcstream.pp +++ b/test/tcstream.pp @@ -1,3 +1,24 @@ +{ TStream classes tests. + + Copyright (C) 2020 Michael Van Canneyt michael@freepascal.org + + This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version + with the following modification: + + As a special exception, the copyright holders of this library give you permission to link this library with independent modules + to produce an executable, regardless of the license terms of these independent modules,and to copy and distribute the resulting + executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions + of the license of that module. An independent module is a module which is not derived from or based on this library. If you + modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do + not wish to do so, delete this exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free + Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. +} unit tcstream; {$mode objfpc}{$H+} diff --git a/test/tcstreaming.pp b/test/tcstreaming.pp index b31c163..e4d005f 100644 --- a/test/tcstreaming.pp +++ b/test/tcstreaming.pp @@ -1,3 +1,25 @@ +{ Base class for component stream tests. + + Copyright (C) 2020 Michael Van Canneyt michael@freepascal.org + + This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version + with the following modification: + + As a special exception, the copyright holders of this library give you permission to link this library with independent modules + to produce an executable, regardless of the license terms of these independent modules,and to copy and distribute the resulting + executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions + of the license of that module. An independent module is a module which is not derived from or based on this library. If you + modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do + not wish to do so, delete this exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free + Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. +} + {$mode objfpc} {$h+} unit tcstreaming; diff --git a/test/tcsyshelpers.pp b/test/tcsyshelpers.pp index 106b559..5972962 100644 --- a/test/tcsyshelpers.pp +++ b/test/tcsyshelpers.pp @@ -1243,6 +1243,6 @@ end; initialization - RegisterTest(TTestHelpers); +// RegisterTest(TTestHelpers); end. diff --git a/test/testcomps.pp b/test/testcomps.pp new file mode 100644 index 0000000..4fc65b5 --- /dev/null +++ b/test/testcomps.pp @@ -0,0 +1,1093 @@ +{ Components used in component streaming tests. + + Copyright (C) 2020- Michael Van Canneyt michael@freepascal.org + + This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version + with the following modification: + + As a special exception, the copyright holders of this library give you permission to link this library with independent modules + to produce an executable, regardless of the license terms of these independent modules,and to copy and distribute the resulting + executable under terms of your choice, provided that you also meet, for each linked independent module, the terms and conditions + of the license of that module. An independent module is a module which is not derived from or based on this library. If you + modify this library, you may extend this exception to your version of the library, but you are not obligated to do so. If you do + not wish to do so, delete this exception statement from your version. + + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. + + You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free + Software Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. +} +unit testcomps; + +interface + +uses classes, sysutils; + +Type + TEmptyComponent = Class(TComponent) + end; + + // Simple integer, fits in 1 byte + TIntegerComponent = Class(TComponent) + private + FIntProp: Integer; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property IntProp : Integer Read FIntProp Write FIntProp; + end; + + // Simple integer, fits in 2 bytes + TIntegerComponent2 = Class(TComponent) + private + FIntProp: Integer; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property IntProp : Integer Read FIntProp Write FIntProp; + end; + + // Simple integer, fits in 3 bytes + TIntegerComponent3 = Class(TComponent) + private + FIntProp: Integer; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property IntProp : Integer Read FIntProp Write FIntProp; + end; + + // Simple integer, Default value. (set) + TIntegerComponent4 = Class(TComponent) + private + FIntProp: Integer; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property IntProp : Integer Read FIntProp Write FIntProp default 6; + end; + + // Simple integer, Default value. (not set) + TIntegerComponent5 = Class(TComponent) + private + FIntProp: Integer; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property IntProp : Integer Read FIntProp Write FIntProp default 6; + end; + + // Simple Int64 property fits in a single byte. + TInt64Component = Class(TComponent) + private + FIntProp: NativeInt; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Int64Prop : NativeInt Read FIntProp Write FIntProp; + end; + + // Simple Int64 property fits 2 bytes. + TInt64Component2 = Class(TComponent) + private + FIntProp: NativeInt; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Int64Prop : NativeInt Read FIntProp Write FIntProp; + end; + + // Simple Int64 property fits 3 bytes. + TInt64Component3 = Class(TComponent) + private + FIntProp: NativeInt; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Int64Prop : NativeInt Read FIntProp Write FIntProp; + end; + + // Simple Int64 property fits 4 bytes. + TInt64Component4 = Class(TComponent) + private + FIntProp: NativeInt; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Int64Prop : NativeInt Read FIntProp Write FIntProp; + end; + + // Int64 property with default, set. + TInt64Component5 = Class(TComponent) + private + FIntProp: NativeInt; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Int64Prop : NativeInt Read FIntProp Write FIntProp default 7; + end; + + // Int64 property with default, not set. + TInt64Component6 = Class(TComponent) + private + FIntProp: NativeInt; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Int64Prop : NativeInt Read FIntProp Write FIntProp default 7; + end; + + // String property. + TStringComponent = Class(TComponent) + private + F: String; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property StringProp : String Read F Write F; + end; + + // String property, empty + TStringComponent2 = Class(TComponent) + private + F: String; + Published + Property StringProp : String Read F Write F; + end; + + // String property, with quote. + + { TStringComponent3 } + + TStringComponent3 = Class(TComponent) + private + F: String; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property StringProp : String Read F Write F; + end; + + + // WideString property + TWideStringComponent = Class(TComponent) + private + F: WideString; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property WideStringProp : WideString Read F Write F; + end; + + // WideString property, empty + TWideStringComponent2 = Class(TComponent) + private + F: WideString; + Published + Property WideStringProp : WideString Read F Write F; + end; + + // Single property + TSingleComponent = Class(TComponent) + private + F: Single; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property SingleProp : Single Read F Write F; + end; + + // Double property + TDoubleComponent = Class(TComponent) + private + F: Double; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property DoubleProp : Double Read F Write F; + end; + + // Extended property + TExtendedComponent = Class(TComponent) + private + F: Extended; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property ExtendedProp : Extended Read F Write F; + end; + + (* + // Comp property + TCompComponent = Class(TComponent) + private + F: Comp; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property ExtendedProp : Comp Read F Write F; + end; + *) + + // Currency property + TCurrencyComponent = Class(TComponent) + private + F: Currency; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property CurrencyProp : Currency Read F Write F; + end; + + // DateTime property, date only + TDateTimeComponent = Class(TComponent) + private + F: TDateTime; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property DateTimeProp : TDateTime Read F Write F; + end; + + // DateTime property, time only + TDateTimeComponent2 = Class(TComponent) + private + F: TDateTime; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property DateTimeProp : TDateTime Read F Write F; + end; + + // DateTime property, Date and time + TDateTimeComponent3 = Class(TComponent) + private + F: TDateTime; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property DateTimeProp : TDateTime Read F Write F; + end; + + TDice = (one,two,three,four,five,six); + + // Enum property. No default (i.e. 0) + TEnumComponent = Class(TComponent) + private + F: TDice; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Dice : TDice Read F Write F; + end; + + // Enum property, not set + TEnumComponent2 = Class(TComponent) + private + F: TDice; + Published + Property Dice : TDice Read F Write F; + end; + + // Enum property with default, not set + TEnumComponent3 = Class(TComponent) + private + F: TDice; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Dice : TDice Read F Write F default two; + end; + + // Enum property with default, set + TEnumComponent4 = Class(TComponent) + private + F: TDice; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Dice : TDice Read F Write F default two; + end; + + // Enum property with default, no need to set + TEnumComponent5 = Class(TComponent) + private + F: TDice; + Published + Property Dice : TDice Read F Write F default one; + end; + + Throws = Set of TDice; + + // Set property, no default. + TSetComponent = Class(TComponent) + private + F: Throws; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Throw : Throws Read F Write F; + end; + + // Set property, no default, not set + TSetComponent2 = Class(TComponent) + private + F: Throws; + Published + Property Throw : Throws Read F Write F; + end; + + // Set property, default, not set + TSetComponent3 = Class(TComponent) + private + F: Throws; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Throw : Throws Read F Write F default [three,six]; + end; + + // Set property, default, set + TSetComponent4 = Class(TComponent) + private + F: Throws; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property Throw : Throws Read F Write F default [three,six]; + end; + + // Multiple components. + TMultipleComponent = Class(TComponent) + private + FCurrency: Currency; + FInt: Integer; + FString: String; + FDice: TDice; + F: Throws; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property IntProp : Integer Read FInt Write FInt; + Property StringProp : String Read FString Write FString; + Property CurrencyProp : Currency Read FCurrency Write FCurrency; + Property Dice : TDice Read FDice Write FDice; + Property Throw : Throws Read F Write F; + end; + + TTestPersistent1 = Class(TPersistent) + private + FInt: Integer; + FAstring: String; + Public + Procedure Assign(ASource : TPersistent); override; + Published + Property AInteger : Integer Read FInt Write FInt; + Property AString : String Read FAstring Write FAsTring; + end; + + // Persistent as a published property. + TPersistentComponent = Class(TComponent) + private + FPers: TTestPersistent1; + procedure SetPers(const Value: TTestPersistent1); + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Published + Property Persist : TTestPersistent1 Read FPers Write SetPers; + end; + + // For use in collection streaming + TTestItem = Class(TCollectionItem) + Private + F : String; + Published + Property StrProp : String Read F Write F; + end; + + // For use in collection streaming: items with two properties + + { TTest2Item } + + TTest2Item = Class(TCollectionItem) + Private + F1, F2 : String; + public + Published + Property StrProp1 : String Read F1 Write F1; + Property StrProp2 : String Read F2 Write F2; + end; + + + TTestCollection = Class(TCollection) + Public + Constructor Create; + end; + + // Empty collection + TCollectionComponent = Class(TComponent) + Private + FColl : TCollection; + Procedure SetColl(AColl : TCollection); + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Published + Property Coll : TCollection Read FColl Write SetCOll; + end; + + // collection with elements. + TCollectionComponent2 = Class(TCollectionComponent) + Public + Constructor Create(AOwner : TComponent); override; + end; + + // collection with elements, one has no props + TCollectionComponent3 = Class(TCollectionComponent) + Public + Constructor Create(AOwner : TComponent); override; + end; + + // collection with changed propname, one element + TCollectionComponent4 = Class(TComponent) + FColl : TTestCollection; + Procedure SetColl(AColl : TTestCollection); + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Published + Property Coll : TTestCollection Read FColl Write SetColl; + end; + + // collection two elements, items with two properties + TCollectionComponent5 = Class(TComponent) + FColl : TCollection; + Procedure SetColl(AColl : TCollection); + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Published + Property Coll : TCollection Read FColl Write SetColl; + end; + + // Component as published property + TOwnedComponent = Class(TComponent) + F : TComponent; + Public + Constructor Create(AOwner : TComponent); override; + Published + Property CompProp : TComponent Read F Write F; + end; + + // Use this if owned components should also be streamed. + TChildrenComponent = Class(TComponent) + // Owned components are children + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + end; + + // Stream sub component. + TStreamedOwnedComponent = Class(TChildrenComponent) + Public + Constructor Create(AOwner : TComponent); override; + Published + Sub : TIntegerComponent; + end; + + // Stream 2 sub components + TStreamedOwnedComponents = Class(TChildrenComponent) + Public + Constructor Create(AOwner : TComponent); override; + Published + SubA : TIntegerComponent; + SubB : TStringComponent; + end; + + // Method tests. + + THandler = Procedure of Object; + + // Method property that points to own method. + TMethodComponent = Class(TComponent) + Private + F : THandler; + Public + Constructor Create(AOwner : TComponent); override; + Published + Procedure MyMethod; + Property MethodProp : THandler Read F Write F; + end; + + // Method property of owned component that points to own method. + TMethodComponent2 = Class(TChildrenComponent) + Public + Constructor Create(AOwner : TComponent); override; + Published + Procedure MyMethod2; + end; + + { TMyItem } + + TMyItem = Class(TCollectionItem) + private + FNR: Integer; + FStr: String; + Public + Procedure Assign(Source : TPersistent); override; + Published + Property Nr : Integer Read FNR Write FNR; + Property Str: String Read FStr Write FStr; + end; + + { TMyColl } + + TMyColl = Class(TCollection) + private + function GetIt(index : Integer): TMyItem; + procedure SetIt(index : Integer; const AValue: TMyItem); + Public + Property It[index : Integer] : TMyItem Read GetIt Write SetIt; default; + end; + + { TCollComp } + + TCollComp = Class(TComponent) + private + FMyColl: TMyColl; + procedure SetMyColl(const AValue: TMyColl); + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Function ToStream : TStream; + Procedure FromStream(AStream : TStream); + Published + Property MyColl : TMyColl Read FMyColl Write SetMyColl; + end; + + +Implementation + +{ TStringComponent3 } + +constructor TStringComponent3.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + F:='A ''quoted'' string'; +end; + +procedure TChildrenComponent.GetChildren(Proc: TGetChildProc; Root: TComponent); + +Var + I : Integer; + +begin + if (Root=Nil) and (Root<>Nil) then exit;// Silence warning + For I:=0 to ComponentCount-1 do + Proc(Components[i]); +end; + + +{ TIntegerComponent } + +constructor TIntegerComponent.Create(AOwner: TComponent); +begin + inherited; + FIntProp:=3; +end; + + +{ TInt64Component } + +constructor TInt64Component.Create(AOwner: TComponent); +begin + inherited; + FIntProp:=4; +end; + +{ TInt64Component2 } + +constructor TInt64Component2.Create(AOwner: TComponent); +begin + inherited; + FIntProp:=2 shl 9; +end; + +{ TIntegerComponent2 } + +constructor TIntegerComponent2.Create(AOwner: TComponent); +begin + inherited; + FintProp:=2 shl 9; +end; + +{ TIntegerComponent3 } + +constructor TIntegerComponent3.Create(AOwner: TComponent); +begin + inherited; + FintProp:=2 shl 17; +end; + +{ TInt64Component3 } + +constructor TInt64Component3.Create(AOwner: TComponent); +begin + inherited; + FintProp:=2 shl 17; +end; + +{ TInt64Component4 } + +constructor TInt64Component4.Create(AOwner: TComponent); +begin + inherited; + FintProp:=NativeInt(MaxInt)+NativeInt(2 shl 14); +end; + +{ TStringComponent } + +constructor TStringComponent.Create(AOwner: TComponent); +begin + Inherited; + F:='A string'; +end; + +{ TWideStringComponent } + +constructor TWideStringComponent.Create(AOwner: TComponent); +begin + inherited; + F:='Some WideString'; +end; + +{ TSingleComponent } + +constructor TSingleComponent.Create(AOwner: TComponent); +begin + inherited; + F:=1.23; +end; + +{ TDoubleComponent } + +constructor TDoubleComponent.Create(AOwner: TComponent); +begin + inherited; + F:=2.34; +end; + +{ TExtendedComponent } + +constructor TExtendedComponent.Create(AOwner: TComponent); +begin + inherited; + F:=3.45; +end; + +{ TCompComponent } +(* +constructor TCompComponent.Create(AOwner: TComponent); +begin + inherited; + F:=4.56; +end; +*) + +{ TCurrencyComponent } + +constructor TCurrencyComponent.Create(AOwner: TComponent); +begin + inherited; + F:=5.67; +end; + +{ TDateTimeComponent } + +constructor TDateTimeComponent.Create(AOwner: TComponent); +begin + inherited; + F:=EncodeDate(1996,8,1); +end; + +{ TDateTimeComponent2 } + +constructor TDateTimeComponent2.Create(AOwner: TComponent); +begin + inherited; + F:=EncodeTime(23,20,0,0); +end; + +{ TDateTimeComponent3 } + +constructor TDateTimeComponent3.Create(AOwner: TComponent); +begin + inherited; + F:=EncodeDate(1996,8,1)+EncodeTime(23,20,0,0); +end; + +{ TEnumComponent } + +constructor TEnumComponent.Create(AOwner: TComponent); +begin + inherited; + F:=Four; +end; + +{ TSetComponent } + +constructor TSetComponent.Create(AOwner: TComponent); +begin + inherited; + F:=[two,five]; +end; + +{ TIntegerComponent4 } + +constructor TIntegerComponent4.Create(AOwner: TComponent); +begin + inherited; + FIntProp:=6; +end; + +{ TIntegerComponent5 } + +constructor TIntegerComponent5.Create(AOwner: TComponent); +begin + inherited; + FintProp:=5; +end; + +{ TInt64Component5 } + +constructor TInt64Component5.Create(AOwner: TComponent); +begin + inherited; + FIntProp:=7; +end; + +{ TInt64Component6 } + +constructor TInt64Component6.Create(AOwner: TComponent); +begin + inherited; + FintProp:=8; +end; + +{ TEnumComponent3 } + +constructor TEnumComponent3.Create(AOwner: TComponent); +begin + inherited; + F:=Three; +end; + +{ TEnumComponent4 } + +constructor TEnumComponent4.Create(AOwner: TComponent); +begin + inherited; + F:=Two; +end; + +{ TSetComponent4 } + +constructor TSetComponent4.Create(AOwner: TComponent); +begin + inherited; + F:=[Three,Six]; +end; + +{ TSetComponent3 } + +constructor TSetComponent3.Create(AOwner: TComponent); +begin + inherited; + F:=[One,Four]; +end; + +{ TMultipleComponent } + +constructor TMultipleComponent.Create(AOwner: TComponent); +begin + inherited; + FInt:=1; + FCurrency:=2.3; + FString:='A String'; + FDice:=two; + F:=[three,four]; +end; + +{ TTestPersistent1 } + +procedure TTestPersistent1.Assign(ASource: TPersistent); + +Var + T :TTestPersistent1; + +begin + If ASource is TTestPersistent1 then + begin + T:=ASource as TTestPersistent1; + FInt:=T.FInt; + FAString:=T.FAString; + end + else + inherited; +end; + +{ TPersistentComponent } + +constructor TPersistentComponent.Create(AOwner: TComponent); +begin + inherited; + FPers:=TTestPersistent1.Create; + FPers.AInteger:=3; + FPers.AString:='A persistent string'; +end; + +Destructor TPersistentComponent.Destroy; + +begin + FreeAndNil(FPers); + Inherited; +end; + +procedure TPersistentComponent.SetPers(const Value: TTestPersistent1); +begin + FPers.Assign(Value); +end; + +{ TCollectionComponent } + +Procedure TCollectionComponent.SetColl(AColl : TCollection); + +begin + FColl.Assign(AColl); +end; + +Constructor TCollectionComponent.Create(AOwner : TComponent); + +begin + Inherited; + FColl:=TCollection.Create(TTestItem); +end; + +Destructor TCollectionComponent.Destroy; + +begin + FreeAndNil(FColl); + Inherited; +end; + +{ TCollectionComponent2 } + +Constructor TCollectionComponent2.Create(AOwner : TComponent); + +begin + Inherited; + (FColl.Add as TTestItem).StrProp:='First'; + (FColl.Add as TTestItem).StrProp:='Second'; + (FColl.Add as TTestItem).StrProp:='Third'; +end; + +{ TCollectionComponen3 } + +Constructor TCollectionComponent3.Create(AOwner : TComponent); + +begin + Inherited; + (FColl.Add as TTestItem).StrProp:='First'; + (FColl.Add as TTestItem).StrProp:=''; + (FColl.Add as TTestItem).StrProp:='Third'; +end; + +{ TCollectionComponent4 } + +constructor TCollectionComponent4.Create(AOwner: TComponent); +begin + inherited; + FColl:=TTestCollection.Create; + (FColl.Add as TTestItem).StrProp:='Something' +end; + +destructor TCollectionComponent4.Destroy; +begin + FreeAndNil(FColl); + inherited; +end; + +procedure TCollectionComponent4.SetColl(AColl: TTestCollection); +begin + FColl.Assign(AColl); +end; + +{ TCollectionComponent5 } + +procedure TCollectionComponent5.SetColl(AColl: TCollection); +begin + FColl.Assign(AColl); +end; + +constructor TCollectionComponent5.Create(AOwner: TComponent); +var + Item : TTest2Item; +begin + inherited Create(AOwner); + FColl:=TCollection.Create(TTest2Item); + Item := FColl.Add as TTest2Item; + Item.StrProp1 := 'Something'; + Item.StrProp2 := 'Otherthing'; + Item := FColl.Add as TTest2Item; + Item.StrProp1 := 'Something 2'; + Item.StrProp2 := 'Otherthing 2'; +end; + +destructor TCollectionComponent5.Destroy; +begin + FreeAndNil(FColl); + inherited Destroy; +end; + +{ TTestCollection } + +Constructor TTestCollection.Create; +begin + Inherited Create(TTestitem); + PropName:='MyCollProp'; +end; + +{ TStreamedOwnedComponent } + +Constructor TStreamedOwnedComponent.Create(AOwner : TComponent); + +begin + Inherited; + Sub:=TIntegerComponent.Create(Self); + Sub.Name:='Sub'; +end; + +{ TStreamedOwnedComponents } + +constructor TStreamedOwnedComponents.Create(AOwner: TComponent); +begin + inherited; + SubA:=TIntegerComponent.Create(Self); + SubA.Name:='SubA'; + SubB:=TStringComponent.Create(Self); + SubB.Name:='SubB'; +end; + + +Constructor TOwnedComponent.Create(AOwner : TComponent); + +Var + C: TComponent; + +begin + Inherited; + C:=TIntegerComponent.Create(Self); + C.Name:='SubComponent'; + CompProp:=C; +end; + + +{ TMethodComponent } + +Constructor TMethodComponent.Create(AOwner : TComponent); + +begin + Inherited; + MethodProp:=@MyMethod; +end; + +Procedure TMethodComponent.MyMethod; + +begin + // Do nothing. +end; + +{ TMethodComponent2 } + +constructor TMethodComponent2.Create(AOwner: TComponent); + +Var + C : TMethodComponent; + +begin + inherited; + C:=TMethodComponent.Create(Self); + C.Name:='AComponent'; + C.MethodProp:=@MyMethod2; +end; + +Procedure TMethodComponent2.MyMethod2; + +begin + // Do nothng +end; + +{ TMyColl } + +function TMyColl.GetIt(index : Integer): TMyItem; +begin + Result:=Items[Index] as TMyItem; +end; + +procedure TMyColl.SetIt(index : Integer; const AValue: TMyItem); +begin + Items[Index]:=AValue; +end; + +{ TCollComp } + +procedure TCollComp.SetMyColl(const AValue: TMyColl); +begin + if (FMyColl=AValue) then + exit; + FMyColl.Assign(AValue); +end; + +constructor TCollComp.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FMyColl:=TMyCOll.Create(TMyItem); +end; + +destructor TCollComp.Destroy; +begin + FreeAndNil(FMyColl); + inherited Destroy; +end; + +function TCollComp.ToStream: TStream; +begin + Result:=TMemoryStream.Create; + Result.WriteComponent(Self); + Result.Position:=0; +end; + +procedure TCollComp.FromStream(AStream: TStream); +begin + AStream.ReadComponent(Self); + Astream.Free; +end; + +procedure TMyItem.Assign(Source: TPersistent); + +Var + I : TMyItem; + +begin + If (Source is TMyItem) then + begin + I:=Source as TMyItem; + FNR:=I.NR; + FStr:=I.Str; + end + else + inherited Assign(Source); +end; + +end. diff --git a/test/testrtl.lpi b/test/testrtl.lpi index e02bc56..72a61a1 100644 --- a/test/testrtl.lpi +++ b/test/testrtl.lpi @@ -76,7 +76,7 @@ - + diff --git a/test/testrtl.lpr b/test/testrtl.lpr index 2905cef..89c1604 100644 --- a/test/testrtl.lpr +++ b/test/testrtl.lpr @@ -25,7 +25,7 @@ program testrtl; {$mode objfpc} uses - browserconsole, consoletestrunner, frmrtlrun, + browserconsole, consoletestrunner, frmrtlrun, strutils, tcstream, tccompstreaming, simplelinkedlist, tcsyshelpers, tcstringhelp; var