THRIFT-4454 Large writes/reads may cause range check errors in debug mode
Client: Delphi
Patch: Jens Geyer

This closes #1466
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index 143611d..be6b8b5 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -71,6 +71,13 @@
     );
     TTestGroups = set of TTestGroup;
 
+    TTestSize = (
+      Empty,           // Edge case: the zero-length empty binary
+      Normal,          // Fairly small array of usual size (256 bytes)
+      ByteArrayTest,   // THRIFT-4454 Large writes/reads may cause range check errors in debug mode
+      PipeWriteLimit   // THRIFT-4372 Pipe write operations across a network are limited to 65,535 bytes per write.
+    );
+
   private
     FTransport : ITransport;
     FProtocol : IProtocol;
@@ -95,7 +102,7 @@
     {$ENDIF}
 
     procedure JSONProtocolReadWriteTest;
-    function  PrepareBinaryData( aRandomDist, aHuge : Boolean) : TBytes;
+    function  PrepareBinaryData( aRandomDist : Boolean; aSize : TTestSize) : TBytes;
     {$IFDEF StressTest}
     procedure StressTest(const client : TThriftTest.Iface);
     {$ENDIF}
@@ -467,6 +474,7 @@
   first_map : IThriftDictionary<TNumberz, IInsanity>;
   second_map : IThriftDictionary<TNumberz, IInsanity>;
   pair : TPair<TNumberz, TUserId>;
+  testsize : TTestSize;
 begin
   client := TThriftTest.TClient.Create( FProtocol);
   FTransport.Open;
@@ -559,42 +567,18 @@
   Expect( i64 = -34359738368, 'testI64(-34359738368) = ' + IntToStr( i64));
 
   // random binary small
-  binOut := PrepareBinaryData( TRUE, FALSE);
-  Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
-  try
-    binIn := client.testBinary(binOut);
-    Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
-    i32 := Min( Length(binOut), Length(binIn));
-    Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
-  except
-    on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
-    on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
-  end;
-
-  // random binary huge
-  binOut := PrepareBinaryData( TRUE, TRUE);
-  Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
-  try
-    binIn := client.testBinary(binOut);
-    Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
-    i32 := Min( Length(binOut), Length(binIn));
-    Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
-  except
-    on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
-    on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
-  end;
-
-  // empty binary
-  SetLength( binOut, 0);
-  Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
-  try
-    binIn := client.testBinary(binOut);
-    Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
-    i32 := Min( Length(binOut), Length(binIn));
-    Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
-  except
-    on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
-    on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
+  for testsize := Low(TTestSize) to High(TTestSize) do begin
+    binOut := PrepareBinaryData( TRUE, testsize);
+    Console.WriteLine('testBinary('+BytesToHex(binOut)+')');
+    try
+      binIn := client.testBinary(binOut);
+      Expect( Length(binOut) = Length(binIn), 'testBinary(): length '+IntToStr(Length(binOut))+' = '+IntToStr(Length(binIn)));
+      i32 := Min( Length(binOut), Length(binIn));
+      Expect( CompareMem( binOut, binIn, i32), 'testBinary('+BytesToHex(binOut)+') = '+BytesToHex(binIn));
+    except
+      on e:TApplicationException do Console.WriteLine('testBinary(): '+e.Message);
+      on e:Exception do Expect( FALSE, 'testBinary(): Unexpected exception "'+e.ClassName+'": '+e.Message);
+    end;
   end;
 
   Console.WriteLine('testDouble(5.325098235)');
@@ -1063,18 +1047,25 @@
 {$ENDIF}
 
 
-function TClientThread.PrepareBinaryData( aRandomDist, aHuge : Boolean) : TBytes;
+function TClientThread.PrepareBinaryData( aRandomDist : Boolean; aSize : TTestSize) : TBytes;
 var i : Integer;
 begin
-  if aHuge
-  then SetLength( result, $12345)  // tests for THRIFT-4372
-  else SetLength( result, $100);
+  case aSize of
+    Empty          : SetLength( result, 0);
+    Normal         : SetLength( result, $100);
+    ByteArrayTest  : SetLength( result, SizeOf(TByteArray) + 128);
+    PipeWriteLimit : SetLength( result, 65535 + 128);
+  else
+    raise EArgumentException.Create('aSize');
+  end;
+
   ASSERT( Low(result) = 0);
+  if Length(result) = 0 then Exit;
 
   // linear distribution, unless random is requested
   if not aRandomDist then begin
     for i := Low(result) to High(result) do begin
-      result[i] := i;
+      result[i] := i mod $100;
     end;
     Exit;
   end;
@@ -1129,7 +1120,7 @@
     StartTestGroup( 'JsonProtocolTest', test_Unknown);
 
     // prepare binary data
-    binary := PrepareBinaryData( FALSE, FALSE);
+    binary := PrepareBinaryData( FALSE, Normal);
     SetLength( emptyBinary, 0); // empty binary data block
 
     // output setup