{ This file is part of the Web Service Toolkit Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO This file is provide under modified LGPL licence ( the files COPYING.modifiedLGPL and COPYING.LGPL). 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. } {$INCLUDE wst_global.inc} unit testformatter_unit; interface uses Classes, SysUtils, {$IFDEF FPC} fpcunit, testutils, testregistry, {$ENDIF} {$IFNDEF FPC} TestFrameWork, ActiveX, {$ENDIF} TypInfo, test_suite_utils, base_service_intf, wst_types, server_service_intf, service_intf; const TEST_NAME_SPACE = 'uri:test-namespace'; type TTestEnum = ( teOne, teTwo, teThree, teFour ); TArrayOfStringRemotableSample = class(TArrayOfStringRemotable) end; { TClass_A } TClass_A = class(TBaseComplexRemotable) private FVal_32S: LongInt; FVal_Bool: Boolean; FVal_Date : TDateRemotable; FVal_DateTime: TDateTimeRemotable; FVal_Enum: TTestEnum; FVal_String: string; FVal_Time : TTimeRemotable; {$IFDEF WST_UNICODESTRING} FVal_UnicodeString: UnicodeString; {$ENDIF WST_UNICODESTRING} FVal_WideString: WideString; public constructor Create();override; procedure FreeObjectProperties();override; Published property Val_32S : LongInt Read FVal_32S Write FVal_32S; property Val_Enum : TTestEnum Read FVal_Enum Write FVal_Enum; property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; property Val_String : string Read FVal_String Write FVal_String; property Val_WideString : WideString Read FVal_WideString Write FVal_WideString; {$IFDEF WST_UNICODESTRING} property Val_UnicodeString : UnicodeString Read FVal_UnicodeString Write FVal_UnicodeString; {$ENDIF WST_UNICODESTRING} property Val_DateTime : TDateTimeRemotable read FVal_DateTime write FVal_DateTime; property Val_Date : TDateRemotable read FVal_Date write FVal_Date; property Val_Time : TTimeRemotable read FVal_Time write FVal_Time; End; TClass_A_Array = class(TBaseObjectArrayRemotable) private function GetItem(AIndex: Integer): TClass_A; public class function GetItemClass():TBaseRemotableClass;override; property Item[AIndex:Integer] : TClass_A Read GetItem;Default; end; TClass_A_Collection = class(TObjectCollectionRemotable) private function GetItem(AIndex: Integer): TClass_A; public class function GetItemClass():TBaseRemotableClass;override; function Add(): TClass_A; {$IFDEF USE_INLINE}inline;{$ENDIF} function AddAt(const APosition : Integer) : TClass_A; {$IFDEF USE_INLINE}inline;{$ENDIF} property Item[AIndex:Integer] : TClass_A Read GetItem;Default; end; { TClass_B } TClass_B = class(TBaseComplexRemotable) private FNonStored: Integer; FObjProp: TClass_A; FVal_32S: LongInt; FVal_Bool: Boolean; FVal_Enum: TTestEnum; FVal_String: string; {$IFDEF WST_UNICODESTRING} FVal_UnicodeString: UnicodeString; {$ENDIF WST_UNICODESTRING} FVal_WideString: WideString; private procedure SetObjProp(const AValue: TClass_A); Public constructor Create();override; procedure FreeObjectProperties();override; Published property Val_32S : LongInt Read FVal_32S Write FVal_32S; property Val_Enum : TTestEnum Read FVal_Enum Write FVal_Enum; property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; property Val_String : string Read FVal_String Write FVal_String; property Val_WideString : WideString Read FVal_WideString Write FVal_WideString; {$IFDEF WST_UNICODESTRING} property Val_UnicodeString : UnicodeString Read FVal_UnicodeString Write FVal_UnicodeString; {$ENDIF WST_UNICODESTRING} property ObjProp : TClass_A Read FObjProp Write SetObjProp stored True; property NonStored : Integer Read FNonStored Write FNonStored stored false; End; { TClass_Int } TClass_Int = class(TBaseComplexRemotable) private FVal_16S: SmallInt; FVal_16U: Word; FVal_32S: LongInt; FVal_32U: LongWord; FVal_64S: Int64; FVal_64U: QWord; FVal_8S: ShortInt; FVal_8U: Byte; Published property Val_8U : Byte Read FVal_8U Write FVal_8U; property Val_8S : ShortInt Read FVal_8S Write FVal_8S; property Val_16U : Word Read FVal_16U Write FVal_16U; property Val_16S : SmallInt Read FVal_16S Write FVal_16S; property Val_32U : LongWord Read FVal_32U Write FVal_32U; property Val_32S : LongInt Read FVal_32S Write FVal_32S; property Val_64U : QWord Read FVal_64U Write FVal_64U; property Val_64S : Int64 Read FVal_64S Write FVal_64S; End; T_ComplexInt64SContent = class(TComplexInt64SContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexInt64UContent = class(TComplexInt64UContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; { T_ComplexInt32SContent } T_ComplexInt32SContent = class(TComplexInt32SContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexInt32UContent = class(TComplexInt32UContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexInt16SContent = class(TComplexInt16SContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexInt16UContent = class(TComplexInt16UContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexInt8SContent = class(TComplexInt8SContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexInt8UContent = class(TComplexInt8UContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; { T_ComplexTestEnumContent } T_ComplexTestEnumContent = class(TComplexEnumContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; FValue : TTestEnum; protected class function GetEnumTypeInfo() : PTypeInfo;override; function GetValueAddress() : Pointer;override; public property Value : TTestEnum read FValue write FValue; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexFloatExtendedContent = class(TComplexFloatExtendedContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexFloatDoubleContent = class(TComplexFloatDoubleContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexStringContent = class(TComplexStringContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; T_ComplexWideStringContent = class(TComplexWideStringContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; {$IFDEF WST_UNICODESTRING} T_ComplexUnicodeStringContent = class(TComplexUnicodeStringContentRemotable) private FBoolSimpleAtt_Exemple: Boolean; FIntSimpleAtt_Exemple: Integer; FStrSimpleAtt_Exemple: string; published property StrSimpleAtt_Exemple : string read FStrSimpleAtt_Exemple write FStrSimpleAtt_Exemple; property IntSimpleAtt_Exemple : Integer read FIntSimpleAtt_Exemple write FIntSimpleAtt_Exemple; property BoolSimpleAtt_Exemple : Boolean read FBoolSimpleAtt_Exemple write FBoolSimpleAtt_Exemple; end; {$ENDIF WST_UNICODESTRING} { TClass_CplxSimpleContent } TClass_CplxSimpleContent = class(TBaseComplexRemotable) private FElt_Exemple: string; FVal_CplxDouble: T_ComplexFloatDoubleContent; FVal_CplxEnum : T_ComplexTestEnumContent; FVal_CplxInt16S: T_ComplexInt16SContent; FVal_CplxInt16U: T_ComplexInt16UContent; FVal_CplxInt32S: T_ComplexInt32SContent; FVal_CplxInt32U: T_ComplexInt32UContent; FVal_CplxExtended : T_ComplexFloatExtendedContent; FVal_CplxInt64S: T_ComplexInt64SContent; FVal_CplxInt64U: T_ComplexInt64UContent; FVal_CplxInt8S: T_ComplexInt8SContent; FVal_CplxInt8U: T_ComplexInt8UContent; FVal_CplxString: T_ComplexStringContent; {$IFDEF WST_UNICODESTRING} FVal_CplxUnicodeString: T_ComplexUnicodeStringContent; {$ENDIF WST_UNICODESTRING} FVal_CplxWideString: T_ComplexWideStringContent; public constructor Create();override; procedure FreeObjectProperties();override; published property Val_CplxInt64S : T_ComplexInt64SContent read FVal_CplxInt64S write FVal_CplxInt64S; property Val_CplxInt64U : T_ComplexInt64UContent read FVal_CplxInt64U write FVal_CplxInt64U; property Val_CplxInt32S : T_ComplexInt32SContent read FVal_CplxInt32S write FVal_CplxInt32S; property Val_CplxInt32U : T_ComplexInt32UContent read FVal_CplxInt32U write FVal_CplxInt32U; property Val_CplxInt16U : T_ComplexInt16UContent read FVal_CplxInt16U write FVal_CplxInt16U; property Val_CplxInt16S : T_ComplexInt16SContent read FVal_CplxInt16S write FVal_CplxInt16S; property Val_CplxInt8U : T_ComplexInt8UContent read FVal_CplxInt8U write FVal_CplxInt8U; property Val_CplxInt8S : T_ComplexInt8SContent read FVal_CplxInt8S write FVal_CplxInt8S; property Val_CplxEnum : T_ComplexTestEnumContent read FVal_CplxEnum write FVal_CplxEnum; property Val_CplxExtended : T_ComplexFloatExtendedContent read FVal_CplxExtended write FVal_CplxExtended; property Val_CplxDouble : T_ComplexFloatDoubleContent read FVal_CplxDouble write FVal_CplxDouble; property Val_CplxString : T_ComplexStringContent read FVal_CplxString write FVal_CplxString; property Val_CplxWideString : T_ComplexWideStringContent read FVal_CplxWideString write FVal_CplxWideString; {$IFDEF WST_UNICODESTRING} property Val_CplxUnicodeString : T_ComplexUnicodeStringContent read FVal_CplxUnicodeString write FVal_CplxUnicodeString; {$ENDIF WST_UNICODESTRING} property Elt_Exemple : string read FElt_Exemple write FElt_Exemple; end; { TClass_Enum } TClass_Enum = class(TBaseComplexRemotable) private FVal_Bool: Boolean; FVal_Enum: TTestEnum; FVal_String: string; Published property Val_Enum : TTestEnum Read FVal_Enum Write FVal_Enum; property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; property Val_String : string Read FVal_String Write FVal_String; End; { TClass_Float } TClass_Float = class(TBaseComplexRemotable) private FVal_Currency: Currency; FVal_Double: Double; FVal_Extended: Extended; FVal_Single: Single; Published property Val_Single : Single Read FVal_Single Write FVal_Single; property Val_Double : Double Read FVal_Double Write FVal_Double; property Val_Extended : Extended Read FVal_Extended Write FVal_Extended; property Val_Currency : Currency Read FVal_Currency Write FVal_Currency; End; TEmbeddedArrayOfStringRemotable = class(TArrayOfStringRemotable); TTestSmallRecord = record fieldSmallint : Smallint; fieldWord : Word; fieldString : string; end; TTestRecord = record fieldByte : Byte; fieldShortInt : ShortInt; fieldSmallint : Smallint; fieldWord : Word; fieldInteger : Integer; fieldLongWord : LongWord; fieldInt64 : Int64; fieldQWord : QWord; fieldComp : Comp; fieldSingle : Single; fieldDouble : Double; fieldExtended : Extended; fieldCurrency : Currency; fieldBoolean : Boolean; fieldString : string; fieldRecord : TTestSmallRecord; end; { TTestSmallClass } TTestSmallClass = class(TBaseComplexRemotable) private FfieldSmallint : Smallint; FfieldString : string; FfieldWord : Word; published property fieldSmallint : Smallint read FfieldSmallint write FfieldSmallint; property fieldWord : Word read FfieldWord write FfieldWord; property fieldString : string read FfieldString write FfieldString; end; { TTestSmallClass2 } TTestSmallClass2 = class(TBaseComplexRemotable) private FfieldString : string; FObjProperty : TTestSmallClass; published property fieldString : string read FfieldString write FfieldString; property ObjProperty : TTestSmallClass read FObjProperty write FObjProperty; end; { TClassWithPropExtName } TClassWithPropExtName = class(TBaseComplexRemotable) private FPropWithExtName: Integer; FStrProp: string; published property StrProp : string read FStrProp write FStrProp; property PropWithExtName : Integer read FPropWithExtName write FPropWithExtName; end; { TTestFormatterSimpleType } TTestFormatterSimpleType= class(TWstBaseTest) protected function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;virtual;abstract; function Support_ComplextType_with_SimpleContent():Boolean;virtual; function Support_nil():Boolean;virtual; class function SupportInt64() : Boolean;virtual; class function SupportUInt64() : Boolean;virtual; published procedure Test_AnsiChar; procedure Test_AnsiChar_ScopeData; procedure Test_WideChar; procedure Test_WideChar_ScopeData; {$IFDEF WST_UNICODESTRING} procedure Test_UnicodeChar; procedure Test_UnicodeChar_ScopeData; {$ENDIF WST_UNICODESTRING} procedure Test_Int_8; procedure Test_Int_8_ScopeData; procedure Test_Int_16; procedure Test_Int_16_ScopeData; procedure Test_Int_32; procedure Test_Int_32_ScopeData; procedure Test_Int_64; procedure Test_Int_64_ScopeData; procedure Test_Single_4; procedure Test_Single_4_ScopeData; procedure Test_Double_8; procedure Test_Double_8_ScopeData; procedure Test_Currency_8; procedure Test_Currency_8_ScopeData; procedure Test_Extended_10; procedure Test_Extended_10_ScopeData; procedure Test_AnsiString; procedure Test_AnsiString_ScopeData; {$IFDEF WST_UNICODESTRING} procedure Test_UnicodeString; {$ENDIF WST_UNICODESTRING} procedure Test_WideString; procedure Test_WideString_ScopeData; procedure Test_Bool; procedure Test_Bool_ScopeData; procedure Test_Enum; procedure Test_Enum_ScopeData; end; { TTestFormatter } TTestFormatter = class(TTestFormatterSimpleType) protected class function GetFormaterName() : string;virtual;abstract; class function SupportNamedArrayItem() : Boolean;virtual; published procedure Test_Int_WithClass; procedure Test_Float_WithClass; procedure Test_Enum_Bool_String_WithClass; procedure Test_CplxInt64SimpleContent_WithClass; procedure Test_CplxInt32SimpleContent_WithClass; procedure Test_CplxInt16SimpleContent_WithClass; procedure Test_CplxInt8SimpleContent_WithClass; procedure Test_CplxEnumSimpleContent_WithClass; procedure Test_CplxFloatExtendedSimpleContent_WithClass; procedure Test_CplxStringSimpleContent_WithClass; procedure Test_CplxWideStringSimpleContent_WithClass; {$IFDEF WST_UNICODESTRING} procedure Test_CplxUnicodeStringSimpleContent_WithClass; {$ENDIF WST_UNICODESTRING} procedure Test_Object(); procedure Test_Object_Nil(); procedure Test_Object_ExternalPropertyName(); procedure Test_StringArray(); procedure Test_StringArray_Embedded(); procedure Test_StringArrayZeroLength(); procedure Test_StringArrayZeroLength_serializeOption(); procedure Test_BooleanArray(); procedure Test_Int8UArray(); procedure Test_Int8SArray(); procedure Test_Int16SArray(); procedure Test_Int16UArray(); procedure Test_Int32UArray(); procedure Test_Int32SArray(); procedure Test_Int64SArray(); procedure Test_Int64UArray(); procedure Test_FloatSingleArray(); procedure Test_FloatDoubleArray(); procedure Test_FloatExtendedArray(); procedure Test_FloatCurrencyArray(); procedure Test_ObjectArray(); procedure Test_ObjectArray_ReadEmptyArray(); procedure Test_ObjectArrayZeroLength_serializeOption(); procedure Test_ObjectCollection(); procedure Test_ObjectCollectionZeroLength_serializeOption(); procedure Test_ObjectCollection_ReadEmptyCollection(); procedure Test_SimpleTypeArray_ReadEmptyArray(); procedure Test_ComplexInt32S(); procedure Test_Record_simple(); procedure Test_Record_nested(); procedure test_Date_ReadNil(); procedure test_Duration_ReadNil(); procedure test_Time_ReadNil(); procedure test_GetScopeItemNames(); procedure test_GetFormaterName(); end; { TTestBinaryFormatter } TTestBinaryFormatter= class(TTestFormatter) protected class function GetFormaterName() : string;override; function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; published procedure test_WriteBuffer(); end; { TTestBinaryFormatterAttributes } TTestBinaryFormatterAttributes= class(TTestFormatterSimpleType) protected function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; end; { TTestSOAPFormatter } TTestSOAPFormatter= class(TTestFormatter) protected class function GetFormaterName() : string;override; class function SupportNamedArrayItem() : Boolean;override; function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; procedure do_test_Object(const AProps, AFileName : string); published procedure test_WriteBuffer(); procedure test_ReadBuffer(); procedure test_Object_DocumentLiteral(); procedure test_Object_DocumentEncoded(); procedure test_Object_RPCLiteral(); procedure test_Object_RPCEncoded(); end; { TTestSOAPFormatterAttributes } TTestSOAPFormatterAttributes = class(TTestFormatterSimpleType) protected function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; end; { TTestXmlRpcFormatterAttributes } TTestXmlRpcFormatterAttributes = class(TTestFormatterSimpleType) protected function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; end; TTestXmlRpcFormatter= class(TTestFormatter) protected class function GetFormaterName() : string;override; function CreateFormatter(ARootType : PTypeInfo):IFormatterBase;override; function Support_ComplextType_with_SimpleContent():Boolean;override; function Support_nil():Boolean;override; published procedure test_WriteBuffer(); procedure test_default_data_type(); end; { TTestArray } TTestArray= class(TWstBaseTest) published procedure Test_StringArray(); procedure Test_BooleanArray(); procedure Test_Int8UArray(); procedure Test_Int8SArray(); procedure Test_Int16SArray(); procedure Test_Int16UArray(); procedure Test_Int32UArray(); procedure Test_Int32SArray(); procedure Test_Int64SArray(); procedure Test_Int64UArray(); procedure Test_FloatSingleArray(); procedure Test_FloatDoubleArray(); procedure Test_FloatExtendedArray(); procedure Test_FloatCurrencyArray(); end; { TTest_TBaseComplexRemotable } TTest_TBaseComplexRemotable= class(TTestCase) published procedure Test_Assign(); end; { TTest_SoapFormatterExceptionBlock } TTest_SoapFormatterExceptionBlock = class(TTestCase) protected procedure SetUp(); override; procedure TearDown(); override; function CreateFormatter():IFormatterResponse; function CreateFormatterClient():IFormatterClient; published procedure ExceptBlock_server(); procedure ExceptBlock_client(); procedure client_keep_style(); end; { TTest_XmlRpcFormatterExceptionBlock } TTest_XmlRpcFormatterExceptionBlock = class(TTestCase) protected procedure SetUp(); override; procedure TearDown(); override; function CreateFormatter():IFormatterResponse; function CreateFormatterClient():IFormatterClient; published procedure ExceptBlock_server(); procedure ExceptBlock_client(); end; { TTest_BinaryFormatterExceptionBlock } TTest_BinaryFormatterExceptionBlock = class(TTestCase) protected function CreateFormatter():IFormatterResponse; function CreateFormatterClient():IFormatterClient; published procedure ExceptBlock_server(); procedure ExceptBlock_client(); end; { TTest_TStringBufferRemotable } TTest_TStringBufferRemotable = class(TTestCase) published procedure Assign(); end; implementation uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_rtti, Math, imp_utils {$IFNDEF FPC} , xmldom, wst_delphi_xml {$ENDIF} {$IFDEF FPC} , DOM, XMLRead, wst_fpc_xml {$ENDIF} , server_service_soap, soap_formatter, server_service_xmlrpc, xmlrpc_formatter, binary_streamer, server_binary_formatter, binary_formatter; function CompareNodes(const A,B : PDataBuffer) : Boolean;overload;forward; function CompareObjectBuffers(const A,B : PObjectBuffer) : Boolean;overload; var ca, cb : PObjectBufferItem; ok : Boolean; begin if ( A = nil ) and ( B = nil ) then begin Result := True end else if ( A <> nil ) and ( B <> nil ) then begin Result := False; if ( A^.NilObject = B^.NilObject ) and ( A^.Count = B^.Count ) and ( CompareNodes(A^.InnerData,B^.InnerData) ) then begin if ( A^.Count > 0 ) then begin ca := A^.Head; cb := B^.Head; while Assigned(ca) do begin if not CompareNodes(ca^.Data,cb^.Data) then Break; ca := ca^.Next; cb := cb^.Next; end; ok := ( ca = nil ); end else begin ok := True; end; end else begin ok := False; end; if ok then Result := CompareObjectBuffers(A^.Attributes,B^.Attributes); end else begin Result := False; end; end; function CompareObjectBuffers(const A,B : PArrayBuffer) : Boolean;overload; var i : Integer; ok : Boolean; begin if ( A = nil ) and ( B = nil ) then begin ok := True end else if ( A <> nil ) and ( B <> nil ) then begin if ( A^.Count = B^.Count ) then begin ok := True; if ( A^.Count > 0 ) then begin for i := 0 to Pred(A^.Count) do begin if not CompareNodes(A^.Items^[i],B^.Items^[i]) then begin ok := False; Break; end; end; end; if ok then ok := CompareObjectBuffers(A^.Attributes,B^.Attributes); end else begin ok := False; end; end else begin ok := False; end; Result := ok; end; function CompareNodes(const A,B : PDataBuffer) : Boolean;overload; var ok : Boolean; begin if ( A = nil ) and ( B = nil ) then begin ok := True; end else if ( A <> nil ) and ( B <> nil ) then begin ok := False; if ( A^.DataType = B^.DataType ) and ( A^.Name = B^.Name ) then begin case A^.DataType of dtInt8U,dtInt8S : ok := ( A^.Int8U = A^.Int8U ); dtInt16U,dtInt16S : ok := ( A^.Int16U = A^.Int16U ); dtInt32U,dtInt32S : ok := ( A^.Int32U = A^.Int32U ); dtInt64U,dtInt64S : ok := ( A^.Int64U = A^.Int64U ); dtBool : ok := ( A^.BoolData = A^.BoolData ); dtEnum : ok := ( A^.EnumData = A^.EnumData ); dtSingle : ok := ( A^.SingleData = A^.SingleData ); dtDouble : ok := ( A^.DoubleData = A^.DoubleData ); dtExtended : ok := ( A^.ExtendedData = A^.ExtendedData ); dtCurrency : ok := ( A^.CurrencyData = A^.CurrencyData ); dtAnsiString : ok := ( A^.AnsiStrData = A^.AnsiStrData ); dtObject : ok := CompareObjectBuffers(A^.ObjectData,B^.ObjectData); dtArray : ok := CompareObjectBuffers(A^.ArrayData,B^.ArrayData); end; end; end else begin ok := False; end; Result := ok; end; function RandomValue(const AMaxlen: Integer): ansistring; var k : Integer; begin SetLength(Result,AMaxlen); for k := 1 to AMaxlen do begin Result[k] := AnsiChar((Random(Ord(High(AnsiChar))))); end; end; { T_ComplexTestEnumContent } class function T_ComplexTestEnumContent.GetEnumTypeInfo() : PTypeInfo; begin Result := TypeInfo(TTestEnum); end; function T_ComplexTestEnumContent.GetValueAddress() : Pointer; begin Result := @FValue; end; function TTestFormatterSimpleType.Support_ComplextType_with_SimpleContent( ): Boolean; begin Result := True; end; function TTestFormatterSimpleType.Support_nil(): Boolean; begin Result := True; end; class function TTestFormatterSimpleType.SupportInt64(): Boolean; begin Result := True; end; class function TTestFormatterSimpleType.SupportUInt64(): Boolean; begin Result := True; end; procedure TTestFormatterSimpleType.Test_AnsiChar; const VAL_1 : AnsiChar = 'O'; VAL_2 : AnsiChar = 'i'; Var f : IFormatterBase; s : TMemoryStream; x : string; xVal_1, xVal_2 : AnsiChar; begin s := Nil; Try xVal_1 := VAL_1; xVal_2 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('xVal_1',TypeInfo(AnsiChar),xVal_1); f.Put('xVal_2',TypeInfo(AnsiChar),xVal_2); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); xVal_1 := #0; xVal_2 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'xVal_1'; f.Get(TypeInfo(AnsiChar),x,xVal_1); x := 'xVal_2'; f.Get(TypeInfo(AnsiChar),x,xVal_2); f.EndScopeRead(); CheckEquals(String(VAL_1),String(xVal_1)); CheckEquals(String(VAL_2),String(xVal_2)); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_AnsiChar_ScopeData; const VAL_1 : AnsiChar = 'O'; VAL_2 : AnsiChar = 'i'; var f : IFormatterBase; s : TMemoryStream; x : string; xVal_1 : AnsiChar; begin s := Nil; try xVal_1 := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(AnsiChar),xVal_1); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); xVal_1 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(AnsiChar),xVal_1); f.EndScopeRead(); CheckEquals(String(VAL_1),String(xVal_1)); xVal_1 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(AnsiChar),xVal_1); f.EndScope(); s.Clear(); f.SaveToStream(s); xVal_1 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(AnsiChar),xVal_1); f.EndScopeRead(); CheckEquals(String(VAL_2),String(xVal_1)); finally s.Free(); end; end; procedure TTestFormatterSimpleType.Test_WideChar; const VAL_1 : WideChar = WideChar(300); VAL_2 : WideChar = WideChar(400); Var f : IFormatterBase; s : TMemoryStream; x : string; xVal_1, xVal_2 : WideChar; begin s := Nil; Try xVal_1 := VAL_1; xVal_2 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('xVal_1',TypeInfo(WideChar),xVal_1); f.Put('xVal_2',TypeInfo(WideChar),xVal_2); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); xVal_1 := #0; xVal_2 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'xVal_1'; f.Get(TypeInfo(WideChar),x,xVal_1); x := 'xVal_2'; f.Get(TypeInfo(WideChar),x,xVal_2); f.EndScopeRead(); CheckEquals(VAL_1,xVal_1); CheckEquals(VAL_2,xVal_2); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_WideChar_ScopeData; const VAL_1 : WideChar = WideChar(300); VAL_2 : WideChar = WideChar(400); var f : IFormatterBase; s : TMemoryStream; x : string; xVal_1 : WideChar; begin s := Nil; try xVal_1 := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(WideChar),xVal_1); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); xVal_1 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(WideChar),xVal_1); f.EndScopeRead(); CheckEquals(VAL_1,xVal_1); xVal_1 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(WideChar),xVal_1); f.EndScope(); s.Clear(); f.SaveToStream(s); xVal_1 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(WideChar),xVal_1); f.EndScopeRead(); CheckEquals(VAL_2,xVal_1); finally s.Free(); end; end; {$IFDEF WST_UNICODESTRING} procedure TTestFormatterSimpleType.Test_UnicodeChar; const VAL_1 : UnicodeChar = UnicodeChar(300); VAL_2 : UnicodeChar = UnicodeChar(400); Var f : IFormatterBase; s : TMemoryStream; x : string; xVal_1, xVal_2 : UnicodeChar; begin s := Nil; Try xVal_1 := VAL_1; xVal_2 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('xVal_1',TypeInfo(UnicodeChar),xVal_1); f.Put('xVal_2',TypeInfo(UnicodeChar),xVal_2); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); xVal_1 := #0; xVal_2 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'xVal_1'; f.Get(TypeInfo(UnicodeChar),x,xVal_1); x := 'xVal_2'; f.Get(TypeInfo(UnicodeChar),x,xVal_2); f.EndScopeRead(); CheckEquals(VAL_1,xVal_1); CheckEquals(VAL_2,xVal_2); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_UnicodeChar_ScopeData; const VAL_1 : UnicodeChar = UnicodeChar(300); VAL_2 : UnicodeChar = UnicodeChar(400); var f : IFormatterBase; s : TMemoryStream; x : string; xVal_1 : UnicodeChar; begin s := Nil; try xVal_1 := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(UnicodeChar),xVal_1); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); xVal_1 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(UnicodeChar),xVal_1); f.EndScopeRead(); CheckEquals(VAL_1,xVal_1); xVal_1 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(UnicodeChar),xVal_1); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); xVal_1 := #0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(UnicodeChar),xVal_1); f.EndScopeRead(); CheckEquals(VAL_2,xVal_1); finally s.Free(); end; end; {$ENDIF WST_UNICODESTRING} procedure TTestFormatterSimpleType.Test_Int_8; const VAL_1 = 12; VAL_2 = -10; Var f : IFormatterBase; s : TMemoryStream; x : string; intVal_U : Byte; intVal_S : ShortInt; begin s := Nil; Try intVal_U := VAL_1; intVal_S := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('intVal_U',TypeInfo(Byte),intVal_U); f.Put('intVal_S',TypeInfo(ShortInt),intVal_S); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_U := 0; intVal_S := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_U'; f.Get(TypeInfo(Byte),x,intVal_U); x := 'intVal_S'; f.Get(TypeInfo(ShortInt),x,intVal_S); f.EndScopeRead(); CheckEquals(VAL_1,intVal_U); CheckEquals(VAL_2,intVal_S); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Int_8_ScopeData; const VAL_1 = 12; VAL_2 = -10; var f : IFormatterBase; s : TMemoryStream; x : string; intVal_U : Byte; intVal_S : ShortInt; begin s := Nil; Try intVal_U := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(Byte),intVal_U); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_U := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(Byte),intVal_U); f.EndScopeRead(); CheckEquals(VAL_1,intVal_U); /// intVal_S := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(ShortInt),intVal_S); f.EndScope(); s.Clear(); f.SaveToStream(s); intVal_S := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(ShortInt),intVal_S); f.EndScopeRead(); CheckEquals(VAL_2,intVal_S); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Int_16; const VAL_1 = 1210; VAL_2 : SmallInt = -1012; Var f : IFormatterBase; s : TMemoryStream; x : string; intVal_U : Word; intVal_S : SmallInt; begin s := Nil; Try intVal_U := VAL_1; intVal_S := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('intVal_U',TypeInfo(Word),intVal_U); f.Put('intVal_S',TypeInfo(SmallInt),intVal_S); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_U := 0; intVal_S := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_U'; f.Get(TypeInfo(Word),x,intVal_U); x := 'intVal_S'; f.Get(TypeInfo(SmallInt),x,intVal_S); f.EndScopeRead(); CheckEquals(VAL_1,intVal_U); CheckEquals(VAL_2,intVal_S); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Int_16_ScopeData; const VAL_1 = 1210; VAL_2 : SmallInt = -1012; Var f : IFormatterBase; s : TMemoryStream; x : string; intVal_U : WOrd; intVal_S : SmallInt; begin s := Nil; Try intVal_U := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(Word),intVal_U); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_U := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(Word),intVal_U); f.EndScopeRead(); CheckEquals(VAL_1,intVal_U); /// intVal_S := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(SmallInt),intVal_S); f.EndScope(); s.Clear(); f.SaveToStream(s); intVal_S := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(SmallInt),intVal_S); f.EndScopeRead(); CheckEquals(VAL_2,intVal_S); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Int_32; const VAL_1 = 3294967295; VAL_2 : LongInt = -101276; Var f : IFormatterBase; s : TMemoryStream; x : string; intVal_U : LongWord; intVal_S : LongInt; begin s := Nil; Try intVal_U := VAL_1; intVal_S := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('intVal_U',TypeInfo(LongWord),intVal_U); f.Put('intVal_S',TypeInfo(LongInt),intVal_S); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_U := 0; intVal_S := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_U'; f.Get(TypeInfo(LongWord),x,intVal_U); x := 'intVal_S'; f.Get(TypeInfo(LongInt),x,intVal_S); f.EndScopeRead(); Check( ( VAL_1 = intVal_U ) ); CheckEquals(VAL_2,intVal_S); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Int_32_ScopeData; const VAL_1 = 3294967295; VAL_2 : LongInt = -101276; var f : IFormatterBase; s : TMemoryStream; x : string; intVal_U : LongWord; intVal_S : LongInt; begin s := Nil; Try intVal_U := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(LongWord),intVal_U); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_U := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(LongWord),intVal_U); f.EndScopeRead(); CheckEquals(VAL_1,intVal_U); /// intVal_S := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(LongInt),intVal_S); f.EndScope(); s.Clear(); f.SaveToStream(s); intVal_S := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(LongInt),intVal_S); f.EndScopeRead(); CheckEquals(VAL_2,intVal_S); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Int_64; const VAL_1 = High(QWord) -1000; VAL_2 : Int64 = -$FFFFFFFFF0; VAL_32_1 = High(DWord) -1000; VAL_32_2 : Int64 = -$FFFFFF0; Var f : IFormatterBase; s : TMemoryStream; x : string; intVal_U : QWord; intVal_S : Int64; begin s := Nil; Try if SupportInt64() then intVal_S := VAL_2 else intVal_S := VAL_32_2; if SupportUInt64() then intVal_U := VAL_1 else intVal_U := VAL_32_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('intVal_U',TypeInfo(QWord),intVal_U); f.Put('intVal_S',TypeInfo(Int64),intVal_S); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_U := 0; intVal_S := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_U'; f.Get(TypeInfo(QWord),x,intVal_U); x := 'intVal_S'; f.Get(TypeInfo(Int64),x,intVal_S); f.EndScopeRead(); if SupportInt64() then CheckEquals(VAL_2,intVal_S) else CheckEquals(VAL_32_2,intVal_S); if SupportUInt64() then CheckEquals(QWord(VAL_1),intVal_U) else CheckEquals(QWord(VAL_32_1),intVal_U); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Int_64_ScopeData; const VAL_1 = High(QWord) -1000; VAL_2 : Int64 = -$FFFFFFFFF0; VAL_32_1 = High(DWord) -1000; VAL_32_2 : Int64 = -$FFFFFF0; var f : IFormatterBase; s : TMemoryStream; x : string; intVal_U : QWord; intVal_S : Int64; begin s := Nil; Try if SupportUInt64() then intVal_U := VAL_1 else intVal_U := VAL_32_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(QWord),intVal_U); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_U := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(QWord),intVal_U); f.EndScopeRead(); if SupportUInt64() then CheckEquals(VAL_1,intVal_U) else CheckEquals(VAL_32_1,intVal_U); /// if SupportInt64() then intVal_S := VAL_2 else intVal_S := VAL_32_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(Int64),intVal_S); f.EndScope(); s.Clear(); f.SaveToStream(s); intVal_S := 0; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(Int64),intVal_S); f.EndScopeRead(); if SupportInt64() then CheckEquals(VAL_2,intVal_S) else CheckEquals(VAL_32_2,intVal_S); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Single_4; const VAL_1 : single = 12.10; var f : IFormatterBase; s : TMemoryStream; x : string; tmpVal : Single; begin s := Nil; Try tmpVal := VAL_1; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.Put('tmpVal',TypeInfo(Single),tmpVal); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); tmpVal := 0; f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.Get(TypeInfo(Single),x,tmpVal); f.EndScopeRead(); CheckEquals(VAL_1,tmpVal);//,0.00001); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Single_4_ScopeData; const VAL_1 : single = 12.10; var f : IFormatterBase; s : TMemoryStream; x : string; tmpVal : Single; begin s := Nil; Try tmpVal := VAL_1; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.PutScopeInnerValue(TypeInfo(Single),tmpVal); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); tmpVal := 0; f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.GetScopeInnerValue(TypeInfo(Single),tmpVal); f.EndScopeRead(); CheckEquals(VAL_1,tmpVal);//,0.00001); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Double_8; const VAL_1 : Double = 12.10; Var f : IFormatterBase; s : TMemoryStream; x : string; tmpVal : Double; begin s := Nil; Try tmpVal := VAL_1; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.Put('tmpVal',TypeInfo(Double),tmpVal); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); tmpVal := 0; f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.Get(TypeInfo(Double),x,tmpVal); f.EndScopeRead(); CheckEquals(VAL_1,tmpVal); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Double_8_ScopeData; const VAL_1 : Double = 12.10; Var f : IFormatterBase; s : TMemoryStream; x : string; tmpVal : Double; begin s := Nil; Try tmpVal := VAL_1; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.PutScopeInnerValue(TypeInfo(Double),tmpVal); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); tmpVal := 0; f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.GetScopeInnerValue(TypeInfo(Double),tmpVal); f.EndScopeRead(); CheckEquals(VAL_1,tmpVal); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Currency_8; const VAL_1 : Currency = 12.10; Var f : IFormatterBase; s : TMemoryStream; x : string; tmpVal : Currency; begin s := Nil; Try tmpVal := VAL_1; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.Put('tmpVal',TypeInfo(Currency),tmpVal); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); tmpVal := 0; f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.Get(TypeInfo(Currency),x,tmpVal); f.EndScopeRead(); CheckEquals(VAL_1,tmpVal); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Currency_8_ScopeData; const VAL_1 : Currency = 12.10; Var f : IFormatterBase; s : TMemoryStream; x : string; tmpVal : Currency; begin s := Nil; Try tmpVal := VAL_1; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.PutScopeInnerValue(TypeInfo(Currency),tmpVal); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); tmpVal := 0; f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.GetScopeInnerValue(TypeInfo(Currency),tmpVal); f.EndScopeRead(); CheckEquals(VAL_1,tmpVal); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Extended_10; const VAL_1 : Extended = 12.10; Var f : IFormatterBase; s : TMemoryStream; x : string; tmpVal : Extended; begin s := Nil; Try tmpVal := VAL_1; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.Put('tmpVal',TypeInfo(Extended),tmpVal); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); tmpVal := 0; f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.Get(TypeInfo(Extended),x,tmpVal); f.EndScopeRead(); CheckEquals(VAL_1,tmpVal); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Extended_10_ScopeData; const VAL_1 : Extended = 12.10; Var f : IFormatterBase; s : TMemoryStream; x : string; tmpVal : Extended; begin s := Nil; Try tmpVal := VAL_1; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.PutScopeInnerValue(TypeInfo(Extended),tmpVal); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); tmpVal := 0; f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'tmpVal'; f.GetScopeInnerValue(TypeInfo(Extended),tmpVal); f.EndScopeRead(); CheckEquals(VAL_1,tmpVal); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_AnsiString; const VAL_1 : AnsiString = 'AzErTy'; VAL_2 = 'QwErTy'; Var f : IFormatterBase; s : TMemoryStream; x : string; locVal_1 : ansistring; locVal_3 : ansistring; begin s := Nil; Try locVal_1 := VAL_1; locVal_3 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('intVal_1',TypeInfo(ansistring),locVal_1); f.Put('intVal_3',TypeInfo(ansistring),locVal_3); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); locVal_1 := ''; locVal_3 := 'yyyyyyyy'; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_1'; f.Get(TypeInfo(ansistring),x,locVal_1); x := 'intVal_3'; f.Get(TypeInfo(ansistring),x,locVal_3); f.EndScopeRead(); CheckEquals(VAL_1,locVal_1); CheckEquals(VAL_2,locVal_3); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_AnsiString_ScopeData; const VAL_1 = 'AzErTy1234'; Var f : IFormatterBase; s : TMemoryStream; x : string; locVal_1 : ansistring; begin s := Nil; Try locVal_1 := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(ansistring),locVal_1); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); locVal_1 := ''; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(ansistring),locVal_1); f.EndScopeRead(); CheckEquals(VAL_1,locVal_1); Finally s.Free(); End; end; {$IFDEF WST_UNICODESTRING} procedure TTestFormatterSimpleType.Test_UnicodeString; //var VAL_1 : UnicodeString = 'AzErTy123'; VAL_2 : UnicodeString = 'QwErTy85'; Var f : IFormatterBase; s : TMemoryStream; x : string; VAL_1, VAL_2 : UnicodeString; locVal_1 : UnicodeString; locVal_3 : UnicodeString; begin VAL_1 := WideString('AzErTy123'); VAL_2 := 'QwErTy85'; s := Nil; Try locVal_1 := VAL_1; locVal_3 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('intVal_1',TypeInfo(UnicodeString),locVal_1); f.Put('intVal_3',TypeInfo(UnicodeString),locVal_3); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); locVal_1 := ''; locVal_3 := 'yyyyyyyy'; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_1'; f.Get(TypeInfo(UnicodeString),x,locVal_1); x := 'intVal_3'; f.Get(TypeInfo(UnicodeString),x,locVal_3); f.EndScopeRead(); Check(VAL_1 = locVal_1, 'Expected : "'+VAL_1+'", actual : "'+locVal_1+'"'); Check(VAL_2 = locVal_3, Format('Expected : "%s", actual : "%s"',[VAL_2,locVal_3])); Finally s.Free(); End; end; {$ENDIF WST_UNICODESTRING} procedure TTestFormatterSimpleType.Test_WideString; const VAL_1 : WideString = 'AzErTy123'; VAL_2 : WideString = 'QwErTy85'; Var f : IFormatterBase; s : TMemoryStream; x : string; locVal_1 : WideString; locVal_3 : WideString; begin s := Nil; Try locVal_1 := VAL_1; locVal_3 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('intVal_1',TypeInfo(WideString),locVal_1); f.Put('intVal_3',TypeInfo(WideString),locVal_3); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); locVal_1 := ''; locVal_3 := 'yyyyyyyy'; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_1'; f.Get(TypeInfo(WideString),x,locVal_1); x := 'intVal_3'; f.Get(TypeInfo(WideString),x,locVal_3); f.EndScopeRead(); Check(VAL_1 = locVal_1); Check(VAL_2 = locVal_3); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_WideString_ScopeData; const VAL_1 : WideString = 'AzErTy1234'; Var f : IFormatterBase; s : TMemoryStream; x : string; locVal_1 : widestring; begin s := Nil; Try locVal_1 := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(widestring),locVal_1); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); locVal_1 := ''; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(widestring),locVal_1); f.EndScopeRead(); CheckEquals(VAL_1,locVal_1); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Bool; const VAL_1 = True; VAL_2 = False; Var f : IFormatterBase; s : TMemoryStream; x : string; intVal_1 : Boolean; intVal_3 : Boolean; begin s := Nil; Try intVal_1 := VAL_1; intVal_3 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('intVal_1',TypeInfo(Boolean),intVal_1); f.Put('intVal_3',TypeInfo(Boolean),intVal_3); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_1 := False; intVal_3 := True; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_1'; f.Get(TypeInfo(Boolean),x,intVal_1); x := 'intVal_3'; f.Get(TypeInfo(Boolean),x,intVal_3); f.EndScopeRead(); CheckEquals(VAL_1,intVal_1); CheckEquals(VAL_2,intVal_3); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Bool_ScopeData; const VAL_1 = True; VAL_2 = False; Var f : IFormatterBase; s : TMemoryStream; x : string; locVal_1 : Boolean; begin s := Nil; Try locVal_1 := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(Boolean),locVal_1); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); locVal_1 := not locVal_1; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(Boolean),locVal_1); f.EndScopeRead(); CheckEquals(VAL_1,locVal_1); //----------- locVal_1 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.PutScopeInnerValue(TypeInfo(Boolean),locVal_1); f.EndScope(); s.Clear(); f.SaveToStream(s); locVal_1 := not locVal_1; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(Boolean),locVal_1); f.EndScopeRead(); CheckEquals(VAL_2,locVal_1); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Enum; const VAL_1 = teTwo; VAL_2 = teFour; Var f : IFormatterBase; s : TMemoryStream; x : string; intVal_1 : TTestEnum; intVal_3 : TTestEnum; begin s := Nil; Try intVal_1 := VAL_1; intVal_3 := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Enum)); f.Put('intVal_1',TypeInfo(TTestEnum),intVal_1); f.Put('intVal_3',TypeInfo(TTestEnum),intVal_3); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_1 := teOne; intVal_3 := teOne; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'intVal_1'; f.Get(TypeInfo(TTestEnum),x,intVal_1); x := 'intVal_3'; f.Get(TypeInfo(TTestEnum),x,intVal_3); f.EndScopeRead(); CheckEquals(Ord(VAL_1),Ord(intVal_1)); CheckEquals(Ord(VAL_2),Ord(intVal_3)); Finally s.Free(); End; end; procedure TTestFormatterSimpleType.Test_Enum_ScopeData; const VAL_1 = teTwo; Var f : IFormatterBase; s : TMemoryStream; x : string; intVal_1 : TTestEnum; begin s := Nil; Try intVal_1 := VAL_1; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Enum)); f.PutScopeInnerValue(TypeInfo(TTestEnum),intVal_1); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); intVal_1 := teOne; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); f.GetScopeInnerValue(TypeInfo(TTestEnum),intVal_1); f.EndScopeRead(); CheckEquals(Ord(VAL_1),Ord(intVal_1)); Finally s.Free(); End; end; class function TTestFormatter.SupportNamedArrayItem() : Boolean; begin Result := False; end; procedure TTestFormatter.Test_Int_WithClass; const CONST_Val_8U = $FE; CONST_Val_8S = -$7F; CONST_Val_16U = $FFFE; CONST_Val_16S = -$7FFF; CONST_Val_32U = $FFFFFFFE; CONST_Val_32S = -$7FFFFFFF; {$IFDEF HAS_BUILT_IN_64UINT} CONST_Val_64U = 18446744073709551604{ = $FFFFFFFFFFFFFFF4}; {$ELSE HAS_BUILT_IN_64UINT} CONST_Val_64U = $FFFFFFFFFFFFF; {$ENDIF HAS_BUILT_IN_64UINT} CONST_Val_64S = -$FFFFFFFFFFFFF; Var f : IFormatterBase; s : TMemoryStream; a : TClass_Int; x : string; begin s := Nil; a := TClass_Int.Create(); Try a.Val_8U := CONST_Val_8U; a.Val_8S := CONST_Val_8S; a.Val_16U := CONST_Val_16U; a.Val_16S := CONST_Val_16S; a.Val_32U := CONST_Val_32U; a.Val_32S := CONST_Val_32S; if SupportInt64() then a.Val_64S := CONST_Val_64S else a.Val_64S := CONST_Val_32S; if SupportUInt64() then a.Val_64U := CONST_Val_64U else a.Val_64U := CONST_Val_32U; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_Int),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_Int.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_Int),x,a); f.EndScopeRead(); CheckEquals(CONST_Val_8U,a.Val_8U); CheckEquals(CONST_Val_8S,a.Val_8S); CheckEquals(CONST_Val_16U,a.Val_16U); CheckEquals(CONST_Val_16S,a.Val_16S); CheckEquals(CONST_Val_32U,a.Val_32U); CheckEquals(CONST_Val_32S,a.Val_32S); if SupportInt64() then CheckEquals(CONST_Val_64S,a.Val_64S) else CheckEquals(CONST_Val_32S,a.Val_64S); if SupportUInt64() then CheckEquals(QWord(CONST_Val_64U),a.Val_64U) else CheckEquals(QWord(CONST_Val_32U),a.Val_64U); Finally a.Free(); s.Free(); End; end; procedure TTestFormatter.Test_Float_WithClass; const VAL_CUR : Currency = 8.8; VAL_DBL : Double = 8.8; VAL_SGL : Single = 4.4; VAL_EXT : Extended = 10.10; Var f : IFormatterBase; s : TMemoryStream; a : TClass_Float; x : string; begin s := Nil; a := TClass_Float.Create(); Try a.Val_Currency := VAL_CUR; a.Val_Double := VAL_DBL; a.Val_Extended := VAL_EXT; a.Val_Single := VAL_SGL; f := CreateFormatter(TypeInfo(TClass_Float)); f.BeginObject('Root',TypeInfo(TClass_Float)); f.Put('o1',TypeInfo(TClass_Float),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_Float.Create(); f := CreateFormatter(TypeInfo(TClass_Float)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Float)); x := 'o1'; f.Get(TypeInfo(TClass_Float),x,a); f.EndScopeRead(); CheckEquals(VAL_SGL,a.Val_Single); CheckEquals(VAL_DBL,a.Val_Double); CheckEquals(VAL_CUR,a.Val_Currency); CheckEquals(VAL_EXT,a.Val_Extended); Finally a.Free(); s.Free(); End; end; procedure TTestFormatter.Test_Enum_Bool_String_WithClass; Var f : IFormatterBase; s : TMemoryStream; a : TClass_Enum; x : string; begin s := Nil; a := TClass_Enum.Create(); Try a.Val_Bool := True; a.Val_Enum := teThree; a.Val_String := 'atou'; f := CreateFormatter(TypeInfo(TClass_Enum)); f.BeginObject('Root',TypeInfo(TClass_Enum)); f.Put('o1',TypeInfo(TClass_Enum),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_Enum.Create(); f := CreateFormatter(TypeInfo(TClass_Enum)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Enum)); x := 'o1'; f.Get(TypeInfo(TClass_Enum),x,a); f.EndScopeRead(); CheckEquals(True,a.Val_Bool); CheckEquals(Ord(teThree),Ord(a.Val_Enum)); CheckEquals('atou',a.Val_String); //------------------------------------ FreeAndNil(a); a := TClass_Enum.Create(); a.Val_Bool := False; a.Val_Enum := teTwo; a.Val_String := 'atoukws'; f := CreateFormatter(TypeInfo(TClass_Enum)); f.BeginObject('Root',TypeInfo(TClass_Enum)); f.Put('o1',TypeInfo(TClass_Enum),a); f.EndScope(); s.Clear(); f.SaveToStream(s); FreeAndNil(a); a := TClass_Enum.Create(); f := CreateFormatter(TypeInfo(TClass_Enum)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Enum)); x := 'o1'; f.Get(TypeInfo(TClass_Enum),x,a); f.EndScopeRead(); CheckEquals(False,a.Val_Bool); CheckEquals(Ord(teTwo),Ord(a.Val_Enum)); CheckEquals('atoukws',a.Val_String); Finally a.Free(); s.Free(); End; end; procedure TTestFormatter.Test_CplxInt64SimpleContent_WithClass; const VAL_S = -$FFFFFFFFFF; VAL_U = $FFFFFFFFFFFF; VAL_X = 121; VAL_STR_S = 'Test Attribute S'; VAL_STR_U = 'Test Attribute U'; VAL_STR_X = 'test it'; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : TComplexInt64SContentRemotable; nu : TComplexInt64UContentRemotable; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := TComplexInt64SContentRemotable.Create(); nu := TComplexInt64UContentRemotable.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxInt64S.Value := VAL_S; a.Val_CplxInt64S.StrSimpleAtt_Exemple := VAL_STR_S; a.Val_CplxInt64S.IntSimpleAtt_Exemple := VAL_X; a.Val_CplxInt64S.BoolSimpleAtt_Exemple := True; a.Elt_Exemple := VAL_STR_X; ns.Value := VAL_S; a.Val_CplxInt64U.Value := VAL_U; a.Val_CplxInt64U.StrSimpleAtt_Exemple := VAL_STR_U; a.Val_CplxInt64U.IntSimpleAtt_Exemple := VAL_X; a.Val_CplxInt64U.BoolSimpleAtt_Exemple := False; nu.Value := VAL_U; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(TComplexInt64SContentRemotable),ns); f.Put('nu',TypeInfo(TComplexInt64UContentRemotable),nu); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_CplxSimpleContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexInt64SContentRemotable),x,ns); x := 'nu'; f.Get(TypeInfo(TComplexInt64UContentRemotable),x,nu); f.EndScopeRead(); CheckEquals(VAL_S,a.Val_CplxInt64S.Value); CheckEquals(VAL_X,a.Val_CplxInt64S.IntSimpleAtt_Exemple); CheckEquals(VAL_STR_S,a.Val_CplxInt64S.StrSimpleAtt_Exemple); CheckEquals(True,a.Val_CplxInt64S.BoolSimpleAtt_Exemple); CheckEquals(VAL_STR_X,a.Elt_Exemple); CheckEquals(QWord(VAL_U),a.Val_CplxInt64U.Value); CheckEquals(VAL_X,a.Val_CplxInt64U.IntSimpleAtt_Exemple); CheckEquals(VAL_STR_U,a.Val_CplxInt64U.StrSimpleAtt_Exemple); CheckEquals(False,a.Val_CplxInt64U.BoolSimpleAtt_Exemple); finally FreeAndNil(nu); FreeAndNil(ns); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_CplxInt32SimpleContent_WithClass; const VAL_S = -12; VAL_U = 10; VAL_X = 1210; VAL_STR_S = 'Test Attribute S'; VAL_STR_U = 'Test Attribute U'; VAL_STR_X = 'test it'; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : TComplexInt32SContentRemotable; nu : TComplexInt32UContentRemotable; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := TComplexInt32SContentRemotable.Create(); nu := TComplexInt32UContentRemotable.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxInt32S.Value := VAL_S; a.Val_CplxInt32S.StrSimpleAtt_Exemple := VAL_STR_S; a.Val_CplxInt32S.IntSimpleAtt_Exemple := VAL_X; a.Val_CplxInt32S.BoolSimpleAtt_Exemple := True; a.Elt_Exemple := VAL_STR_X; ns.Value := VAL_S; a.Val_CplxInt32U.Value := VAL_U; a.Val_CplxInt32U.StrSimpleAtt_Exemple := VAL_STR_U; a.Val_CplxInt32U.IntSimpleAtt_Exemple := VAL_X; a.Val_CplxInt32U.BoolSimpleAtt_Exemple := False; nu.Value := VAL_U; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(TComplexInt32SContentRemotable),ns); f.Put('nu',TypeInfo(TComplexInt32UContentRemotable),nu); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_CplxSimpleContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexInt32SContentRemotable),x,ns); x := 'nu'; f.Get(TypeInfo(TComplexInt32UContentRemotable),x,nu); f.EndScopeRead(); CheckEquals(VAL_S,a.Val_CplxInt32S.Value); CheckEquals(VAL_X,a.Val_CplxInt32S.IntSimpleAtt_Exemple); CheckEquals(VAL_STR_S,a.Val_CplxInt32S.StrSimpleAtt_Exemple); CheckEquals(True,a.Val_CplxInt32S.BoolSimpleAtt_Exemple); CheckEquals(VAL_STR_X,a.Elt_Exemple); CheckEquals(VAL_U,a.Val_CplxInt32U.Value); CheckEquals(VAL_X,a.Val_CplxInt32U.IntSimpleAtt_Exemple); CheckEquals(VAL_STR_U,a.Val_CplxInt32U.StrSimpleAtt_Exemple); CheckEquals(False,a.Val_CplxInt32U.BoolSimpleAtt_Exemple); finally FreeAndNil(nu); FreeAndNil(ns); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_CplxInt16SimpleContent_WithClass; const VAL_S = -12; VAL_U = 10; VAL_X = 1210; VAL_STR_S = 'Test Attribute S'; VAL_STR_U = 'Test Attribute U'; VAL_STR_X = 'test it'; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : TComplexInt16SContentRemotable; nu : TComplexInt16UContentRemotable; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := TComplexInt16SContentRemotable.Create(); nu := TComplexInt16UContentRemotable.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxInt16S.Value := VAL_S; a.Val_CplxInt16S.StrSimpleAtt_Exemple := VAL_STR_S; a.Val_CplxInt16S.IntSimpleAtt_Exemple := VAL_X; a.Val_CplxInt16S.BoolSimpleAtt_Exemple := True; a.Elt_Exemple := VAL_STR_X; ns.Value := VAL_S; a.Val_CplxInt16U.Value := VAL_U; a.Val_CplxInt16U.StrSimpleAtt_Exemple := VAL_STR_U; a.Val_CplxInt16U.IntSimpleAtt_Exemple := VAL_X; a.Val_CplxInt16U.BoolSimpleAtt_Exemple := False; nu.Value := VAL_U; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(TComplexInt16SContentRemotable),ns); f.Put('nu',TypeInfo(TComplexInt16UContentRemotable),nu); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_CplxSimpleContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexInt16SContentRemotable),x,ns); x := 'nu'; f.Get(TypeInfo(TComplexInt16UContentRemotable),x,nu); f.EndScopeRead(); CheckEquals(VAL_S,a.Val_CplxInt16S.Value); CheckEquals(VAL_X,a.Val_CplxInt16S.IntSimpleAtt_Exemple); CheckEquals(VAL_STR_S,a.Val_CplxInt16S.StrSimpleAtt_Exemple); CheckEquals(True,a.Val_CplxInt16S.BoolSimpleAtt_Exemple); CheckEquals(VAL_STR_X,a.Elt_Exemple); CheckEquals(VAL_U,a.Val_CplxInt16U.Value); CheckEquals(VAL_X,a.Val_CplxInt16U.IntSimpleAtt_Exemple); CheckEquals(VAL_STR_U,a.Val_CplxInt16U.StrSimpleAtt_Exemple); CheckEquals(False,a.Val_CplxInt16U.BoolSimpleAtt_Exemple); finally FreeAndNil(nu); FreeAndNil(ns); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_CplxInt8SimpleContent_WithClass; const VAL_S = -12; VAL_U = 10; VAL_X = 121; VAL_STR_S = 'Test Attribute S'; VAL_STR_U = 'Test Attribute U'; VAL_STR_X = 'test it'; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : TComplexInt8SContentRemotable; nu : TComplexInt8UContentRemotable; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := TComplexInt8SContentRemotable.Create(); nu := TComplexInt8UContentRemotable.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxInt8S.Value := VAL_S; a.Val_CplxInt8S.StrSimpleAtt_Exemple := VAL_STR_S; a.Val_CplxInt8S.IntSimpleAtt_Exemple := VAL_X; a.Val_CplxInt8S.BoolSimpleAtt_Exemple := True; a.Elt_Exemple := VAL_STR_X; ns.Value := VAL_S; a.Val_CplxInt8U.Value := VAL_U; a.Val_CplxInt8U.StrSimpleAtt_Exemple := VAL_STR_U; a.Val_CplxInt8U.IntSimpleAtt_Exemple := VAL_X; a.Val_CplxInt8U.BoolSimpleAtt_Exemple := False; nu.Value := VAL_U; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(TComplexInt8SContentRemotable),ns); f.Put('nu',TypeInfo(TComplexInt8UContentRemotable),nu); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_CplxSimpleContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexInt8SContentRemotable),x,ns); x := 'nu'; f.Get(TypeInfo(TComplexInt8UContentRemotable),x,nu); f.EndScopeRead(); CheckEquals(VAL_S,a.Val_CplxInt8S.Value); CheckEquals(VAL_X,a.Val_CplxInt8S.IntSimpleAtt_Exemple); CheckEquals(VAL_STR_S,a.Val_CplxInt8S.StrSimpleAtt_Exemple); CheckEquals(True,a.Val_CplxInt8S.BoolSimpleAtt_Exemple); CheckEquals(VAL_STR_X,a.Elt_Exemple); CheckEquals(VAL_U,a.Val_CplxInt8U.Value); CheckEquals(VAL_X,a.Val_CplxInt8U.IntSimpleAtt_Exemple); CheckEquals(VAL_STR_U,a.Val_CplxInt8U.StrSimpleAtt_Exemple); CheckEquals(False,a.Val_CplxInt8U.BoolSimpleAtt_Exemple); finally FreeAndNil(nu); FreeAndNil(ns); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_CplxEnumSimpleContent_WithClass; const VAL_S = teTwo; VAL_U = teThree; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : T_ComplexTestEnumContent; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := T_ComplexTestEnumContent.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxEnum := T_ComplexTestEnumContent.Create(); a.Val_CplxEnum.Value := VAL_S; ns.Value := VAL_U; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(T_ComplexTestEnumContent),ns); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); ns.Value := teOne; a := TClass_CplxSimpleContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexInt8SContentRemotable),x,ns); f.EndScopeRead(); CheckEquals(Ord(VAL_S),Ord(a.Val_CplxEnum.Value),'a.Val_CplxEnum.Value'); CheckEquals(Ord(VAL_U),Ord(ns.Value),'ns.Value'); finally FreeAndNil(ns); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_CplxFloatExtendedSimpleContent_WithClass; const VAL_S : Extended = -12.10; VAL_U : Double = 10.76; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : TComplexFloatExtendedContentRemotable; nu : TComplexFloatDoubleContentRemotable; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := TComplexFloatExtendedContentRemotable.Create(); nu := TComplexFloatDoubleContentRemotable.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxExtended := T_ComplexFloatExtendedContent.Create(); a.Val_CplxExtended.Value := VAL_S; a.Val_CplxDouble := T_ComplexFloatDoubleContent.Create(); a.Val_CplxDouble.Value := VAL_U; a.Val_CplxInt32S.Free(); a.Val_CplxInt32S := nil; a.Val_CplxInt32U.Free(); a.Val_CplxInt32U := nil; ns.Value := VAL_S; nu.Value := VAL_U; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(TComplexFloatExtendedContentRemotable),ns); f.Put('nu',TypeInfo(TComplexFloatDoubleContentRemotable),nu); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_CplxSimpleContent.Create(); a.Val_CplxInt32S.Free(); a.Val_CplxInt32S := nil; a.Val_CplxInt32U.Free(); a.Val_CplxInt32U := nil; a.Val_CplxExtended := T_ComplexFloatExtendedContent.Create(); a.Val_CplxDouble := T_ComplexFloatDoubleContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexFloatExtendedContentRemotable),x,ns); x := 'nu'; f.Get(TypeInfo(TComplexFloatDoubleContentRemotable),x,nu); f.EndScopeRead(); CheckEquals(VAL_S,a.Val_CplxExtended.Value,'VAL_S <> a.Val_CplxExtended.Value'); CheckEquals(VAL_U,a.Val_CplxDouble.Value,'VAL_S <> a.Val_CplxDouble.Value'); CheckEquals(VAL_S,ns.Value,'VAL_S <> ns.Value'); CheckEquals(VAL_U,nu.Value,'VAL_U <> nu.Value'); CheckNull(a.Val_CplxInt32S,'a.Val_CplxInt32S <> nil'); CheckNull(a.Val_CplxInt32U,'a.Val_CplxInt32U <> nil'); finally FreeAndNil(nu); FreeAndNil(ns); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_CplxStringSimpleContent_WithClass; const VAL_S = 'web services toolkit'; VAL_STR_S = 'Test Attribute S'; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : TComplexStringContentRemotable; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := TComplexStringContentRemotable.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxString := T_ComplexStringContent.Create(); a.Val_CplxString.Value := VAL_S; a.Val_CplxInt32S.Free(); a.Val_CplxInt32S := nil; a.Val_CplxInt32U.Free(); a.Val_CplxInt32U := nil; ns.Value := VAL_STR_S; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(TComplexStringContentRemotable),ns); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_CplxSimpleContent.Create(); a.Val_CplxInt32S.Free(); a.Val_CplxInt32S := nil; a.Val_CplxInt32U.Free(); a.Val_CplxInt32U := nil; a.Val_CplxString := T_ComplexStringContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexStringContentRemotable),x,ns); f.EndScopeRead(); CheckEquals(VAL_S,a.Val_CplxString.Value,'VAL_S <> a.Val_CplxString.Value'); CheckEquals(VAL_STR_S,ns.Value,'VAL_STR_S <> ns.Value'); finally FreeAndNil(ns); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_CplxWideStringSimpleContent_WithClass; const VAL_S : WideString = 'web services toolkit'; VAL_STR_S : WideString = 'Test Attribute S'; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : TComplexWideStringContentRemotable; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := TComplexWideStringContentRemotable.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxWideString := T_ComplexWideStringContent.Create(); a.Val_CplxWideString.Value := VAL_S; a.Val_CplxInt32S.Free(); a.Val_CplxInt32S := nil; a.Val_CplxInt32U.Free(); a.Val_CplxInt32U := nil; ns.Value := VAL_STR_S; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(TComplexWideStringContentRemotable),ns); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_CplxSimpleContent.Create(); a.Val_CplxInt32S.Free(); a.Val_CplxInt32S := nil; a.Val_CplxInt32U.Free(); a.Val_CplxInt32U := nil; a.Val_CplxWideString := T_ComplexWideStringContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexWideStringContentRemotable),x,ns); f.EndScopeRead(); CheckEquals(VAL_S,a.Val_CplxWideString.Value,'VAL_S <> a.Val_CplxWideString.Value'); CheckEquals(VAL_STR_S,ns.Value,'VAL_STR_S <> ns.Value'); finally FreeAndNil(ns); a.Free(); s.Free(); end; end; {$IFDEF WST_UNICODESTRING} procedure TTestFormatter.Test_CplxUnicodeStringSimpleContent_WithClass; const VAL_S = 'web services toolkit'; VAL_STR_S = 'Test Attribute S'; var f : IFormatterBase; s : TMemoryStream; a : TClass_CplxSimpleContent; ns : TComplexUnicodeStringContentRemotable; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; ns := TComplexUnicodeStringContentRemotable.Create(); a := TClass_CplxSimpleContent.Create(); try a.Val_CplxUnicodeString := T_ComplexUnicodeStringContent.Create(); a.Val_CplxUnicodeString.Value := VAL_S; a.Val_CplxInt32S.Free(); a.Val_CplxInt32S := nil; a.Val_CplxInt32U.Free(); a.Val_CplxInt32U := nil; ns.Value := VAL_STR_S; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('o1',TypeInfo(TClass_CplxSimpleContent),a); f.Put('ns',TypeInfo(TComplexUnicodeStringContentRemotable),ns); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_CplxSimpleContent.Create(); a.Val_CplxInt32S.Free(); a.Val_CplxInt32S := nil; a.Val_CplxInt32U.Free(); a.Val_CplxInt32U := nil; a.Val_CplxUnicodeString := T_ComplexUnicodeStringContent.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'o1'; f.Get(TypeInfo(TClass_CplxSimpleContent),x,a); x := 'ns'; f.Get(TypeInfo(TComplexUnicodeStringContentRemotable),x,ns); f.EndScopeRead(); CheckEquals(VAL_S,a.Val_CplxUnicodeString.Value,'VAL_S <> a.Val_CplxUnicodeString.Value'); CheckEquals(VAL_STR_S,ns.Value,'VAL_STR_S <> ns.Value'); finally FreeAndNil(ns); a.Free(); s.Free(); end; end; {$ENDIF WST_UNICODESTRING} procedure TTestFormatter.Test_Object(); const DATE_VALUE = 39000; DATETIME_VALUE = 39000.1234; TIME_VALUE = '01:23:45.789Z'; Var f : IFormatterBase; s : TMemoryStream; a : TClass_B; x : string; begin s := Nil; a := TClass_B.Create(); Try a.Val_Bool := False; a.Val_Enum := teThree; a.Val_String := '123'; a.Val_WideString := 'wide123'; {$IFDEF WST_UNICODESTRING} a.Val_UnicodeString := 'unicode123'; {$ENDIF WST_UNICODESTRING} a.ObjProp.Val_String := '456'; a.ObjProp.Val_WideString := 'wide456'; a.ObjProp.Val_DateTime.AsDate := DATETIME_VALUE; a.ObjProp.Val_Date.AsDate := DATE_VALUE; a.ObjProp.Val_Time.AsString := TIME_VALUE; {$IFDEF WST_UNICODESTRING} a.ObjProp.Val_UnicodeString := 'unicode456'; {$ENDIF WST_UNICODESTRING} a.ObjProp.Val_Enum := teFour; a.ObjProp.Val_Bool := True; a.ObjProp.Val_32S := 121076; a.NonStored := 121076; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('o1',TypeInfo(TClass_B),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TClass_B.Create(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'o1'; f.Get(TypeInfo(TClass_B),x,a); f.EndScopeRead(); CheckEquals(False,a.Val_Bool); CheckEquals(Ord(teThree),Ord(a.Val_Enum)); CheckEquals('123',a.Val_String); CheckEquals(WideString('wide123'),a.Val_WideString); {$IFDEF WST_UNICODESTRING} CheckEquals('unicode123',a.Val_UnicodeString); {$ENDIF WST_UNICODESTRING} CheckEquals(True,a.ObjProp.Val_Bool); CheckEquals(Ord(teFour),Ord(a.ObjProp.Val_Enum)); CheckEquals('456',a.ObjProp.Val_String); CheckEquals(WideString('wide456'),a.ObjProp.Val_WideString); CheckEquals(TDateTimeRemotable.ToStr(DATETIME_VALUE),TDateTimeRemotable.ToStr(a.ObjProp.Val_DateTime.AsDate)); CheckEquals(TDateRemotable.ToStr(DATE_VALUE),TDateRemotable.ToStr(a.ObjProp.Val_Date.AsDate)); CheckEquals(TIME_VALUE,a.ObjProp.Val_Time.AsString); {$IFDEF WST_UNICODESTRING} CheckEquals('unicode456',a.ObjProp.Val_UnicodeString); {$ENDIF WST_UNICODESTRING} CheckEquals(121076,a.ObjProp.Val_32S); CheckEquals(0,a.NonStored); Finally a.Free(); s.Free(); End; end; procedure TTestFormatter.Test_Object_Nil(); var f : IFormatterBase; s : TMemoryStream; a : TClass_B; x : string; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; a := nil; try f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('o1',TypeInfo(TClass_B),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := nil; f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'o1'; f.Get(TypeInfo(TClass_B),x,a); f.EndScopeRead(); CheckNull(a); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Object_ExternalPropertyName(); var f : IFormatterBase; s : TMemoryStream; a, areaded : TClassWithPropExtName; x : string; ls : TStringList; begin ls := nil; s := nil; a := TClassWithPropExtName.Create(); try a.StrProp := 'wst string'; a.PropWithExtName := 123; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('o1',TypeInfo(TClassWithPropExtName),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); //s.SaveToFile(wstExpandLocalFileName(ClassName + '.Test_Object_ExternalPropertyName.' + f.GetFormatName())); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'o1'; f.BeginObjectRead(x,TypeInfo(TClassWithPropExtName)); ls := TStringList.Create(); CheckEquals(2, f.GetScopeItemNames(ls), 'Scope item names'); Check(ls.IndexOf('ExternalProperty') >= 0, '"ExternalProperty" not found'); f.EndScopeRead(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); areaded := TClassWithPropExtName.Create(); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'o1'; f.Get(TypeInfo(TClassWithPropExtName),x,areaded); f.EndScopeRead(); CheckEquals(a.StrProp, areaded.StrProp, 'StrProp'); CheckEquals(a.PropWithExtName, areaded.PropWithExtName, 'PropWithExtName'); finally ls.Free(); a.Free(); areaded.Free(); s.Free(); end; end; procedure TTestFormatter.Test_StringArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of string = ('AzErTy','QwErTy','123456','','1'); var a : TArrayOfStringRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfStringRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length, 'Length 1'); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfStringRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfStringRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfStringRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length, 'Length 2'); for i := 0 to Pred(AR_LEN) do CheckEquals(VAL_AR[i],a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_StringArray_Embedded(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of string = ('AzErTy','QwErTy','123456','','1'); var a : TArrayOfStringRemotable; b : TEmbeddedArrayOfStringRemotable; i, intVal : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; b := nil; a := TArrayOfStringRemotable.Create(); try b := TEmbeddedArrayOfStringRemotable.Create(); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length, 'Length 1'); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); b.SetLength(AR_LEN); CheckEquals(AR_LEN,b.Length); for i := 0 to Pred(AR_LEN) do begin a[i] := VAL_AR[i]; b[i] := VAL_AR[Pred(AR_LEN)-i]; end; intVal := 1210; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfStringRemotable),a); f.Put('x',TypeInfo(Integer),intVal); f.Put('b',TypeInfo(TEmbeddedArrayOfStringRemotable),b); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); FreeAndNil(b); intVal := 0; a := TArrayOfStringRemotable.Create(); b := TEmbeddedArrayOfStringRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); b.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfStringRemotable),x,a); x := 'x'; f.Get(TypeInfo(Integer),x,intVal); x := 'b'; f.Get(TypeInfo(TEmbeddedArrayOfStringRemotable),x,b); f.EndScopeRead(); CheckEquals(1210,intVal, 'IntVal'); CheckEquals(AR_LEN,a.Length, 'Length 2 a'); CheckEquals(AR_LEN,b.Length,'Length 2 b'); for i := 0 to Pred(AR_LEN) do begin CheckEquals(VAL_AR[i],a[i]); CheckEquals(VAL_AR[Pred(AR_LEN)-i],b[i]); end; finally b.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_StringArrayZeroLength(); var a : TArrayOfStringRemotable; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfStringRemotable.Create(); try CheckEquals(0,a.Length); f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfStringRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfStringRemotable),x,a); f.EndScopeRead(); CheckNotNull(a); CheckEquals(0,a.Length); a := TArrayOfStringRemotable.Create(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfStringRemotable),x,a); f.EndScopeRead(); CheckNotNull(a); CheckEquals(0,a.Length); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_StringArrayZeroLength_serializeOption(); var a : TArrayOfStringRemotable; f : IFormatterBase; s : TMemoryStream; x : string; ls : TStringList; begin a := nil; s := nil; ls := TStringList.Create(); try a := TArrayOfStringRemotable.Create(); CheckEquals(0,a.Length); a.Options := []; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfStringRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); CheckEquals(0,f.GetScopeItemNames(ls)); f.EndScopeRead(); a.Options := [ioAlwaysSerialize]; s.Clear(); f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfStringRemotable),a); f.EndScope(); f.SaveToStream(s); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); CheckEquals(1,f.GetScopeItemNames(ls)); CheckEquals('a',ls[0]); f.EndScopeRead(); finally ls.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_BooleanArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Boolean = (True,True,False,True,False); var a : TArrayOfBooleanRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfBooleanRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfBooleanRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfBooleanRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfBooleanRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do CheckEquals(VAL_AR[i],a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Int8UArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Byte = (12,34,100,200,180); var a : TArrayOfInt8URemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfInt8URemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfInt8URemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfInt8URemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt8URemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do CheckEquals(VAL_AR[i],a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Int8SArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of ShortInt = (-12,-34,100,120,110); var a : TArrayOfInt8SRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfInt8SRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfInt8SRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfInt8SRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt8SRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do CheckEquals(VAL_AR[i],a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Int16SArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of SmallInt = (-12,-34,100,200,180); var a : TArrayOfInt16SRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfInt16SRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfInt16SRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfInt16SRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt16SRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do CheckEquals(VAL_AR[i],a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Int16UArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Word = (12,34,100,200,180); var a : TArrayOfInt16URemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfInt16URemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfInt16URemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfInt16URemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt16URemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do CheckEquals(VAL_AR[i],a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Int32UArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of LongWord = (12,34,100,200,180); var a : TArrayOfInt32URemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfInt32URemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfInt32URemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfInt32URemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt32URemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do CheckEquals(True,VAL_AR[i] = a[i],Format('VAL_AR[%d] = a[%d]',[i,i])); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Int32SArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of LongInt = (-12,-34,100,200,180); var a : TArrayOfInt32SRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfInt32SRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfInt32SRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfInt32SRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt32SRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do CheckEquals(VAL_AR[i],a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Int64SArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Int64 = ( -$FFFFFFFFFF,-$FFFF123FFF,$FFFFFFFFFF2,$FFFFFFFFFF2F,$FFFFFFFFFF24 ); var a : TArrayOfInt64SRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfInt64SRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfInt64SRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfInt64SRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt64SRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do CheckEquals(VAL_AR[i],a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_Int64UArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of QWord = (12,34,100,200,180); var a : TArrayOfInt64URemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfInt64URemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfInt64URemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfInt64URemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfInt64URemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do Check(VAL_AR[i]=a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_FloatSingleArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Single = (-12.10,-4.45,100,200.58,180.3); var a : TArrayOfFloatSingleRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfFloatSingleRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfFloatSingleRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfFloatSingleRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfFloatSingleRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do Check(VAL_AR[i]=a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_FloatDoubleArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Double = (-12.10,-4.45,100,200.58,180.3); var a : TArrayOfFloatDoubleRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfFloatDoubleRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfFloatDoubleRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfFloatDoubleRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfFloatDoubleRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do Check(IsZero(VAL_AR[i]-a[i]),Format('Expected : %s got %s',[FloatToStr(VAL_AR[i]),FloatToStr(a[i])])); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_FloatExtendedArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Extended = (-12.10,-4.45,100,200.58,180.3); var a : TArrayOfFloatExtendedRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfFloatExtendedRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfFloatExtendedRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfFloatExtendedRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfFloatExtendedRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do Check(IsZero(VAL_AR[i]-a[i]),Format('Expected : %s got %s',[FloatToStr(VAL_AR[i]),FloatToStr(a[i])])); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_FloatCurrencyArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Currency = (-12.10,-4.45,100,200.58,180.3); var a : TArrayOfFloatCurrencyRemotable; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; a := TArrayOfFloatCurrencyRemotable.Create(); try CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do a[i] := VAL_AR[i]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfFloatCurrencyRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); a := TArrayOfFloatCurrencyRemotable.Create(); a.SetLength(0); a.SetLength(0); a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfFloatCurrencyRemotable),x,a); f.EndScopeRead(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do Check(VAL_AR[i]=a[i]); finally a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_ObjectArray(); const AR_LEN = 5; procedure FillObject(AObject : TClass_A; const AIndex : Integer); begin AObject.Val_32S := AIndex * AR_LEN; if ( ( AObject.Val_32S mod 3 ) = 0 ) then AObject.Val_32S := -AObject.Val_32S; AObject.Val_Bool := ( AObject.Val_32S < 0 ); AObject.Val_Enum := TTestEnum( ( AIndex * AR_LEN) mod ( 1 + Ord(High(TTestEnum)) ) ); AObject.FVal_String := Format('Sample string %d',[AIndex]); end; procedure CompareObject(AExpected, AActual : TClass_A; const AMsg : string); begin Check( ( ( AExpected = nil ) and ( AActual = nil ) ) or ( ( AExpected <> nil ) and ( AActual <> nil ) ), AMsg ); if ( AExpected <> nil ) then begin CheckEquals(Ord(AExpected.Val_Enum), Ord(AActual.Val_Enum)); CheckEquals(AExpected.Val_Bool, AActual.Val_Bool); CheckEquals(AExpected.Val_32S, AActual.Val_32S); CheckEquals(AExpected.Val_String, AActual.Val_String); CheckEquals(AExpected.Val_WideString, AActual.Val_WideString); end; end; var a, areaded : TClass_A_Array; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; areaded := nil; a := TClass_A_Array.Create(); try a.SetLength(AR_LEN); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do begin FillObject(a[i],i); end; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TClass_A_Array),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); //s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_ObjectArray.' + f.GetFormatName())); areaded := TClass_A_Array.Create(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TClass_A_Array),x,areaded); f.EndScopeRead(); CheckEquals(AR_LEN,areaded.Length); for i := 0 to Pred(AR_LEN) do CompareObject(a[i],areaded[i], Format('Object at %d index',[i])); finally areaded.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_ObjectArray_ReadEmptyArray(); var a, areaded : TClass_A_Array; f : IFormatterBase; s : TMemoryStream; x : string; ls : TStringList; begin ls := nil; s := nil; areaded := nil; a := TClass_A_Array.Create(); try a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TClass_A_Array),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); //s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_ObjectArray.' + f.GetFormatName())); areaded := nil; f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TClass_A_Array),x,areaded); f.EndScopeRead(); CheckNotNull(areaded); CheckEquals(0,areaded.Length); areaded := TClass_A_Array.Create(); areaded.SetLength(12); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TClass_A_Array),x,areaded); f.EndScopeRead(); CheckEquals(0,areaded.Length); ls := TStringList.Create(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); f.GetScopeItemNames(ls); CheckEquals(-1, ls.IndexOf('a'), 'empty array should not be streamed'); f.EndScopeRead(); CheckEquals(0,areaded.Length); finally ls.Free(); areaded.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_ObjectArrayZeroLength_serializeOption(); var a : TClass_A_Array; f : IFormatterBase; s : TMemoryStream; x : string; ls : TStringList; begin a := nil; s := nil; ls := TStringList.Create(); try s := TMemoryStream.Create(); a := TClass_A_Array.Create(); a.SetLength(0); a.Options := []; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TClass_A_Array),a); f.EndScope(); f.SaveToStream(s); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); CheckEquals(0, f.GetScopeItemNames(ls)); f.EndScopeRead(); a.Options := [ioAlwaysSerialize]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TClass_A_Array),a); f.EndScope(); s.Clear(); f.SaveToStream(s); s.Position := 0; f.LoadFromStream(s); f.BeginObjectRead(x,TypeInfo(TClass_B)); CheckEquals(1, f.GetScopeItemNames(ls)); f.EndScopeRead(); CheckEquals('a', ls[0]); finally ls.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_ObjectCollection(); const AR_LEN = 5; procedure FillObject(AObject : TClass_A; const AIndex : Integer); begin AObject.Val_32S := AIndex * AR_LEN; if ( ( AObject.Val_32S mod 3 ) = 0 ) then AObject.Val_32S := -AObject.Val_32S; AObject.Val_Bool := ( AObject.Val_32S < 0 ); AObject.Val_Enum := TTestEnum( ( AIndex * AR_LEN) mod ( 1 + Ord(High(TTestEnum)) ) ); AObject.FVal_String := Format('Sample string %d',[AIndex]); end; procedure CompareObject(AExpected, AActual : TClass_A; const AMsg : string); begin Check( ( ( AExpected = nil ) and ( AActual = nil ) ) or ( ( AExpected <> nil ) and ( AActual <> nil ) ), AMsg ); if ( AExpected <> nil ) then begin CheckEquals(Ord(AExpected.Val_Enum), Ord(AActual.Val_Enum)); CheckEquals(AExpected.Val_Bool, AActual.Val_Bool); CheckEquals(AExpected.Val_32S, AActual.Val_32S); CheckEquals(AExpected.Val_String, AActual.Val_String); CheckEquals(AExpected.Val_WideString, AActual.Val_WideString); end; end; var a, areaded : TClass_A_Collection; i : Integer; f : IFormatterBase; s : TMemoryStream; x : string; begin s := nil; areaded := nil; a := TClass_A_Collection.Create(); try for i := 1 to AR_LEN do a.Add(); CheckEquals(AR_LEN,a.Length); for i := 0 to Pred(AR_LEN) do begin FillObject(a[i],i); end; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TClass_A_Collection),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); //s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_ObjectCollection.' + f.GetFormatName())); areaded := TClass_A_Collection.Create(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TClass_A_Collection),x,areaded); f.EndScopeRead(); CheckEquals(AR_LEN,areaded.Length); for i := 0 to Pred(AR_LEN) do CompareObject(a[i],areaded[i], Format('Object at %d index',[i])); finally areaded.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_ObjectCollectionZeroLength_serializeOption(); var a : TClass_A_Collection; f : IFormatterBase; s : TMemoryStream; x : string; ls : TStringList; begin a := nil; s := nil; ls := TStringList.Create(); try s := TMemoryStream.Create(); a := TClass_A_Collection.Create(); a.Clear(); a.Options := []; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TClass_A_Collection),a); f.EndScope(); f.SaveToStream(s); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); CheckEquals(0, f.GetScopeItemNames(ls)); f.EndScopeRead(); a.Options := [ioAlwaysSerialize]; f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TClass_A_Collection),a); f.EndScope(); s.Clear(); f.SaveToStream(s); s.Position := 0; f.LoadFromStream(s); f.BeginObjectRead(x,TypeInfo(TClass_B)); CheckEquals(1, f.GetScopeItemNames(ls)); f.EndScopeRead(); CheckEquals('a', ls[0]); finally ls.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_ObjectCollection_ReadEmptyCollection(); var a, areaded : TClass_A_Collection; f : IFormatterBase; s : TMemoryStream; x : string; ls : TStringList; begin ls := nil; s := nil; areaded := nil; a := TClass_A_Collection.Create(); try a.Clear(); f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TClass_A_Collection),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); //s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_ObjectCollection_ReadEmptyCollection.' + f.GetFormatName())); areaded := TClass_A_Collection.Create(); areaded.Add(); areaded.Add(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TClass_A_Collection),x,areaded); f.EndScopeRead(); CheckEquals(0,areaded.Length); ls := TStringList.Create(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); f.GetScopeItemNames(ls); CheckEquals(-1, ls.IndexOf('a'), 'empty array should not be streamed'); f.EndScopeRead(); CheckEquals(0,areaded.Length); finally ls.Free(); areaded.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_SimpleTypeArray_ReadEmptyArray(); var a, areaded : TArrayOfStringRemotable; f : IFormatterBase; s : TMemoryStream; x : string; ls : TStringList; begin ls := nil; s := nil; areaded := nil; a := TArrayOfStringRemotable.Create(); try a.SetLength(0); f := CreateFormatter(TypeInfo(TClass_B)); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('a',TypeInfo(TArrayOfStringRemotable),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); //s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_SimpleTypeArray_ReadEmptyArray.' + f.GetFormatName())); areaded := TArrayOfStringRemotable.Create(); areaded.SetLength(12); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'a'; f.Get(TypeInfo(TArrayOfStringRemotable),x,areaded); f.EndScopeRead(); CheckEquals(0,areaded.Length); ls := TStringList.Create(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); f.GetScopeItemNames(ls); CheckEquals(-1, ls.IndexOf('a'), 'empty array should not be streamed'); f.EndScopeRead(); CheckEquals(0,areaded.Length); finally ls.Free(); areaded.Free(); a.Free(); s.Free(); end; end; procedure TTestFormatter.Test_ComplexInt32S(); const VAL_1 = 121076; VAL_2 : LongInt = -101276; var f : IFormatterBase; s : TMemoryStream; x : string; a, b : TComplexInt32SContentRemotable; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; a := nil; b := nil; try a := TComplexInt32SContentRemotable.Create(); b := TComplexInt32SContentRemotable.Create(); a.Value := VAL_1; b.Value := VAL_2; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('a',TypeInfo(TComplexInt32SContentRemotable),a); f.Put('b',TypeInfo(TComplexInt32SContentRemotable),b); f.EndScope(); FreeAndNil(a);FreeAndNil(b); s := TMemoryStream.Create(); f.SaveToStream(s); a := TComplexInt32SContentRemotable.Create(); b := TComplexInt32SContentRemotable.Create(); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'a'; f.Get(TypeInfo(TComplexInt32SContentRemotable),x,a); x := 'b'; f.Get(TypeInfo(TComplexInt32SContentRemotable),x,b); f.EndScopeRead(); CheckEquals(VAL_1,a.Value); CheckEquals(VAL_2,b.Value); finally s.Free(); FreeAndNil(a); FreeAndNil(b); end; end; procedure TTestFormatter.Test_Record_simple(); const VAL_1 : Integer = 12; VAL_2 : Integer = -76; VAL_3 = 'wst record sample'; var f : IFormatterBase; s : TMemoryStream; x : string; a : TTestSmallRecord; begin s := nil; try a.fieldWord := VAL_1; a.fieldSmallint := VAL_2; a.fieldString := VAL_3; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('a',TypeInfo(TTestSmallRecord),a); f.EndScope(); a.fieldWord := 0; a.fieldSmallint := 0; a.fieldString := ''; s := TMemoryStream.Create(); f.SaveToStream(s); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'a'; f.Get(TypeInfo(TTestSmallRecord),x,a); f.EndScopeRead(); CheckEquals(VAL_1,a.fieldWord); CheckEquals(VAL_2,a.fieldSmallint); CheckEquals(VAL_3,a.fieldString); finally s.Free(); end; end; procedure TTestFormatter.Test_Record_nested(); const VAL_EPSILON = 0.0001; VAL_EMPTY_RECORD : TTestRecord = ( fieldByte : 0; fieldShortInt : 0; fieldSmallint : 0; fieldWord : 0; fieldInteger : 0; fieldLongWord : 0; fieldInt64 : 0; fieldQWord : 0; fieldComp : 0; fieldSingle : 0; fieldDouble : 0; fieldExtended : 0; fieldCurrency : 0; fieldBoolean : False; fieldString : ''; fieldRecord : ( fieldSmallint : 0; fieldWord : 0; fieldString : ''); ); VAL_RECORD : TTestRecord = ( fieldByte : 12; fieldShortInt : -10; fieldSmallint : 76; fieldWord : 34; fieldInteger : -45; fieldLongWord : 567; fieldInt64 : 8910; fieldQWord : 111213; fieldComp : 141516; fieldSingle : 1718; fieldDouble : -1819; fieldExtended : 2021; fieldCurrency : -2122; fieldBoolean : True; fieldString : 'sample record string 0123456789'; fieldRecord : ( fieldSmallint : 10; fieldWord : 11; fieldString : 'azertyqwerty'); ); var f : IFormatterBase; s : TMemoryStream; x : string; a : TTestRecord; begin s := nil; try a := VAL_RECORD; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('a',TypeInfo(TTestRecord),a); f.EndScope(); a := VAL_EMPTY_RECORD; s := TMemoryStream.Create(); f.SaveToStream(s); f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'a'; f.Get(TypeInfo(TTestRecord),x,a); f.EndScopeRead(); CheckEquals(VAL_RECORD.fieldBoolean,a.fieldBoolean,'fieldBoolean'); CheckEquals(VAL_RECORD.fieldByte,a.fieldByte,'fieldByte'); {$IFDEF HAS_COMP} CheckEquals(VAL_RECORD.fieldComp,a.fieldComp,'fieldComp'); {$ENDIF} Check(IsZero(VAL_RECORD.fieldCurrency-a.fieldCurrency,VAL_EPSILON),'fieldCurrency'); Check(IsZero(VAL_RECORD.fieldExtended-a.fieldExtended,VAL_EPSILON),'fieldExtended'); CheckEquals(VAL_RECORD.fieldInt64,a.fieldInt64,'fieldInt64'); CheckEquals(VAL_RECORD.fieldInteger,a.fieldInteger,'fieldInteger'); Check(VAL_RECORD.fieldLongWord = a.fieldLongWord,'fieldLongWord'); {$IFDEF HAS_QWORD} CheckEquals(VAL_RECORD.fieldQWord,a.fieldQWord,'fieldQWord'); {$ENDIF} CheckEquals(VAL_RECORD.fieldRecord.fieldSmallint,a.fieldRecord.fieldSmallint,'fieldSmallint'); CheckEquals(VAL_RECORD.fieldRecord.fieldString,a.fieldRecord.fieldString,'fieldString'); CheckEquals(VAL_RECORD.fieldRecord.fieldWord,a.fieldRecord.fieldWord,'fieldWord'); CheckEquals(VAL_RECORD.fieldShortInt,a.fieldShortInt,'fieldShortInt'); Check(IsZero(VAL_RECORD.fieldSingle-a.fieldSingle,VAL_EPSILON),'fieldSingle'); CheckEquals(VAL_RECORD.fieldSmallint,a.fieldSmallint,'fieldSmallint'); CheckEquals(VAL_RECORD.fieldString,a.fieldString,'fieldString'); CheckEquals(VAL_RECORD.fieldWord,a.fieldWord,'fieldWord'); finally s.Free(); end; end; procedure TTestFormatter.test_Date_ReadNil(); const DATE_VALUE = 39000.123; var f : IFormatterBase; s : TMemoryStream; x : string; a : TDateTimeRemotable; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; a := nil; try a := TDateTimeRemotable.Create(); a.AsDate := DATE_VALUE; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('a',TypeInfo(TDateTimeRemotable),a); f.EndScope(); FreeAndNil(a); s := TMemoryStream.Create(); f.SaveToStream(s); a := nil; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'a'; f.Get(TypeInfo(TDateTimeRemotable),x,a); f.EndScopeRead(); CheckNotNull(a); CheckEquals(TDateTimeRemotable.ToStr(DATE_VALUE),TDateTimeRemotable.ToStr(a.AsDate)); finally s.Free(); FreeAndNil(a); end; end; procedure TTestFormatter.test_Duration_ReadNil(); const TEST_VALUE = 'P1Y2M3DT4H5M6S'; var f : IFormatterBase; s : TMemoryStream; x : string; a : TDurationRemotable; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; a := nil; try a := TDurationRemotable.Create(); a.AsString := TEST_VALUE; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('a',TypeInfo(TDurationRemotable),a); f.EndScope(); FreeAndNil(a); s := TMemoryStream.Create(); f.SaveToStream(s); a := nil; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'a'; f.Get(TypeInfo(TDurationRemotable),x,a); f.EndScopeRead(); CheckNotNull(a); CheckEquals(TEST_VALUE,a.AsString); finally s.Free(); FreeAndNil(a); end; end; procedure TTestFormatter.test_Time_ReadNil(); const TEST_VALUE = '23:34:56Z'; var f : IFormatterBase; s : TMemoryStream; x : string; a : TTimeRemotable; begin if not Support_ComplextType_with_SimpleContent() then Exit; s := nil; a := nil; try a := TTimeRemotable.Create(); a.AsString := TEST_VALUE; f := CreateFormatter(TypeInfo(TClass_Int)); f.BeginObject('Root',TypeInfo(TClass_Int)); f.Put('a',TypeInfo(TTimeRemotable),a); f.EndScope(); FreeAndNil(a); s := TMemoryStream.Create(); f.SaveToStream(s); a := nil; f := CreateFormatter(TypeInfo(TClass_Int)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_Int)); x := 'a'; f.Get(TypeInfo(TTimeRemotable),x,a); f.EndScopeRead(); CheckNotNull(a); CheckEquals(TEST_VALUE,a.AsString); finally s.Free(); FreeAndNil(a); end; end; procedure TTestFormatter.test_GetScopeItemNames(); Var f : IFormatterBase; s : TMemoryStream; a, b : TClass_A; x : string; ls : TStringList; intv : TArrayOfStringRemotableSample; begin ls := nil; s := Nil; b := nil; intv := nil; a := TClass_A.Create(); try a.Val_Bool := False; a.Val_Enum := teThree; a.Val_String := '123'; a.Val_32S := 55; b := TClass_A.Create(); intv := TArrayOfStringRemotableSample.Create(); intv.SetLength(3); intv[0] := 'wst'; intv[1] := 'azerty'; intv[2] := 'qwerty'; f := CreateFormatter(TypeInfo(TClass_A)); f.BeginObject('Root',TypeInfo(TClass_A)); f.Put('a',TypeInfo(TClass_A),a); f.Put('b',TypeInfo(TClass_A),b); f.Put('intv',TypeInfo(TArrayOfStringRemotableSample),intv); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); FreeAndNil(b); FreeAndNil(intv); ls := TStringList.Create(); f := CreateFormatter(TypeInfo(TClass_A)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_A)); CheckEquals(3, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(Root)'); Check( ls.IndexOf('a') >= 0 ); Check( ls.IndexOf('b') >= 0 ); Check( ls.IndexOf('intv') >= 0 ); x := 'a'; f.BeginObjectRead(x,TypeInfo(TClass_A)); CheckEquals(8{$IFDEF WST_UNICODESTRING}+1{$ENDIF}, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(a)'); Check( ls.IndexOf('Val_Bool') >= 0 ); Check( ls.IndexOf('Val_Enum') >= 0 ); Check( ls.IndexOf('Val_String') >= 0 ); Check( ls.IndexOf('Val_32S') >= 0 ); f.EndScopeRead(); x := 'b'; f.BeginObjectRead(x,TypeInfo(TClass_A)); CheckEquals(8{$IFDEF WST_UNICODESTRING}+1{$ENDIF}, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(b)'); Check( ls.IndexOf('Val_Bool') >= 0 ); Check( ls.IndexOf('Val_Enum') >= 0 ); Check( ls.IndexOf('Val_String') >= 0 ); Check( ls.IndexOf('Val_32S') >= 0 ); f.EndScopeRead(); x := 'intv'; f.BeginArrayRead(x,TypeInfo(TArrayOfStringRemotableSample),asScoped,'OI'); CheckEquals(3, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(intv)'); if SupportNamedArrayItem() then Check( ls.IndexOf('OI') >= 0, 'Named item' ); f.EndScopeRead(); f.EndScopeRead(); finally intv.Free(); ls.Free(); b.Free();; a.Free(); s.Free(); end; end; { TTestBinaryFormatter } function TTestBinaryFormatter.CreateFormatter(ARootType : PTypeInfo):IFormatterBase; begin Result := TBaseBinaryFormatter.Create() as IFormatterBase; //Result.BeginObject('root',Nil); end; class function TTestBinaryFormatter.GetFormaterName(): string; begin Result := 'wst-binary'; end; procedure TTestBinaryFormatter.test_WriteBuffer(); var bw : IDataStore; br : IDataStoreReader; f : IFormatterBase; strm : TStringStream; a, b, tmp : PDataBuffer; locBuffer : string; begin a := CreateObjBuffer(dtObject,'a',nil); CreateObjBuffer(dtAnsiString,'aa',a)^.AnsiStrData^.Data := 'val_aa'; tmp := CreateObjBuffer(dtObject,'b',a); tmp := CreateObjBuffer(dtObject,'c',tmp); CreateObjBuffer(dtInt32U,'i',tmp)^.Int32S := 1210; CreateObjBuffer(dtAnsiString,'s',tmp)^.AnsiStrData^.Data := 's string sample'; b := nil; strm := TStringStream.Create(''); try bw := CreateBinaryWriter(strm); SaveObjectToStream(a,bw); strm.Position := 0; locBuffer := strm.DataString; f := TBaseBinaryFormatter.Create() as IFormatterBase; //f.BeginObject('Root',TypeInfo(TClass_A)); //done in the constructor! f.WriteBuffer(locBuffer); //f.EndScope(); strm.Size := 0; f.SaveToStream(strm); strm.Position := 0; br := CreateBinaryReader(strm); b := LoadObjectFromStream(br); Check(CompareNodes(a,b^.ObjectData^.Head^.Data)); finally strm.Free(); FreeObjectBuffer(a); FreeObjectBuffer(b); end; end; { TTestSOAPFormatter } function TTestSOAPFormatter.CreateFormatter(ARootType : PTypeInfo):IFormatterBase; begin Result := TSOAPBaseFormatter.Create() as IFormatterBase; Result.BeginObject('Env',ARootType) end; procedure TTestSOAPFormatter.do_test_Object(const AProps, AFilename: string); const DATE_VALUE = 39000; DATETIME_VALUE = 39000.1234; TIME_VALUE = '01:23:45.789Z'; Var f : IFormatterBase; s : TMemoryStream; a : TClass_B; x : string; begin s := Nil; a := TClass_B.Create(); Try a.Val_Bool := False; a.Val_Enum := teThree; a.Val_String := '123'; a.Val_WideString := 'wide123'; {$IFDEF WST_UNICODESTRING} a.Val_UnicodeString := 'unicode123'; {$ENDIF WST_UNICODESTRING} a.ObjProp.Val_String := '456'; a.ObjProp.Val_WideString := 'wide456'; a.ObjProp.Val_DateTime.AsDate := DATETIME_VALUE; a.ObjProp.Val_Date.AsDate := DATE_VALUE; a.ObjProp.Val_Time.AsString := TIME_VALUE; {$IFDEF WST_UNICODESTRING} a.ObjProp.Val_UnicodeString := 'unicode456'; {$ENDIF WST_UNICODESTRING} a.ObjProp.Val_Enum := teFour; a.ObjProp.Val_Bool := True; a.ObjProp.Val_32S := 121076; a.NonStored := 121076; f := CreateFormatter(TypeInfo(TClass_B)); f.GetPropertyManager().SetProperties(AProps); f.BeginObject('Root',TypeInfo(TClass_B)); f.Put('o1',TypeInfo(TClass_B),a); f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); FreeAndNil(a); //if not IsStrEmpty(AFilename) then //s.SaveToFile(wstExpandLocalFileName(AFilename)); a := TClass_B.Create(); f := CreateFormatter(TypeInfo(TClass_B)); f.GetPropertyManager().SetProperties(AProps); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'o1'; f.Get(TypeInfo(TClass_B),x,a); f.EndScopeRead(); CheckEquals(False,a.Val_Bool); CheckEquals(Ord(teThree),Ord(a.Val_Enum)); CheckEquals('123',a.Val_String); CheckEquals(WideString('wide123'),a.Val_WideString); {$IFDEF WST_UNICODESTRING} CheckEquals('unicode123',a.Val_UnicodeString); {$ENDIF WST_UNICODESTRING} CheckEquals(True,a.ObjProp.Val_Bool); CheckEquals(Ord(teFour),Ord(a.ObjProp.Val_Enum)); CheckEquals('456',a.ObjProp.Val_String); CheckEquals(WideString('wide456'),a.ObjProp.Val_WideString); CheckEquals(TDateTimeRemotable.ToStr(DATETIME_VALUE),TDateTimeRemotable.ToStr(a.ObjProp.Val_DateTime.AsDate)); CheckEquals(TDateRemotable.ToStr(DATE_VALUE),TDateRemotable.ToStr(a.ObjProp.Val_Date.AsDate)); {$IFDEF WST_UNICODESTRING} CheckEquals('unicode456',a.ObjProp.Val_UnicodeString); {$ENDIF WST_UNICODESTRING} CheckEquals(121076,a.ObjProp.Val_32S); CheckEquals(0,a.NonStored); Finally a.Free(); s.Free(); End; end; class function TTestSOAPFormatter.GetFormaterName(): string; begin Result := 'SOAP'; end; class function TTestSOAPFormatter.SupportNamedArrayItem() : Boolean; begin Result := True; end; procedure TTestSOAPFormatter.test_WriteBuffer(); const s_XML_BUFFER : AnsiString = ' ' + ' ' + ' ' + ' ' + ' -76 ' + ' wst record sample ' + ' ' + ' ' + ''; var f : IFormatterBase; strm : TMemoryStream; da, db : TXMLDocument; begin f := TSOAPBaseFormatter.Create() as IFormatterBase; f.BeginObject('Root',TypeInfo(TClass_A)); f.WriteBuffer(s_XML_BUFFER); f.EndScope(); da := nil; db := nil; strm := TMemoryStream.Create(); try f.SaveToStream(strm); strm.Position := 0; ReadXMLFile(da,strm); strm.Size := 0; strm.WriteBuffer(s_XML_BUFFER[1],Length(s_XML_BUFFER)); strm.Position := 0; ReadXMLFile(db,strm); Check(CompareNodes(da.DocumentElement.FirstChild,db.DocumentElement)); finally ReleaseDomNode(da); ReleaseDomNode(db); strm.Free(); end; end; procedure TTestSOAPFormatter.test_ReadBuffer(); function SpecialTrim(const AInStr : string) : string; var k : Integer; begin Result := ''; if ( Length(AInStr) > 0 ) then begin for k := 1 to Length(AInStr) do begin if ( AnsiChar(AInStr[k]) in ['a'..'z','A'..'Z','0'..'9',':','<','>'] ) then Result := Result + AInStr[k]; end; end; end; const {$IFDEF FPC} s_XML_BUFFER : AnsiString = ' ' + ' 1 ' + ' 0 ' + ' SampleStringContent ' + ''; {$ENDIF FPC} {$IFDEF DELPHI} s_XML_BUFFER : AnsiString = ' ' + ' 1 ' + ' 0 ' + ' SampleStringContent ' + ''; {$ENDIF DELPHI} var f : IFormatterBase; strm : TMemoryStream; obj2 : TTestSmallClass2; obj : TTestSmallClass; strName, strBuffer : string; begin strm := nil; obj := nil; obj := TTestSmallClass.Create(); try obj2 := TTestSmallClass2.Create(); obj2.fieldString := 'wst 123'; obj2.ObjProperty := obj; obj.fieldSmallint := 1; obj.fieldString := 'fpc'; obj.fieldString := 'SampleStringContent'; f := TSOAPBaseFormatter.Create() as IFormatterBase; f.GetPropertyManager().SetProperty('Style','Document'); f.BeginObject('Root',TypeInfo(TClass_A)); f.Put('inst',TypeInfo(TTestSmallClass2),obj2); f.EndScope(); strm := TMemoryStream.Create(); f.SaveToStream(strm); f := TSOAPBaseFormatter.Create() as IFormatterBase; f.GetPropertyManager().SetProperty('Style','Document'); strm.Position := 0; f.LoadFromStream(strm); strName := 'Root'; f.BeginObjectRead(strName,TypeInfo(TClass_A)); strName := 'inst'; f.BeginObjectRead(strName,TypeInfo(TTestSmallClass2)); Check(f.ReadBuffer('ObjProperty',strBuffer)); f.EndScopeRead(); f.EndScopeRead(); CheckEquals(SpecialTrim(s_XML_BUFFER),SpecialTrim(strBuffer)); finally FreeAndNil(obj2); FreeAndNil(obj); FreeAndNil(strm); end; end; procedure TTestSOAPFormatter.test_Object_DocumentLiteral(); begin do_test_Object('Style=Document;EncodingStyle=Literal','test_Object_DocumentLiteral.xml'); end; procedure TTestSOAPFormatter.test_Object_DocumentEncoded(); begin do_test_Object('Style=Document;EncodingStyle=Encoded','test_Object_DocumentEncoded.xml'); end; procedure TTestSOAPFormatter.test_Object_RPCLiteral(); begin do_test_Object('Style=RPC;EncodingStyle=Literal','test_Object_RPCLiteral.xml'); end; procedure TTestSOAPFormatter.test_Object_RPCEncoded(); begin do_test_Object('Style=RPC;EncodingStyle=Encoded','test_Object_RPCEncoded.xml'); end; { TClass_A_Array } function TClass_A_Array.GetItem(AIndex: Integer): TClass_A; begin Result := TClass_A(Inherited GetItem(AIndex)); end; class function TClass_A_Array.GetItemClass(): TBaseRemotableClass; begin Result:= TClass_A; end; { TClass_A_Collection } function TClass_A_Collection.GetItem(AIndex: Integer): TClass_A; begin Result := TClass_A(Inherited GetItem(AIndex)); end; class function TClass_A_Collection.GetItemClass(): TBaseRemotableClass; begin Result:= TClass_A; end; function TClass_A_Collection.Add() : TClass_A; begin Result := TClass_A(inherited Add()); end; function TClass_A_Collection.AddAt(const APosition : Integer) : TClass_A; begin Result := TClass_A(inherited AddAt(APosition)); end; { TClass_B } procedure TClass_B.SetObjProp(const AValue: TClass_A); begin FObjProp.Assign(AValue); end; constructor TClass_B.Create(); begin inherited Create(); FObjProp := TClass_A.Create(); end; procedure TClass_B.FreeObjectProperties(); begin FreeAndNil(FObjProp); inherited FreeObjectProperties(); end; { TTestArray } procedure TTestArray.Test_StringArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of string = ('AzErTy','QwErTy','123456','','1'); var a : TArrayOfStringRemotable; i, j : Integer; begin a := TArrayOfStringRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(String))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(String))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do CheckEquals(VAL_AR[j],a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_BooleanArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Boolean = (True,True,False,True,False); var a : TArrayOfBooleanRemotable; i, j : Integer; begin a := TArrayOfBooleanRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(Boolean))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(Boolean))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do CheckEquals(VAL_AR[j],a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_Int8UArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Byte = (12,34,100,200,180); var a : TArrayOfInt8URemotable; i, j : Integer; begin a := TArrayOfInt8URemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(Byte))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(Byte))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do CheckEquals(VAL_AR[j],a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_Int8SArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of ShortInt = (-12,-34,100,120,110); var a : TArrayOfInt8SRemotable; i, j : Integer; begin a := TArrayOfInt8SRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(ShortInt))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(ShortInt))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do CheckEquals(VAL_AR[j],a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_Int16SArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of SmallInt = (-12,-34,100,200,180); var a : TArrayOfInt16SRemotable; i, j : Integer; begin a := TArrayOfInt16SRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(SmallInt))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(SmallInt))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do CheckEquals(VAL_AR[j],a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_Int16UArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Word = (12,4,100,200,180); var a : TArrayOfInt16URemotable; i, j : Integer; begin a := TArrayOfInt16URemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(Word))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(Word))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do CheckEquals(VAL_AR[j],a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_Int32UArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of LongWord = (12,4,100,200,180); var a : TArrayOfInt32URemotable; i, j : Integer; begin a := TArrayOfInt32URemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(LongWord))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(LongWord))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do Check(VAL_AR[j]=a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_Int32SArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of LongInt = (-12,-34,100,200,180); var a : TArrayOfInt32SRemotable; i, j : Integer; begin a := TArrayOfInt32SRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(LongInt))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(LongInt))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do CheckEquals(VAL_AR[j],a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_Int64SArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Int64 = (-12,-34,100,200,180); var a : TArrayOfInt64SRemotable; i, j : Integer; begin a := TArrayOfInt64SRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(Int64))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(Int64))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do CheckEquals(VAL_AR[j],a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_Int64UArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of QWord = (12,4,100,200,180); var a : TArrayOfInt64URemotable; i, j : Integer; begin a := TArrayOfInt64URemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(QWord))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(QWord))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do Check(VAL_AR[j]=a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_FloatSingleArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Single = (-12.10,-4.45,100,200.58,180.3); var a : TArrayOfFloatSingleRemotable; i, j : Integer; begin a := TArrayOfFloatSingleRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(Single))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(Single))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do Check(VAL_AR[j]=a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_FloatDoubleArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Double = (-12.10,-4.45,100,200.58,180.3); var a : TArrayOfFloatDoubleRemotable; i, j : Integer; begin a := TArrayOfFloatDoubleRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(Double))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(Double))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do Check(VAL_AR[j]=a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_FloatExtendedArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Extended = (-12.10,-4.45,100,200.58,180.3); var a : TArrayOfFloatExtendedRemotable; i, j : Integer; begin a := TArrayOfFloatExtendedRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(Extended))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(Extended))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do Check(VAL_AR[j]=a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; procedure TTestArray.Test_FloatCurrencyArray(); const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Currency = (-12.10,-4.45,100,200.58,180.3); var a : TArrayOfFloatCurrencyRemotable; i, j : Integer; begin a := TArrayOfFloatCurrencyRemotable.Create(); try CheckEquals(PTypeInfo(TypeInfo(Currency))^.Name,a.GetItemTypeInfo()^.Name,'TypeInfo'); CheckEquals(Ord(PTypeInfo(TypeInfo(Currency))^.Kind),Ord(a.GetItemTypeInfo()^.Kind),'TypeInfo'); CheckEquals(0,a.Length); a.SetLength(0); CheckEquals(0,a.Length); for i := 1 to AR_LEN do begin a.SetLength(i); CheckEquals(i,a.Length,'Length'); for j := 0 to Pred(i) do a[j] := VAL_AR[j]; for j := 0 to Pred(i) do Check(VAL_AR[j]=a[j],'Item'); end; a.SetLength(0); CheckEquals(0,a.Length); finally a.Free(); end; end; { TTest_TBaseComplexRemotable } procedure TTest_TBaseComplexRemotable.Test_Assign(); Var a,b : TClass_B; begin b := nil; a := TClass_B.Create(); Try a.Val_Bool := False; a.Val_Enum := teThree; a.Val_String := '123'; a.ObjProp.Val_String := '456'; a.ObjProp.Val_Enum := teFour; a.ObjProp.Val_Bool := True; a.ObjProp.Val_32S := 121076; a.NonStored := 121076; b := TClass_B.Create(); b.Assign(a); CheckEquals(a.Val_Bool,b.Val_Bool); CheckEquals(Ord(a.Val_Enum),Ord(b.Val_Enum)); CheckEquals(a.Val_String,b.Val_String); CheckEquals(a.ObjProp.Val_Bool,b.ObjProp.Val_Bool); CheckEquals(Ord(a.ObjProp.Val_Enum),Ord(b.ObjProp.Val_Enum)); CheckEquals(a.ObjProp.Val_String,a.ObjProp.Val_String); Finally a.Free(); b.Free(); End; end; { TTestSOAPFormatterAttributes } function TTestSOAPFormatterAttributes.CreateFormatter(ARootType: PTypeInfo): IFormatterBase; begin Result := TSOAPBaseFormatter.Create() as IFormatterBase; Result.BeginObject('Env',ARootType); Result.SetSerializationStyle(ssAttibuteSerialization); end; { TTestBinaryFormatterAttributes } function TTestBinaryFormatterAttributes.CreateFormatter(ARootType: PTypeInfo): IFormatterBase; begin Result := TBaseBinaryFormatter.Create() as IFormatterBase; //Result.BeginObject('Root',ARootType); Result.SetSerializationStyle(ssAttibuteSerialization); end; { TClass_CplxSimpleContent } constructor TClass_CplxSimpleContent.Create(); begin FVal_CplxInt64S := T_ComplexInt64SContent.Create(); FVal_CplxInt64U := T_ComplexInt64UContent.Create(); FVal_CplxInt32S := T_ComplexInt32SContent.Create(); FVal_CplxInt32U := T_ComplexInt32UContent.Create(); FVal_CplxInt16S := T_ComplexInt16SContent.Create(); FVal_CplxInt16U := T_ComplexInt16UContent.Create(); FVal_CplxInt8S := T_ComplexInt8SContent.Create(); FVal_CplxInt8U := T_ComplexInt8UContent.Create(); end; procedure TClass_CplxSimpleContent.FreeObjectProperties(); begin FreeAndNil(FVal_CplxEnum); FreeAndNil(FVal_CplxInt64S); FreeAndNil(FVal_CplxInt64U); FreeAndNil(FVal_CplxInt32U); FreeAndNil(FVal_CplxInt32S); FreeAndNil(FVal_CplxInt16U); FreeAndNil(FVal_CplxInt16S); FreeAndNil(FVal_CplxInt8U); FreeAndNil(FVal_CplxInt8S); FreeAndNil(FVal_CplxDouble); FreeAndNil(FVal_CplxExtended); FreeAndNil(FVal_CplxString); FreeAndNil(FVal_CplxWideString); {$IFDEF WST_UNICODESTRING} FreeAndNil(FVal_CplxUnicodeString); {$ENDIF WST_UNICODESTRING} inherited FreeObjectProperties(); end; { TTestXmlRpcFormatterAttributes } function TTestXmlRpcFormatterAttributes.CreateFormatter(ARootType: PTypeInfo): IFormatterBase; begin Result := TXmlRpcBaseFormatter.Create() as IFormatterBase; //Result.BeginObject('Env',ARootType) end; { TTestXmlRpcFormatter } function TTestXmlRpcFormatter.CreateFormatter(ARootType: PTypeInfo): IFormatterBase; begin Result := TXmlRpcBaseFormatter.Create() as IFormatterBase; end; class function TTestXmlRpcFormatter.GetFormaterName(): string; begin Result := 'XMLRPC'; end; function TTestXmlRpcFormatter.Support_ComplextType_with_SimpleContent(): Boolean; begin Result := False; end; function TTestXmlRpcFormatter.Support_nil(): Boolean; begin Result := False; end; procedure TTestXmlRpcFormatter.test_WriteBuffer(); const s_XML_BUFFER : AnsiString = ' ' + ' ' + ' ' + ' ' + ' -76 ' + ' wst record sample ' + ' ' + ' ' + ''; var f : IFormatterBase; strm : TMemoryStream; da, db : TXMLDocument; begin f := TXmlRpcBaseFormatter.Create() as IFormatterBase; f.BeginObject('Root',TypeInfo(TClass_A)); f.WriteBuffer(s_XML_BUFFER); f.EndScope(); da := nil; db := nil; strm := TMemoryStream.Create(); try f.SaveToStream(strm); strm.Position := 0; ReadXMLFile(da,strm); strm.Size := 0; strm.WriteBuffer(s_XML_BUFFER[1],Length(s_XML_BUFFER)); strm.Position := 0; ReadXMLFile(db,strm); Check(CompareNodes(da.DocumentElement.FirstChild,db.DocumentElement)); finally ReleaseDomNode(da); ReleaseDomNode(db); strm.Free(); end; end; procedure TTestXmlRpcFormatter.test_default_data_type(); const s_XML_BUFFER : ansistring = //'' + sLineBreak + '' + sLineBreak + ' ' + sLineBreak + ' o1' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + ' fieldSmallint' + sLineBreak + ' 123' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + ' fieldWord' + sLineBreak + ' 456' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + ' fieldString' + sLineBreak + ' fpc-wst' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + ' ' + sLineBreak + ''; var f : IFormatterBase; s : TMemoryStream; a : TTestSmallClass; x : string; begin s := Nil; a := TTestSmallClass.Create(); try f := CreateFormatter(TypeInfo(TClass_B)); s := TMemoryStream.Create(); s.Write(s_XML_BUFFER[1],Length(s_XML_BUFFER)); s.Position := 0; f.LoadFromStream(s); x := 'Root'; f.BeginObjectRead(x,TypeInfo(TClass_B)); x := 'o1'; f.Get(TypeInfo(TTestSmallClass),x,a); f.EndScopeRead(); CheckEquals(123,a.fieldSmallint); CheckEquals(456,a.fieldWord); CheckEquals('fpc-wst',a.fieldString); finally a.Free(); s.Free(); end; end; { TTest_SoapFormatterExceptionBlock } function TTest_SoapFormatterExceptionBlock.CreateFormatter() : IFormatterResponse; begin Result := server_service_soap.TSOAPFormatter.Create() as IFormatterResponse; end; function TTest_SoapFormatterExceptionBlock.CreateFormatterClient() : IFormatterClient; begin Result := soap_formatter.TSOAPFormatter.Create() as IFormatterClient; end; function FindAttributeByValueInNode( const AAttValue : string; const ANode : TDOMNode; out AResAtt : string ):boolean; Var i,c : Integer; begin AResAtt := ''; if Assigned(ANode) and Assigned(ANode.Attributes) and ( ANode.Attributes.Length > 0 ) then begin c := Pred(ANode.Attributes.Length); For i := 0 To c Do Begin If AnsiSameText(AAttValue,ANode.Attributes.Item[i].NodeValue) Then Begin AResAtt := ANode.Attributes.Item[i].NodeName; Result := True; Exit; End; End; end; Result := False; end; procedure TTest_SoapFormatterExceptionBlock.ExceptBlock_server(); const VAL_CODE = 'Server.CustomCode.Test'; VAL_MSG = 'This is a sample exception message.'; var f : IFormatterResponse; strm : TMemoryStream; envNd : TDOMElement; bdyNd, fltNd, tmpNode : TDOMNode; nsShortName,eltName, msgBuff : string; doc : TXMLDocument; begin f := CreateFormatter(); f.BeginExceptionList(VAL_CODE,VAL_MSG); f.EndExceptionList(); strm := TMemoryStream.Create(); try f.SaveToStream(strm); strm.Position := 0; ReadXMLFile(doc,strm); if FindAttributeByValueInNode(sSOAP_ENV,doc.DocumentElement,nsShortName) or FindAttributeByValueInNode('"' + sSOAP_ENV + '"',doc.DocumentElement,nsShortName) then begin nsShortName := Copy(nsShortName,1 + Pos(':',nsShortName),MaxInt); if not IsStrEmpty(nsShortName) then nsShortName := nsShortName + ':'; end else begin nsShortName := ''; end; eltName := nsShortName + sENVELOPE; envNd := doc.DocumentElement; if not SameText(eltName,envNd.NodeName) then check(False,Format('XML root node must be "Envelope", found : "%s"',[envNd.NodeName + ':::' + nsShortName])); bdyNd := envNd.FirstChild; if not Assigned(bdyNd) then check(False,'Node not found : "Body".'); eltName := nsShortName + 'Body'; if not SameText(bdyNd.NodeName,eltName) then begin check(False,'Node not found : "Body".'); end; bdyNd := envNd.FirstChild; If Not Assigned(bdyNd) Then check(False,'Node not found : "Body"'); If Not SameText(bdyNd.NodeName,eltName) Then bdyNd := bdyNd.NextSibling; If Not Assigned(bdyNd) Then Check(False,'Node not found : "Body"'); If Not Assigned(bdyNd.FirstChild) Then Check(False,'Response Node not found'); eltName := nsShortName + 'Fault'; if SameText(eltName,bdyNd.FirstChild.NodeName) then begin fltNd := bdyNd.FirstChild; eltName := 'faultcode'; tmpNode := FindNode(fltNd,eltName); if not Assigned(tmpNode) then Check(False,Format('"%s" Node not found.',[eltName])); if tmpNode.HasChildNodes then msgBuff := tmpNode.FirstChild.NodeValue else msgBuff := tmpNode.NodeValue; CheckEquals(VAL_CODE,msgBuff,eltName); eltName := 'faultstring'; tmpNode := FindNode(fltNd,eltName); if not Assigned(tmpNode) then Check(False,Format('"%s" Node not found.',[eltName])); if tmpNode.HasChildNodes then msgBuff := tmpNode.FirstChild.NodeValue else msgBuff := tmpNode.NodeValue; CheckEquals(VAL_MSG,msgBuff,eltName); end; finally FreeAndNil(strm); end; end; procedure TTest_SoapFormatterExceptionBlock.ExceptBlock_client(); const VAL_CODE = 'Server.CustomCode.Test'; VAL_MSG = 'This is a sample exception message.'; VAL_STREAM = ' '+ ' ' + ' '+ ' '+ ' ' + VAL_CODE + ' '+ ' ' + VAL_MSG +' '+ ' '+ ' '+ ' '; var f : IFormatterClient; strm : TStringStream; excpt_code, excpt_msg : string; begin excpt_code := ''; excpt_msg := ''; f := CreateFormatterClient(); strm := TStringStream.Create(VAL_STREAM); try strm.Position := 0; f.LoadFromStream(strm); try f.BeginCallRead(nil); Check(False,'BeginCallRead() should raise an exception.'); except on e : ESOAPException do begin excpt_code := e.FaultCode; excpt_msg := e.FaultString; end; end; CheckEquals(VAL_CODE,excpt_code,'faultCode'); CheckEquals(VAL_MSG,excpt_msg,'faultString'); finally FreeAndNil(strm); end; end; procedure TTest_SoapFormatterExceptionBlock.client_keep_style(); const VAL_CODE = 'Server.CustomCode.Test'; VAL_MSG = 'This is a sample exception message.'; VAL_STREAM = ' '+ ' ' + ' '+ ' '+ ' ' + VAL_CODE + ' '+ ' ' + VAL_MSG +' '+ ' '+ ' '+ ' '; var f : IFormatterClient; strm : TStringStream; excpt_code, excpt_msg : string; begin excpt_code := ''; excpt_msg := ''; f := CreateFormatterClient(); f.GetPropertyManager().SetProperty('Style','Document'); CheckEquals('Document',f.GetPropertyManager().GetProperty('Style'),'Style'); strm := TStringStream.Create(VAL_STREAM); try strm.Position := 0; f.LoadFromStream(strm); try f.BeginCallRead(nil); Check(False,'BeginCallRead() should raise an exception.'); except on e : ESOAPException do begin excpt_code := e.FaultCode; excpt_msg := e.FaultString; end; end; CheckEquals(VAL_CODE,excpt_code,'faultCode'); CheckEquals(VAL_MSG,excpt_msg,'faultString'); CheckEquals('Document',f.GetPropertyManager().GetProperty('Style'),'Style'); f := CreateFormatterClient(); f.GetPropertyManager().SetProperty('Style','RPC'); CheckEquals('RPC',f.GetPropertyManager().GetProperty('Style'),'Style'); strm.Position := 0; f.LoadFromStream(strm); try f.BeginCallRead(nil); Check(False,'BeginCallRead() should raise an exception.'); except on e : ESOAPException do begin excpt_code := e.FaultCode; excpt_msg := e.FaultString; end; end; CheckEquals(VAL_CODE,excpt_code,'faultCode'); CheckEquals(VAL_MSG,excpt_msg,'faultString'); CheckEquals('RPC',f.GetPropertyManager().GetProperty('Style'),'Style'); finally FreeAndNil(strm); end; end; {$IFDEF WST_RECORD_RTTI} function __TTestSmallRecord_TYPEINFO_FUNC__() : PTypeInfo; var p : ^TTestSmallRecord; r : TTestSmallRecord; begin p := @r; Result := MakeRawTypeInfo( 'TTestSmallRecord', SizeOf(TTestSmallRecord), [ PtrUInt(@(p^.fieldSmallint)) - PtrUInt(p), PtrUInt(@(p^.fieldWord)) - PtrUInt(p), PtrUInt(@(p^.fieldString)) - PtrUInt(p) ], [ TypeInfo(SmallInt), TypeInfo(Word), TypeInfo(String) ] ); end; {$ENDIF WST_RECORD_RTTI} {$IFDEF WST_RECORD_RTTI} function __TTestRecord_TYPEINFO_FUNC__() : PTypeInfo; var p : ^TTestRecord; r : TTestRecord; begin p := @r; Result := MakeRawTypeInfo( 'TTestRecord', SizeOf(TTestRecord), [ PtrUInt(@(p^.fieldByte)) - PtrUInt(p), PtrUInt(@(p^.fieldShortInt)) - PtrUInt(p), PtrUInt(@(p^.fieldSmallint)) - PtrUInt(p), PtrUInt(@(p^.fieldWord)) - PtrUInt(p), PtrUInt(@(p^.fieldInteger)) - PtrUInt(p), PtrUInt(@(p^.fieldLongWord)) - PtrUInt(p), PtrUInt(@(p^.fieldInt64)) - PtrUInt(p), PtrUInt(@(p^.fieldQWord)) - PtrUInt(p), PtrUInt(@(p^.fieldComp)) - PtrUInt(p), PtrUInt(@(p^.fieldSingle)) - PtrUInt(p), PtrUInt(@(p^.fieldDouble)) - PtrUInt(p), PtrUInt(@(p^.fieldExtended)) - PtrUInt(p), PtrUInt(@(p^.fieldCurrency)) - PtrUInt(p), PtrUInt(@(p^.fieldBoolean)) - PtrUInt(p), PtrUInt(@(p^.fieldString)) - PtrUInt(p), PtrUInt(@(p^.fieldRecord)) - PtrUInt(p) ], [ TypeInfo(Byte), TypeInfo(ShortInt), TypeInfo(SmallInt), TypeInfo(Word), TypeInfo(Integer), TypeInfo(LongWord), TypeInfo(Int64), TypeInfo(QWord), TypeInfo(Comp), TypeInfo(Single), TypeInfo(Double), TypeInfo(Extended), TypeInfo(Currency), TypeInfo(Boolean), TypeInfo(String), TypeInfo(TTestSmallRecord) ] ); end; {$ENDIF WST_RECORD_RTTI} procedure TTest_SoapFormatterExceptionBlock.SetUp(); begin inherited; {$IFNDEF FPC} CoInitialize(nil); {$ENDIF} end; procedure TTest_SoapFormatterExceptionBlock.TearDown(); begin {$IFNDEF FPC} CoUninitialize(); {$ENDIF} inherited; end; { TTest_XmlRpcFormatterExceptionBlock } procedure TTest_XmlRpcFormatterExceptionBlock.SetUp(); begin inherited; {$IFNDEF FPC} CoInitialize(nil); {$ENDIF} end; procedure TTest_XmlRpcFormatterExceptionBlock.TearDown(); begin {$IFNDEF FPC} CoUninitialize(); {$ENDIF} inherited; end; function TTest_XmlRpcFormatterExceptionBlock.CreateFormatter() : IFormatterResponse; begin Result := server_service_xmlrpc.TXmlRpcFormatter.Create() as IFormatterResponse; end; function TTest_XmlRpcFormatterExceptionBlock.CreateFormatterClient() : IFormatterClient; begin Result := xmlrpc_formatter.TXmlRpcFormatter.Create() as IFormatterClient; end; procedure TTest_XmlRpcFormatterExceptionBlock.ExceptBlock_server(); function loc_FindNode(AScope : TDOMNode; const ANodeName: string): TDOMNode; var memberNode, tmpNode : TDOMNode; i : Integer; chilNodes : TDOMNodeList; nodeFound : Boolean; begin Result := nil; if AScope.HasChildNodes() then begin nodeFound := False; memberNode := AScope.FirstChild; while ( not nodeFound ) and ( memberNode <> nil ) do begin if memberNode.HasChildNodes() then begin chilNodes := memberNode.ChildNodes; for i := 0 to Pred(GetNodeListCount(chilNodes)) do begin tmpNode := chilNodes.Item[i]; if AnsiSameText(sNAME,tmpNode.NodeName) and ( tmpNode.FirstChild <> nil ) and AnsiSameText(ANodeName,tmpNode.FirstChild.NodeValue) then begin nodeFound := True; Break; end; end; if nodeFound then begin tmpNode := FindNode(memberNode,sVALUE); if ( tmpNode <> nil ) and ( tmpNode.FirstChild <> nil ) then begin Result := tmpNode.FirstChild; Break; end; end; end; memberNode := memberNode.NextSibling; end; end; end; const VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.'; var f : IFormatterResponse; strm : TMemoryStream; callNode : TDOMElement; faultNode, faultStruct, tmpNode : TDOMNode; doc : TXMLDocument; excpt_code, excpt_msg : string; begin f := CreateFormatter(); f.BeginExceptionList(VAL_CODE,VAL_MSG); f.EndExceptionList(); strm := TMemoryStream.Create(); try f.SaveToStream(strm); strm.Position := 0; ReadXMLFile(doc,strm); callNode := doc.DocumentElement; if not SameText(base_xmlrpc_formatter.sMETHOD_RESPONSE,callNode.NodeName) then Check(False,Format('XML root node must be "%s".',[base_xmlrpc_formatter.sMETHOD_RESPONSE])); faultNode := FindNode(callNode,base_xmlrpc_formatter.sFAULT); if ( faultNode = nil ) then begin Check(False,Format('Invalid XmlRPC response message, "%s" or "%s" are not present.',[base_xmlrpc_formatter.sPARAMS,base_xmlrpc_formatter.sFAULT])); end; tmpNode := FindNode(faultNode,base_xmlrpc_formatter.sVALUE); if ( tmpNode = nil ) then begin Check(False,Format('Invalid XmlRPC fault response message, "%s" is not present.',[base_xmlrpc_formatter.sVALUE])); end; faultStruct := FindNode(tmpNode,XmlRpcDataTypeNames[xdtStruct]); if ( faultStruct = nil ) then begin Check(False,Format('Invalid XmlRPC fault response message, "%s" is not present.',[XmlRpcDataTypeNames[xdtStruct]])); end; tmpNode := loc_FindNode(faultStruct,base_xmlrpc_formatter.sFAULT_CODE); if ( tmpNode = nil ) then begin Check(False,Format('Invalid XmlRPC fault response message, "%s" is not present.',[base_xmlrpc_formatter.sFAULT_CODE])); end; excpt_code := tmpNode.FirstChild.NodeValue; CheckEquals(VAL_CODE,excpt_code,base_xmlrpc_formatter.sFAULT_STRING); tmpNode := loc_FindNode(faultStruct,base_xmlrpc_formatter.sFAULT_STRING); if ( tmpNode = nil ) then begin Check(False,Format('Invalid XmlRPC fault response message, "%s" is not present.',[base_xmlrpc_formatter.sFAULT_STRING])); end; excpt_msg := tmpNode.FirstChild.NodeValue; CheckEquals(VAL_MSG,excpt_msg,base_xmlrpc_formatter.sFAULT_STRING); finally FreeAndNil(strm); end; end; procedure TTest_XmlRpcFormatterExceptionBlock.ExceptBlock_client(); const VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.'; VAL_STREAM = ' ' + ' ' + ' ' + ' ' + ' ' + ' ' + ' faultCode ' + ' ' + ' ' + VAL_CODE + ' ' + ' ' + ' ' + ' ' + ' faultString ' + ' ' + ' ' + VAL_MSG + ' ' + ' ' + ' ' + ' ' + ' ' + ' ' + ' '; var f : IFormatterClient; strm : TStringStream; excpt_code, excpt_msg : string; begin excpt_code := ''; excpt_msg := ''; f := CreateFormatterClient(); strm := TStringStream.Create(VAL_STREAM); try strm.Position := 0; f.LoadFromStream(strm); try f.BeginCallRead(nil); Check(False,'BeginCallRead() should raise an exception.'); except on e : EXmlRpcException do begin excpt_code := e.FaultCode; excpt_msg := e.FaultString; end; end; CheckEquals(VAL_CODE,excpt_code,'faultCode'); CheckEquals(VAL_MSG,excpt_msg,'faultString'); finally FreeAndNil(strm); end; end; { TTest_BinaryFormatterExceptionBlock } function TTest_BinaryFormatterExceptionBlock.CreateFormatter() : IFormatterResponse; begin Result := server_binary_formatter.TBinaryFormatter.Create() as IFormatterResponse; end; function TTest_BinaryFormatterExceptionBlock.CreateFormatterClient() : IFormatterClient; begin Result := binary_formatter.TBinaryFormatter.Create() as IFormatterClient; end; function loc_FindObj(const AOwner: PDataBuffer; const AName : TDataName) : PDataBuffer; Var p : PObjectBufferItem; Begin Assert(AOwner^.DataType >= dtObject); Result := Nil; p:= AOwner^.ObjectData^.Head; While Assigned(p) Do Begin If AnsiSameText(AName,p^.Data^.Name) Then Begin Result := p^.Data; Exit; End; p := p^.Next; End; End; procedure TTest_BinaryFormatterExceptionBlock.ExceptBlock_server(); const VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.'; var f : IFormatterResponse; strm : TMemoryStream; root, bodyNode, faultNode, tmpNode : PDataBuffer; excpt_code, excpt_msg : string; begin root := nil; f := CreateFormatter(); f.BeginExceptionList(VAL_CODE,VAL_MSG); f.EndExceptionList(); strm := TMemoryStream.Create(); try f.SaveToStream(strm); strm.Position := 0; root := LoadObjectFromStream(CreateBinaryReader(strm)); Check(Assigned(root)); CheckEquals(Ord(dtObject), Ord(root^.DataType),'root^.DataType'); Check(Assigned(root^.ObjectData),'root^.ObjectData'); CheckEquals(False,root^.ObjectData^.NilObject,'root^.NilObject'); Check(root^.ObjectData^.Count > 0, 'root^.Count'); bodyNode := root^.ObjectData^.Head^.Data; Check(Assigned(bodyNode),'body'); CheckEquals(Ord(dtObject), Ord(bodyNode^.DataType),'body.DataType'); CheckEquals(False,bodyNode^.ObjectData^.NilObject,'body.NilObject'); Check(bodyNode^.ObjectData^.Count > 0, 'body.Count'); faultNode := bodyNode^.ObjectData^.Head^.Data; Check(Assigned(faultNode),'fault'); CheckEquals(Ord(dtObject), Ord(faultNode^.DataType),'fault.DataType'); CheckEquals(False,faultNode^.ObjectData^.NilObject,'fault.NilObject'); Check(faultNode^.ObjectData^.Count > 0, 'fault.Count'); tmpNode := loc_FindObj(faultNode,'faultcode'); Check(Assigned(tmpNode),'faultcode'); CheckEquals(Ord(dtDefaultString), Ord(tmpNode^.DataType),'faultcode.DataType'); {$IF dtDefaultString = dtAnsiString } excpt_code := tmpNode^.AnsiStrData^.Data; {$ELSE} excpt_code := tmpNode^.UnicodeStrData^.Data; {$IFEND} CheckEquals(VAL_CODE,excpt_code,'faultCode'); tmpNode := loc_FindObj(faultNode,'faultstring'); Check(Assigned(tmpNode),'faultstring'); CheckEquals(Ord(dtDefaultString), Ord(tmpNode^.DataType),'faultstring.DataType'); {$IF dtDefaultString = dtAnsiString } excpt_msg := tmpNode^.AnsiStrData^.Data; {$ELSE} excpt_msg := tmpNode^.UnicodeStrData^.Data; {$IFEND} CheckEquals(VAL_MSG,excpt_msg,'faultString'); finally FreeAndNil(strm); FreeObjectBuffer(root); end; end; procedure TTest_BinaryFormatterExceptionBlock.ExceptBlock_client(); const VAL_CODE = '1210'; VAL_MSG = 'This is a sample exception message.'; var f : IFormatterClient; strm : TMemoryStream; root, bodyNode, faultNode : PDataBuffer; excpt_code, excpt_msg : string; locStore : IDataStore; begin excpt_code := ''; excpt_msg := ''; root := CreateObjBuffer(dtObject,'ROOT'); try bodyNode := CreateObjBuffer(dtObject,'Body',root); faultNode := CreateObjBuffer(dtObject,'Fault',bodyNode); CreateObjBuffer(dtAnsiString,'faultCode',faultNode)^.AnsiStrData^.Data := VAL_CODE; CreateObjBuffer(dtAnsiString,'faultString',faultNode)^.AnsiStrData^.Data := VAL_MSG; f := CreateFormatterClient(); strm := TMemoryStream.Create(); try locStore := CreateBinaryWriter(strm); SaveObjectToStream(root,locStore); locStore := nil; strm.Position := 0; f.LoadFromStream(strm); try f.BeginCallRead(nil); Check(False,'BeginCallRead() should raise an exception.'); except on e : EBinaryException do begin excpt_code := e.FaultCode; excpt_msg := e.FaultString; end; end; CheckEquals(VAL_CODE,excpt_code,'faultCode'); CheckEquals(VAL_MSG,excpt_msg,'faultString'); finally FreeAndNil(strm); end; finally FreeObjectBuffer(root); end; end; procedure TTestFormatter.test_GetFormaterName(); var f : IFormatterBase; begin f := CreateFormatter(TypeInfo(TClass_A)); CheckEquals(Self.GetFormaterName(),f.GetFormatName()); end; { TTest_TStringBufferRemotable } procedure TTest_TStringBufferRemotable.Assign(); const ITER = 100; var a, b : TStringBufferRemotable; i : Integer; begin b := nil; a := TStringBufferRemotable.Create(); try b := TStringBufferRemotable.Create(); CheckEquals(a.Data,b.Data); for i := 0 to ITER do begin a.Data := RandomValue(i); b.Assign(a); CheckEquals(a.Data,b.Data); end; a.Data := ''; b.Assign(a); CheckEquals(a.Data,b.Data); finally b.Free(); a.Free(); end; end; { TClass_A } constructor TClass_A.Create(); begin inherited Create(); FVal_DateTime := TDateTimeRemotable.Create(); FVal_Date := TDateRemotable.Create(); FVal_Time := TTimeRemotable.Create(); end; procedure TClass_A.FreeObjectProperties(); begin FreeAndNil(FVal_Time); FreeAndNil(FVal_Date); FreeAndNil(FVal_DateTime); inherited FreeObjectProperties(); end; initialization RegisterStdTypes(); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TTestEnum),'TTestEnum').RegisterExternalPropertyName('teOne', '1'); GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestEnum)].RegisterExternalPropertyName('teThree', 'Three-external-name'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_Int),'TClass_Int').RegisterExternalPropertyName('Val_8U','U8'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_Enum),'TClass_Enum'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_A),'TClass_A'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_A_Array),'TClass_A_Array'); GetTypeRegistry().ItemByTypeInfo[TypeInfo(TClass_A_Array)].RegisterExternalPropertyName(sARRAY_ITEM,'ArrayItem'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_A_Collection),'TClass_A_Collection'); GetTypeRegistry().ItemByTypeInfo[TypeInfo(TClass_A_Collection)].RegisterExternalPropertyName(sARRAY_ITEM,'Item'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_B),'TClass_B'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_Float),'TClass_Float'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt64SContent),'T_ComplexInt64SContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt64UContent),'T_ComplexInt64UContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt32SContent),'T_ComplexInt32SContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt32UContent),'T_ComplexInt32UContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt16SContent),'T_ComplexInt16SContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt16UContent),'T_ComplexInt16UContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8SContent),'T_ComplexInt8SContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexInt8UContent),'T_ComplexInt8UContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexTestEnumContent),'T_ComplexTestEnumContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatExtendedContent),'T_ComplexFloatExtendedContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexFloatDoubleContent),'T_ComplexFloatDoubleContent'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexStringContent)); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexWideStringContent)); {$IFDEF WST_UNICODESTRING} GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(T_ComplexUnicodeStringContent)); {$ENDIF WST_UNICODESTRING} TClass_CplxSimpleContent.RegisterAttributeProperty('Elt_Exemple'); GetTypeRegistry().Register(TEST_NAME_SPACE,TypeInfo(TClass_CplxSimpleContent),'TClass_CplxSimpleContent').RegisterExternalPropertyName('Elt_Exemple', 'published'); with GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TEmbeddedArrayOfStringRemotable),'TEmbeddedArrayOfStringRemotable') do begin RegisterExternalPropertyName(sARRAY_ITEM,'abc'); RegisterExternalPropertyName(sARRAY_STYLE,sEmbedded); end; with GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TArrayOfStringRemotableSample),'TArrayOfStringRemotableSample') do begin RegisterExternalPropertyName(sARRAY_ITEM,'OI'); RegisterExternalPropertyName(sARRAY_STYLE,sScoped); end; GetTypeRegistry.Register('uri:test-namespace',TypeInfo(TTestSmallClass2),'TTestSmallClass2'); GetTypeRegistry.Register('uri:test-namespace',TypeInfo(TTestSmallClass),'TTestSmallClass'); GetTypeRegistry.Register('uri:test-namespace',TypeInfo(TClassWithPropExtName),'TClassWithPropExtName'); GetTypeRegistry.ItemByTypeInfo[TypeInfo(TClassWithPropExtName)].RegisterExternalPropertyName('PropWithExtName','ExternalProperty'); GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TTestSmallRecord),'TTestSmallRecord').RegisterExternalPropertyName('__FIELDS__','fieldSmallint;fieldWord;fieldString'); {$IFNDEF WST_RECORD_RTTI} GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestSmallRecord)),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__'))); {$ENDIF WST_RECORD_RTTI} {$IFDEF WST_RECORD_RTTI} GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestSmallRecord_TYPEINFO_FUNC__()),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestSmallRecord)].GetExternalPropertyName('__FIELDS__'))); {$ENDIF WST_RECORD_RTTI} GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TTestRecord),'TTestRecord').RegisterExternalPropertyName('__FIELDS__','fieldByte;fieldShortInt;fieldSmallint;fieldWord;fieldInteger;fieldLongWord;fieldInt64;fieldQWord;fieldComp;fieldSingle;fieldDouble;fieldExtended;fieldCurrency;fieldBoolean;fieldString;fieldRecord'); {$IFNDEF WST_RECORD_RTTI} GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(TypeInfo(TTestRecord)),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestRecord)].GetExternalPropertyName('__FIELDS__'))); {$ENDIF WST_RECORD_RTTI} {$IFDEF WST_RECORD_RTTI} GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestRecord)].RegisterObject(FIELDS_STRING,TRecordRttiDataObject.Create(MakeRecordTypeInfo(__TTestRecord_TYPEINFO_FUNC__()),GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestRecord)].GetExternalPropertyName('__FIELDS__'))); {$ENDIF WST_RECORD_RTTI} RegisterAttributeProperty(TypeInfo(TTestSmallRecord),'fieldWord'); RegisterAttributeProperty(TypeInfo(TTestRecord),'fieldWord'); RegisterTest('Support',TTestArray.Suite); RegisterTest('Serializer',TTestSOAPFormatter.Suite); RegisterTest('Serializer',TTestBinaryFormatter.Suite); RegisterTest('Support',TTest_TBaseComplexRemotable.Suite); RegisterTest('Serializer',TTestSOAPFormatterAttributes.Suite); RegisterTest('Serializer',TTestBinaryFormatterAttributes.Suite); RegisterTest('Serializer',TTestXmlRpcFormatterAttributes.Suite); RegisterTest('Serializer',TTestXmlRpcFormatter.Suite); RegisterTest('Serializer',TTest_SoapFormatterExceptionBlock.Suite); RegisterTest('Serializer',TTest_XmlRpcFormatterExceptionBlock.Suite); RegisterTest('Serializer',TTest_BinaryFormatterExceptionBlock.Suite); RegisterTest('Serializer',TTest_TStringBufferRemotable.Suite); end.