THRIFT-4422 Add Async implementation via IFuture
Client: Delphi
Patch: Jens Geyer

This closes #1444
diff --git a/compiler/cpp/src/thrift/generate/t_delphi_generator.cc b/compiler/cpp/src/thrift/generate/t_delphi_generator.cc
index 1894fe8..4650a8a 100644
--- a/compiler/cpp/src/thrift/generate/t_delphi_generator.cc
+++ b/compiler/cpp/src/thrift/generate/t_delphi_generator.cc
@@ -65,6 +65,7 @@
     constprefix_ = false;
     events_ = false;
     xmldoc_ = false;
+    async_ = false;
     for( iter = parsed_options.begin(); iter != parsed_options.end(); ++iter) {
       if( iter->first.compare("ansistr_binary") == 0) {
         ansistr_binary_ = true;
@@ -76,6 +77,8 @@
         events_ = true;
       } else if( iter->first.compare("xmldoc") == 0) {
         xmldoc_ = true;
+      } else if( iter->first.compare("async") == 0) {
+        async_ = true;
       } else {
         throw "unknown option delphi:" + iter->first;
       }
@@ -236,6 +239,7 @@
 
   void generate_function_helpers(t_function* tfunction);
   void generate_service_interface(t_service* tservice);
+  void generate_service_interface(t_service* tservice, bool for_async);
   void generate_service_helpers(t_service* tservice);
   void generate_service_client(t_service* tservice);
   void generate_service_server(t_service* tservice);
@@ -323,6 +327,7 @@
                             std::string prefix = "",
                             bool is_xception_class = false);
   std::string function_signature(t_function* tfunction,
+                                 bool for_async,
                                  std::string full_cls = "",
                                  bool is_xception = false);
   std::string argument_list(t_struct* tstruct);
@@ -399,6 +404,7 @@
   bool constprefix_;
   bool events_;
   bool xmldoc_;
+  bool async_;
   void indent_up_impl() { ++indent_impl_; };
   void indent_down_impl() { --indent_impl_; };
   std::string indent_impl() {
@@ -721,15 +727,19 @@
   has_enum = false;
   has_const = false;
   create_keywords();
+  
   add_delphi_uses_list("Classes");
   add_delphi_uses_list("SysUtils");
   add_delphi_uses_list("Generics.Collections");
+  if(async_) {
+    add_delphi_uses_list("System.Threading");
+  }
+  
   add_delphi_uses_list("Thrift");
   add_delphi_uses_list("Thrift.Utils");
   add_delphi_uses_list("Thrift.Collections");
   add_delphi_uses_list("Thrift.Protocol");
   add_delphi_uses_list("Thrift.Transport");
-
   if (register_types_) {
     add_delphi_uses_list("Thrift.TypeRegistry");
   }
@@ -1850,19 +1860,28 @@
 }
 
 void t_delphi_generator::generate_service_interface(t_service* tservice) {
+  generate_service_interface(tservice,false);
+  if(async_) {
+    generate_service_interface(tservice,true);
+  }
+}
+
+
+void t_delphi_generator::generate_service_interface(t_service* tservice, bool for_async) {
   string extends = "";
   string extends_iface = "";
+  string iface_name = for_async ? "IAsync" : "Iface";
 
   indent_up();
 
   generate_delphi_doc(s_service, tservice);
   if (tservice->get_extends() != NULL) {
     extends = type_name(tservice->get_extends(), true, true);
-    extends_iface = extends + ".Iface";
+    extends_iface = extends + "." + iface_name;
     generate_delphi_doc(s_service, tservice);
-    indent(s_service) << "Iface = interface(" << extends_iface << ")" << endl;
+    indent(s_service) << iface_name << " = interface(" << extends_iface << ")" << endl;
   } else {
-    indent(s_service) << "Iface = interface" << endl;
+    indent(s_service) << iface_name << " = interface" << endl;
   }
 
   indent_up();
@@ -1870,7 +1889,7 @@
   vector<t_function*>::iterator f_iter;
   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
     generate_delphi_doc(s_service, *f_iter);
-    indent(s_service) << function_signature(*f_iter) << endl;
+    indent(s_service) << function_signature(*f_iter, for_async) << endl;
   }
   indent_down();
   indent(s_service) << "end;" << endl << endl;
@@ -1896,20 +1915,15 @@
 void t_delphi_generator::generate_service_client(t_service* tservice) {
   indent_up();
   string extends = "";
-  string extends_client = "";
-  if (tservice->get_extends() != NULL) {
-    extends = type_name(tservice->get_extends());
-    extends_client = extends + ".Client, ";
-  }
-
+  string extends_client = "TInterfacedObject";
+  string implements = async_ ? "Iface, IAsync" : "Iface";
+  
   generate_delphi_doc(s_service, tservice);
   if (tservice->get_extends() != NULL) {
     extends = type_name(tservice->get_extends(), true, true);
     extends_client = extends + ".TClient";
-    indent(s_service) << "TClient = class(" << extends_client << ", Iface)" << endl;
-  } else {
-    indent(s_service) << "TClient = class( TInterfacedObject, Iface)" << endl;
   }
+  indent(s_service) << "TClient = class( " << extends_client << ", " << implements << ")" << endl;
 
   indent(s_service) << "public" << endl;
   indent_up();
@@ -1960,12 +1974,24 @@
 
   indent(s_service) << "protected" << endl;
   indent_up();
+  
   indent(s_service) << "// Iface" << endl;
   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
     string funname = (*f_iter)->get_name();
     generate_delphi_doc(s_service, *f_iter);
-    indent(s_service) << function_signature(*f_iter) << endl;
+    indent(s_service) << function_signature(*f_iter, false) << endl;
   }
+
+  if( async_) {
+    indent(s_service) << endl;
+    indent(s_service) << "// IAsync" << endl;
+    for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+      string funname = (*f_iter)->get_name();
+      generate_delphi_doc(s_service, *f_iter);
+      indent(s_service) << function_signature(*f_iter, true) << endl;
+    }
+  }
+  
   indent_down();
 
   indent(s_service) << "public" << endl;
@@ -1976,37 +2002,66 @@
   for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
     string funname = (*f_iter)->get_name();
 
-    indent_impl(s_service_impl) << function_signature(*f_iter, full_cls) << endl;
-    indent_impl(s_service_impl) << "begin" << endl;
-    indent_up_impl();
-    indent_impl(s_service_impl) << "send_" << funname << "(";
-
-    t_struct* arg_struct = (*f_iter)->get_arglist();
-
-    const vector<t_field*>& fields = arg_struct->get_members();
     vector<t_field*>::const_iterator fld_iter;
-    bool first = true;
-    for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
-      if (first) {
-        first = false;
-      } else {
-        s_service_impl << ", ";
+    t_struct* arg_struct = (*f_iter)->get_arglist();
+    const vector<t_field*>& fields = arg_struct->get_members();
+
+    // one for sync only, two for async+sync
+    int mode = async_ ? 1 : 0;
+    while( mode >= 0) {
+      bool for_async = (mode != 0);
+      mode--;
+
+      indent_impl(s_service_impl) << function_signature(*f_iter, for_async, full_cls) << endl;
+      indent_impl(s_service_impl) << "begin" << endl;
+      indent_up_impl();
+      
+      t_type* ttype = (*f_iter)->get_returntype();
+      if( for_async) {
+        if (is_void(ttype)) { 
+           // Delphi forces us to specify a type with IFuture<T>, so we use Integer=0 for void methods
+          indent_impl(s_service_impl) << "result := TTask.Future<Integer>(function: Integer" << endl;
+        } else { 
+          string rettype = type_name(ttype, false, true, false, true);          
+          indent_impl(s_service_impl) << "result := TTask.Future<" << rettype << ">(function: " << rettype << endl;
+        }
+        indent_impl(s_service_impl) << "begin" << endl;
+        indent_up_impl();
       }
-      s_service_impl << normalize_name((*fld_iter)->get_name());
-    }
-    s_service_impl << ");" << endl;
-
-    if (!(*f_iter)->is_oneway()) {
-      s_service_impl << indent_impl();
-      if (!(*f_iter)->get_returntype()->is_void()) {
-        s_service_impl << "Result := ";
+      
+      indent_impl(s_service_impl) << "send_" << funname << "(";
+  
+      bool first = true;
+      for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
+        if (first) {
+          first = false;
+        } else {
+          s_service_impl << ", ";
+        }
+        s_service_impl << normalize_name((*fld_iter)->get_name());
       }
-      s_service_impl << "recv_" << funname << "();" << endl;
+      s_service_impl << ");" << endl;
+  
+      if (!(*f_iter)->is_oneway()) {
+        s_service_impl << indent_impl();
+        if (!(*f_iter)->get_returntype()->is_void()) {
+          s_service_impl << "Result := ";
+        }
+        s_service_impl << "recv_" << funname << "();" << endl;
+      }
+  
+      if( for_async) {
+        if (is_void(ttype)) {
+          indent_impl(s_service_impl) << "Result := 0;" << endl;  // no IFuture<void> in Delphi
+        }
+        indent_down_impl();
+        indent_impl(s_service_impl) << "end);" << endl;
+      }
+      
+      indent_down_impl();
+      indent_impl(s_service_impl) << "end;" << endl << endl;
     }
-
-    indent_down_impl();
-    indent_impl(s_service_impl) << "end;" << endl << endl;
-
+    
     t_function send_function(g_type_void,
                              string("send_") + (*f_iter)->get_name(),
                              (*f_iter)->get_arglist());
@@ -2018,8 +2073,8 @@
     string argsvar = tmp("_args");
     string msgvar = tmp("_msg");
 
-    indent(s_service) << function_signature(&send_function) << endl;
-    indent_impl(s_service_impl) << function_signature(&send_function, full_cls) << endl;
+    indent(s_service) << function_signature(&send_function, false) << endl;
+    indent_impl(s_service_impl) << function_signature(&send_function, false, full_cls) << endl;
     indent_impl(s_service_impl) << "var" << endl;
     indent_up_impl();
     indent_impl(s_service_impl) << argsvar << " : " << args_intfnm << ";" << endl;
@@ -2072,8 +2127,8 @@
       string appexvar = tmp("_ax");
       string retvar = tmp("_ret");
 
-      indent(s_service) << function_signature(&recv_function) << endl;
-      indent_impl(s_service_impl) << function_signature(&recv_function, full_cls) << endl;
+      indent(s_service) << function_signature(&recv_function, false) << endl;
+      indent_impl(s_service_impl) << function_signature(&recv_function, false, full_cls) << endl;
       indent_impl(s_service_impl) << "var" << endl;
       indent_up_impl();
       indent_impl(s_service_impl) << msgvar << " : Thrift.Protocol.TThriftMessage;" << endl;
@@ -2131,7 +2186,7 @@
 
       if (!(*f_iter)->get_returntype()->is_void()) {
         indent_impl(s_service_impl)
-			<< "raise TApplicationExceptionMissingResult.Create('"
+            << "raise TApplicationExceptionMissingResult.Create('"
             << (*f_iter)->get_name() << " failed: unknown result');" << endl;
       }
 
@@ -2254,8 +2309,8 @@
   indent_impl(s_service_impl) << "TProtocolUtil.Skip(iprot, TType.Struct);" << endl;
   indent_impl(s_service_impl) << "iprot.ReadMessageEnd();" << endl;
   indent_impl(s_service_impl) << "x := "
-								 "TApplicationExceptionUnknownMethod.Create("
-								 "'Invalid method name: ''' + msg.Name + '''');" << endl;
+                                 "TApplicationExceptionUnknownMethod.Create("
+                                 "'Invalid method name: ''' + msg.Name + '''');" << endl;
   indent_impl(s_service_impl)
       << "Thrift.Protocol.Init( msg, msg.Name, TMessageType.Exception, msg.SeqID);"
       << endl;
@@ -2452,7 +2507,7 @@
     indent_impl(s_service_impl) << "if events <> nil then events.UnhandledError(E);" << endl;
   }
   if (!tfunction->is_oneway()) {
-	indent_impl(s_service_impl) << "appx := TApplicationExceptionInternalError.Create(E.Message);"
+    indent_impl(s_service_impl) << "appx := TApplicationExceptionInternalError.Create(E.Message);"
                                 << endl;
     indent_impl(s_service_impl) << "try" << endl;
     indent_up_impl();
@@ -3126,6 +3181,7 @@
 }
 
 string t_delphi_generator::function_signature(t_function* tfunction,
+                                              bool for_async,
                                               std::string full_cls,
                                               bool is_xception) {
   t_type* ttype = tfunction->get_returntype();
@@ -3135,13 +3191,25 @@
   } else {
     prefix = full_cls + ".";
   }
-  if (is_void(ttype)) {
-    return "procedure " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "("
-           + argument_list(tfunction->get_arglist()) + ");";
+
+  if( for_async) {
+    if (is_void(ttype)) {
+      return "function " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "Async("
+             + argument_list(tfunction->get_arglist()) + "): IFuture<Integer>;";  // no IFuture<void> in Delphi
+    } else {
+      return "function " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "Async("
+             + argument_list(tfunction->get_arglist()) + "): IFuture<"
+             + type_name(ttype, false, true, is_xception, true) + ">;";
+    }
   } else {
-    return "function " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "("
-           + argument_list(tfunction->get_arglist()) + "): "
-           + type_name(ttype, false, true, is_xception, true) + ";";
+    if (is_void(ttype)) {
+      return "procedure " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "("
+             + argument_list(tfunction->get_arglist()) + ");";
+    } else {
+      return "function " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "("
+             + argument_list(tfunction->get_arglist()) + "): "
+             + type_name(ttype, false, true, is_xception, true) + ";";
+    }
   }
 }
 
@@ -3721,7 +3789,7 @@
     if (is_required && null_allowed) {
       null_allowed = false;
       indent_impl(code_block) << "if (Self." << fieldname << " = nil)" << endl;
-	  indent_impl(code_block) << "then raise TProtocolExceptionInvalidData.Create("
+      indent_impl(code_block) << "then raise TProtocolExceptionInvalidData.Create("
                               << "'required field " << fieldname << " not set');"
                               << endl;
     }
@@ -3917,4 +3985,5 @@
     "                     and container instances by interface or TypeInfo()\n"
     "    constprefix:     Name TConstants classes after IDL to reduce ambiguities\n"
     "    events:          Enable and use processing events in the generated code.\n"
-    "    xmldoc:          Enable XMLDoc comments for Help Insight etc.\n")
+    "    xmldoc:          Enable XMLDoc comments for Help Insight etc.\n"
+    "    async:           Generate IAsync interface to use Parallel Programming Library (XE7+ only).\n")
diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas
index 59b2a66..143611d 100644
--- a/lib/delphi/test/TestClient.pas
+++ b/lib/delphi/test/TestClient.pas
@@ -25,10 +25,15 @@
 {.$DEFINE PerfTest}     // activate the performance test
 {$DEFINE Exceptions}    // activate the exceptions test (or disable while debugging)
 
+{$if CompilerVersion >= 28}
+{$DEFINE SupportsAsync}
+{$ifend}
+
 interface
 
 uses
   Windows, SysUtils, Classes, Math,
+  {$IFDEF SupportsAsync} System.Threading, {$ENDIF}
   DateUtils,
   Generics.Collections,
   TestConstants,
@@ -85,6 +90,10 @@
     function  CalculateExitCode : Byte;
 
     procedure ClientTest;
+    {$IFDEF SupportsAsync}
+    procedure ClientAsyncTest;
+    {$ENDIF}
+
     procedure JSONProtocolReadWriteTest;
     function  PrepareBinaryData( aRandomDist, aHuge : Boolean) : TBytes;
     {$IFDEF StressTest}
@@ -177,6 +186,7 @@
 class function TTestClient.Execute(const args: array of string) : Byte;
 var
   i : Integer;
+  threadExitCode : Byte;
   host : string;
   port : Integer;
   sPipeName : string;
@@ -374,11 +384,13 @@
 
     result := 0;
     for test := 0 to FNumThread - 1 do begin
-      result := result or threads[test].WaitFor;
+      threadExitCode := threads[test].WaitFor;
+      result := result or threadExitCode;
     end;
 
-    for test := 0 to FNumThread - 1
-    do threads[test].Free;
+    for test := 0 to FNumThread - 1 do begin
+      threads[test].Free;
+    end;
 
     Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));
 
@@ -1004,6 +1016,33 @@
 end;
 
 
+{$IFDEF SupportsAsync}
+procedure TClientThread.ClientAsyncTest;
+var
+  client : TThriftTest.IAsync;
+  s : string;
+  i8 : ShortInt;
+begin
+  StartTestGroup( 'Async Tests', test_Unknown);
+  client := TThriftTest.TClient.Create( FProtocol);
+  FTransport.Open;
+
+  // oneway void functions
+  client.testOnewayAsync(1).Wait;
+  Expect( TRUE, 'Test Oneway(1)');  // success := no exception
+
+  // normal functions
+  s := client.testStringAsync(HUGE_TEST_STRING).Value;
+  Expect( length(s) = length(HUGE_TEST_STRING),
+          'testString( length(HUGE_TEST_STRING) = '+IntToStr(Length(HUGE_TEST_STRING))+') '
+         +'=> length(result) = '+IntToStr(Length(s)));
+
+  i8 := client.testByte(1).Value;
+  Expect( i8 = 1, 'testByte(1) = ' + IntToStr( i8 ));
+end;
+{$ENDIF}
+
+
 {$IFDEF StressTest}
 procedure TClientThread.StressTest(const client : TThriftTest.Iface);
 begin
@@ -1303,12 +1342,15 @@
   try
     {$IFDEF Win64}  
     UseInterlockedExchangeAdd64;
-	{$ENDIF}
+    {$ENDIF}
     JSONProtocolReadWriteTest;
 	
     for i := 0 to FNumIteration - 1 do
     begin
       ClientTest;
+      {$IFDEF SupportsAsync}
+      ClientAsyncTest;
+      {$ENDIF}
     end;
   except
     on e:Exception do Expect( FALSE, 'unexpected exception: "'+e.message+'"');