(* * Licensed to the Apache Software Foundation (ASF) under one * or more contributor license agreements. See the NOTICE file * distributed with this work for additional information * regarding copyright ownership. The ASF licenses this file * to you under the Apache License, Version 2.0 (the * "License"); you may not use this file except in compliance * with the License. You may obtain a copy of the License at * * http://www.apache.org/licenses/LICENSE-2.0 * * Unless required by applicable law or agreed to in writing, * software distributed under the License is distributed on an * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY * KIND, either express or implied. See the License for the * specific language governing permissions and limitations * under the License. *) unit UnitTests; {$I ../src/Thrift.Defines.inc} interface uses Classes, Windows, SysUtils, Math, ActiveX, ComObj, {$IFDEF SupportsAsync} System.Threading, {$ENDIF} DateUtils, Generics.Collections, TestConstants, TestLogger, ConsoleHelper, Thrift, Thrift.Protocol.Compact, Thrift.Protocol.JSON, Thrift.Protocol, Thrift.Transport.Pipes, Thrift.Transport.WinHTTP, Thrift.Transport.MsxmlHTTP, Thrift.Transport, Thrift.Stream, Thrift.Test, Thrift.WinHTTP, Thrift.Utils, Thrift.Configuration, Thrift.Collections; type TQuickUnitTests = class sealed strict private FLogger : ITestLogger; strict protected // Helper procedure StartTestGroup( const aGroup : string; const aTest : TClientTestGroup); inline; procedure Expect( aTestResult : Boolean; const aTestInfo : string); inline; // Test impl procedure JSONProtocolReadWriteTest; procedure HashSetTest; {$IFDEF Win64} procedure UseInterlockedExchangeAdd64; {$ENDIF} // main execution part constructor Create( const logger : ITestLogger); reintroduce; procedure Execute; overload; public destructor Destroy; override; class procedure Execute( const logger : ITestLogger); overload; static; end; implementation constructor TQuickUnitTests.Create( const logger : ITestLogger); begin inherited Create; FLogger := logger; end; destructor TQuickUnitTests.Destroy; begin try FLogger := nil; //-> Release finally inherited Destroy; end; end; class procedure TQuickUnitTests.Execute( const logger : ITestLogger); var instance : TQuickUnitTests; begin instance := TQuickUnitTests.Create(logger); try instance.Execute; finally instance.Free; end; end; procedure TQuickUnitTests.Execute; begin {$IFDEF Win64} UseInterlockedExchangeAdd64; {$ENDIF} JSONProtocolReadWriteTest; HashSetTest; end; procedure TQuickUnitTests.StartTestGroup( const aGroup : string; const aTest : TClientTestGroup); begin FLogger.StartTestGroup( aGroup, aTest); end; procedure TQuickUnitTests.Expect( aTestResult : Boolean; const aTestInfo : string); begin FLogger.Expect( aTestResult, aTestInfo); end; {$IFDEF Win64} procedure TQuickUnitTests.UseInterlockedExchangeAdd64; var a,b : Int64; begin a := 1; b := 2; Thrift.Utils.InterlockedExchangeAdd64( a,b); Expect( a = 3, 'InterlockedExchangeAdd64'); end; {$ENDIF} procedure TQuickUnitTests.JSONProtocolReadWriteTest; // Tests only then read/write procedures of the JSON protocol // All tests succeed, if we can read what we wrote before // Note that passing this test does not imply, that our JSON is really compatible to what // other clients or servers expect as the real JSON. This is beyond the scope of this test. var prot : IProtocol; stm : TStringStream; list : TThriftList; config : IThriftConfiguration; binary, binRead, emptyBinary : TBytes; i,iErr : Integer; const TEST_SHORT = ShortInt( $FE); TEST_SMALL = SmallInt( $FEDC); TEST_LONG = LongInt( $FEDCBA98); TEST_I64 = Int64( $FEDCBA9876543210); TEST_DOUBLE = -1.234e-56; DELTA_DOUBLE = TEST_DOUBLE * 1e-14; TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars") // Test THRIFT-2336 and THRIFT-3404 with U+1D11E (G Clef symbol) and 'Русское Название'; G_CLEF_AND_CYRILLIC_TEXT = #$1d11e' '#$0420#$0443#$0441#$0441#$043a#$043e#$0435' '#$041d#$0430#$0437#$0432#$0430#$043d#$0438#$0435; G_CLEF_AND_CYRILLIC_JSON = '"\ud834\udd1e \u0420\u0443\u0441\u0441\u043a\u043e\u0435 \u041d\u0430\u0437\u0432\u0430\u043d\u0438\u0435"'; // test both possible solidus encodings SOLIDUS_JSON_DATA = '"one/two\/three"'; SOLIDUS_EXCPECTED = 'one/two/three'; begin stm := TStringStream.Create; try FLogger.StartTestGroup( 'JsonProtocolTest', test_Unknown); config := TThriftConfigurationImpl.Create; // prepare binary data binary := PrepareBinaryData( FALSE, TTestSize.Normal); SetLength( emptyBinary, 0); // empty binary data block // output setup prot := TJSONProtocolImpl.Create( TStreamTransportImpl.Create( nil, TThriftStreamAdapterDelphi.Create( stm, FALSE), config)); // write Init( list, TType.String_, 9); prot.WriteListBegin( list); prot.WriteBool( TRUE); prot.WriteBool( FALSE); prot.WriteByte( TEST_SHORT); prot.WriteI16( TEST_SMALL); prot.WriteI32( TEST_LONG); prot.WriteI64( TEST_I64); prot.WriteDouble( TEST_DOUBLE); prot.WriteString( TEST_STRING); prot.WriteBinary( binary); prot.WriteString( ''); // empty string prot.WriteBinary( emptyBinary); // empty binary data block prot.WriteListEnd; // input setup Expect( stm.Position = stm.Size, 'Stream position/length after write'); stm.Position := 0; prot := TJSONProtocolImpl.Create( TStreamTransportImpl.Create( TThriftStreamAdapterDelphi.Create( stm, FALSE), nil, config)); // read and compare list := prot.ReadListBegin; Expect( list.ElementType = TType.String_, 'list element type'); Expect( list.Count = 9, 'list element count'); Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE'); Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE'); Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte'); Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16'); Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32'); Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64'); Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble'); Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString'); binRead := prot.ReadBinary; Expect( Length(prot.ReadString) = 0, 'WriteString/ReadString (empty string)'); Expect( Length(prot.ReadBinary) = 0, 'empty WriteBinary/ReadBinary (empty data block)'); prot.ReadListEnd; // test binary data Expect( Length(binary) = Length(binRead), 'Binary data length check'); iErr := -1; for i := Low(binary) to High(binary) do begin if binary[i] <> binRead[i] then begin iErr := i; Break; end; end; if iErr < 0 then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)') else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr)); Expect( stm.Position = stm.Size, 'Stream position after read'); // Solidus can be encoded in two ways. Make sure we can read both stm.Position := 0; stm.Size := 0; stm.WriteString(SOLIDUS_JSON_DATA); stm.Position := 0; prot := TJSONProtocolImpl.Create( TStreamTransportImpl.Create( TThriftStreamAdapterDelphi.Create( stm, FALSE), nil, config)); Expect( prot.ReadString = SOLIDUS_EXCPECTED, 'Solidus encoding'); // Widechars should work too. Do they? // After writing, we ensure that we are able to read it back // We can't assume hex-encoding, since (nearly) any Unicode char is valid JSON stm.Position := 0; stm.Size := 0; prot := TJSONProtocolImpl.Create( TStreamTransportImpl.Create( nil, TThriftStreamAdapterDelphi.Create( stm, FALSE), config)); prot.WriteString( G_CLEF_AND_CYRILLIC_TEXT); stm.Position := 0; prot := TJSONProtocolImpl.Create( TStreamTransportImpl.Create( TThriftStreamAdapterDelphi.Create( stm, FALSE), nil, config)); FLogger.Expect( prot.ReadString = G_CLEF_AND_CYRILLIC_TEXT, 'Writing JSON with chars > 8 bit'); // Widechars should work with hex-encoding too. Do they? stm.Position := 0; stm.Size := 0; stm.WriteString( G_CLEF_AND_CYRILLIC_JSON); stm.Position := 0; prot := TJSONProtocolImpl.Create( TStreamTransportImpl.Create( TThriftStreamAdapterDelphi.Create( stm, FALSE), nil, config)); FLogger.Expect( prot.ReadString = G_CLEF_AND_CYRILLIC_TEXT, 'Reading JSON with chars > 8 bit'); finally stm.Free; prot := nil; //-> Release FLogger.StartTestGroup( '', test_Unknown); // no more tests here end; end; procedure TQuickUnitTests.HashSetTest; var container : IThriftHashSet; testdata : array of Integer; i : Integer; const TEST_COUNT = 4096; begin StartTestGroup( 'IThriftHashSet implementation', test_Containers); // prepare test data SetLength( testdata, 5); testdata[0] := -2; testdata[1] := 0; testdata[2] := 42; testdata[3] := MaxInt; testdata[4] := Low(Integer); // first insert container := TThriftHashSetImpl.Create; for i in testdata do begin Expect( container.Add( i), 'add first '+IntToStr(i)); Expect( container.Contains( i), 'contains '+IntToStr(i)); end; Expect( container.Count = Length(testdata), 'container size'); // insert again for i in testdata do begin Expect( not container.Add( i), 'add second '+IntToStr(i)); Expect( container.Contains( i), 'contains '+IntToStr(i)); end; Expect( container.Count = Length(testdata), 'container size'); // remove for i in testdata do begin Expect( container.Remove( i), 'first remove '+IntToStr(i)); Expect( not container.Contains( i), 'not contains '+IntToStr(i)); end; Expect( container.Count = 0, 'container size'); // remove again for i in testdata do begin Expect( not container.Remove( i), 'second remove '+IntToStr(i)); Expect( not container.Contains( i), 'not contains '+IntToStr(i)); end; Expect( container.Count = 0, 'container size'); // append and clear for i := 0 to TEST_COUNT-1 do begin container.Add(-i); container.Add(+i); end; Expect( container.Count = 2*TEST_COUNT-1, 'container size check'); Expect( not container.Contains( -TEST_COUNT), 'element not contained'); Expect( not container.Contains( TEST_COUNT), 'element not contained'); container.Clear; Expect( container.Count = 0, 'count=0 after clear'); end; end.