1(* 2 * Licensed to the Apache Software Foundation (ASF) under one 3 * or more contributor license agreements. See the NOTICE file 4 * distributed with this work for additional information 5 * regarding copyright ownership. The ASF licenses this file 6 * to you under the Apache License, Version 2.0 (the 7 * "License"); you may not use this file except in compliance 8 * with the License. You may obtain a copy of the License at 9 * 10 * http://www.apache.org/licenses/LICENSE-2.0 11 * 12 * Unless required by applicable law or agreed to in writing, 13 * software distributed under the License is distributed on an 14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 15 * KIND, either express or implied. See the License for the 16 * specific language governing permissions and limitations 17 * under the License. 18 *) 19 20program TestSerializer; 21 22{$APPTYPE CONSOLE} 23 24uses 25 Classes, Windows, SysUtils, Generics.Collections, 26 Thrift in '..\..\src\Thrift.pas', 27 Thrift.Exception in '..\..\src\Thrift.Exception.pas', 28 Thrift.Socket in '..\..\src\Thrift.Socket.pas', 29 Thrift.Transport in '..\..\src\Thrift.Transport.pas', 30 Thrift.Protocol in '..\..\src\Thrift.Protocol.pas', 31 Thrift.Protocol.JSON in '..\..\src\Thrift.Protocol.JSON.pas', 32 Thrift.Protocol.Compact in '..\..\src\Thrift.Protocol.Compact.pas', 33 Thrift.Collections in '..\..\src\Thrift.Collections.pas', 34 Thrift.Server in '..\..\src\Thrift.Server.pas', 35 Thrift.Utils in '..\..\src\Thrift.Utils.pas', 36 Thrift.Serializer in '..\..\src\Thrift.Serializer.pas', 37 Thrift.Stream in '..\..\src\Thrift.Stream.pas', 38 Thrift.WinHTTP in '..\..\src\Thrift.WinHTTP.pas', 39 Thrift.TypeRegistry in '..\..\src\Thrift.TypeRegistry.pas', 40 System_, 41 DebugProtoTest, 42 TestSerializer.Data; 43 44 45 46type 47 TTestSerializer = class //extends TestCase { 48 private type 49 TMethod = ( 50 mt_Bytes, 51 mt_Stream 52 ); 53 54 private 55 FProtocols : TList< IProtocolFactory>; 56 57 class function Serialize(const input : IBase; const factory : IProtocolFactory) : TBytes; overload; 58 class procedure Serialize(const input : IBase; const factory : IProtocolFactory; const aStream : TStream); overload; 59 class procedure Deserialize( const input : TBytes; const target : IBase; const factory : IProtocolFactory); overload; 60 class procedure Deserialize( const input : TStream; const target : IBase; const factory : IProtocolFactory); overload; 61 62 procedure Test_Serializer_Deserializer; 63 procedure Test_OneOfEach( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream); 64 procedure Test_CompactStruct( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream); 65 66 public 67 constructor Create; 68 destructor Destroy; override; 69 70 procedure RunTests; 71 end; 72 73 74 75{ TTestSerializer } 76 77constructor TTestSerializer.Create; 78begin 79 inherited Create; 80 FProtocols := TList< IProtocolFactory>.Create; 81 FProtocols.Add( TBinaryProtocolImpl.TFactory.Create); 82 FProtocols.Add( TCompactProtocolImpl.TFactory.Create); 83 FProtocols.Add( TJSONProtocolImpl.TFactory.Create); 84end; 85 86 87destructor TTestSerializer.Destroy; 88begin 89 try 90 FreeAndNil( FProtocols); 91 finally 92 inherited Destroy; 93 end; 94end; 95 96 97procedure TTestSerializer.Test_OneOfEach( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream); 98var tested, correct : IOneOfEach; 99 bytes : TBytes; 100 i : Integer; 101begin 102 // write 103 tested := Fixtures.CreateOneOfEach; 104 case method of 105 mt_Bytes: bytes := Serialize( tested, factory); 106 mt_Stream: begin 107 stream.Size := 0; 108 Serialize( tested, factory, stream); 109 end 110 else 111 ASSERT( FALSE); 112 end; 113 114 // init + read 115 tested := TOneOfEachImpl.Create; 116 case method of 117 mt_Bytes: Deserialize( bytes, tested, factory); 118 mt_Stream: begin 119 stream.Position := 0; 120 Deserialize( stream, tested, factory); 121 end 122 else 123 ASSERT( FALSE); 124 end; 125 126 // check 127 correct := Fixtures.CreateOneOfEach; 128 ASSERT( tested.Im_true = correct.Im_true); 129 ASSERT( tested.Im_false = correct.Im_false); 130 ASSERT( tested.A_bite = correct.A_bite); 131 ASSERT( tested.Integer16 = correct.Integer16); 132 ASSERT( tested.Integer32 = correct.Integer32); 133 ASSERT( tested.Integer64 = correct.Integer64); 134 ASSERT( Abs( tested.Double_precision - correct.Double_precision) < 1E-12); 135 ASSERT( tested.Some_characters = correct.Some_characters); 136 ASSERT( tested.Zomg_unicode = correct.Zomg_unicode); 137 ASSERT( tested.What_who = correct.What_who); 138 139 ASSERT( Length(tested.Base64) = Length(correct.Base64)); 140 ASSERT( CompareMem( @tested.Base64[0], @correct.Base64[0], Length(correct.Base64))); 141 142 ASSERT( tested.Byte_list.Count = correct.Byte_list.Count); 143 for i := 0 to tested.Byte_list.Count-1 144 do ASSERT( tested.Byte_list[i] = correct.Byte_list[i]); 145 146 ASSERT( tested.I16_list.Count = correct.I16_list.Count); 147 for i := 0 to tested.I16_list.Count-1 148 do ASSERT( tested.I16_list[i] = correct.I16_list[i]); 149 150 ASSERT( tested.I64_list.Count = correct.I64_list.Count); 151 for i := 0 to tested.I64_list.Count-1 152 do ASSERT( tested.I64_list[i] = correct.I64_list[i]); 153end; 154 155 156procedure TTestSerializer.Test_CompactStruct( const method : TMethod; const factory : IProtocolFactory; const stream : TFileStream); 157var tested, correct : ICompactProtoTestStruct; 158 bytes : TBytes; 159begin 160 // write 161 tested := Fixtures.CreateCompactProtoTestStruct; 162 case method of 163 mt_Bytes: bytes := Serialize( tested, factory); 164 mt_Stream: begin 165 stream.Size := 0; 166 Serialize( tested, factory, stream); 167 end 168 else 169 ASSERT( FALSE); 170 end; 171 172 // init + read 173 correct := TCompactProtoTestStructImpl.Create; 174 case method of 175 mt_Bytes: Deserialize( bytes, tested, factory); 176 mt_Stream: begin 177 stream.Position := 0; 178 Deserialize( stream, tested, factory); 179 end 180 else 181 ASSERT( FALSE); 182 end; 183 184 // check 185 correct := Fixtures.CreateCompactProtoTestStruct; 186 ASSERT( correct.Field500 = tested.Field500); 187 ASSERT( correct.Field5000 = tested.Field5000); 188 ASSERT( correct.Field20000 = tested.Field20000); 189end; 190 191 192procedure TTestSerializer.Test_Serializer_Deserializer; 193var factory : IProtocolFactory; 194 stream : TFileStream; 195 method : TMethod; 196begin 197 stream := TFileStream.Create( 'TestSerializer.dat', fmCreate); 198 try 199 200 for method in [Low(TMethod)..High(TMethod)] do begin 201 for factory in FProtocols do begin 202 203 Test_OneOfEach( method, factory, stream); 204 Test_CompactStruct( method, factory, stream); 205 end; 206 end; 207 208 finally 209 stream.Free; 210 end; 211end; 212 213 214procedure TTestSerializer.RunTests; 215begin 216 try 217 Test_Serializer_Deserializer; 218 except 219 on e:Exception do begin 220 Writeln( e.Message); 221 Write('Hit ENTER to close ... '); Readln; 222 end; 223 end; 224end; 225 226 227class function TTestSerializer.Serialize(const input : IBase; const factory : IProtocolFactory) : TBytes; 228var serial : TSerializer; 229begin 230 serial := TSerializer.Create( factory); 231 try 232 result := serial.Serialize( input); 233 finally 234 serial.Free; 235 end; 236end; 237 238 239class procedure TTestSerializer.Serialize(const input : IBase; const factory : IProtocolFactory; const aStream : TStream); 240var serial : TSerializer; 241begin 242 serial := TSerializer.Create( factory); 243 try 244 serial.Serialize( input, aStream); 245 finally 246 serial.Free; 247 end; 248end; 249 250 251class procedure TTestSerializer.Deserialize( const input : TBytes; const target : IBase; const factory : IProtocolFactory); 252var serial : TDeserializer; 253begin 254 serial := TDeserializer.Create( factory); 255 try 256 serial.Deserialize( input, target); 257 finally 258 serial.Free; 259 end; 260end; 261 262class procedure TTestSerializer.Deserialize( const input : TStream; const target : IBase; const factory : IProtocolFactory); 263var serial : TDeserializer; 264begin 265 serial := TDeserializer.Create( factory); 266 try 267 serial.Deserialize( input, target); 268 finally 269 serial.Free; 270 end; 271end; 272 273 274var test : TTestSerializer; 275begin 276 test := TTestSerializer.Create; 277 try 278 test.RunTests; 279 finally 280 test.Free; 281 end; 282end. 283 284