THRIFT-2013: add perl crosstest multiplexed client and server logic

Client: perl

This closes #1416

2 files changed, 71 insertions, 7 deletions

diff --git a/test/perl/TestClient.pl b/test/perl/TestClient.pl
index 6f3cbc971..990274c5e 100755
--- a/test/perl/TestClient.pl
+++ b/test/perl/TestClient.pl
@@ -33,10 +33,12 @@ use Thrift;
 use Thrift::BinaryProtocol;
 use Thrift::BufferedTransport;
 use Thrift::FramedTransport;
+use Thrift::MultiplexedProtocol;
 use Thrift::SSLSocket;
 use Thrift::Socket;
 use Thrift::UnixSocket;
 
+use ThriftTest::SecondService;
 use ThriftTest::ThriftTest;
 use ThriftTest::Types;
 
@@ -108,13 +110,21 @@ if ($opts{transport} eq 'buffered') {
 }
 
 my $protocol;
-if ($opts{protocol} eq 'binary') {
+my $protocol2;
+if ($opts{protocol} eq 'binary' || $opts{protocol} eq 'multi') {
     $protocol = new Thrift::BinaryProtocol($transport);
 } else {
     usage();
     exit 1;
 }
 
+my $secondService = undef;
+if (index($opts{protocol}, 'multi') == 0) {
+  $protocol2 = new Thrift::MultiplexedProtocol($protocol, "SecondService");
+  $protocol = new Thrift::MultiplexedProtocol($protocol, "ThriftTest");
+  $secondService = new ThriftTest::SecondServiceClient($protocol2);
+}
+
 my $testClient = new ThriftTest::ThriftTestClient($protocol);
 
 eval {
@@ -123,6 +133,14 @@ eval {
 if($@){
     die(Dumper($@));
 }
+
+use constant ERR_BASETYPES => 1;
+use constant ERR_STRUCTS => 2;
+use constant ERR_CONTAINERS => 4;
+use constant ERR_EXCEPTIONS => 8;
+use constant ERR_PROTOCOL => 16;
+use constant ERR_UNKNOWN => 64;
+
 my $start = gettimeofday();
 
 #
@@ -138,6 +156,17 @@ print(" = void\n");
 print("testString(\"Test\")");
 my $s = $testClient->testString("Test");
 print(" = \"$s\"\n");
+exit(ERR_BASETYPES) if ($s ne 'Test');
+
+#
+# MULTIPLEXED TEST
+#
+if (index($opts{protocol}, 'multi') == 0) {
+    print("secondtestString(\"Test2\")");
+    $s = $secondService->secondtestString("Test2");
+    print(" = \"$s\"\n");
+    exit(ERR_PROTOCOL) if ($s ne 'testString("Test2")');
+}
 
 #
 # BOOL TEST
@@ -145,9 +174,11 @@ print(" = \"$s\"\n");
 print("testBool(1)");
 my $t = $testClient->testBool(1);
 print(" = $t\n");
+exit(ERR_BASETYPES) if ($t ne 1);
 print("testBool(0)");
 my $f = $testClient->testBool(0);
 print(" = $f\n");
+exit(ERR_BASETYPES) if ($f ne "");
 
 
 #
@@ -163,13 +194,15 @@ print(" = $u8\n");
 print("testI32(-1)");
 my $i32 = $testClient->testI32(-1);
 print(" = $i32\n");
+exit(ERR_BASETYPES) if ($i32 ne -1);
 
 #
-#I64 TEST
+# I64 TEST
 #
 print("testI64(-34359738368)");
 my $i64 = $testClient->testI64(-34359738368);
 print(" = $i64\n");
+exit(ERR_BASETYPES) if ($i64 ne -34359738368);
 
 #
 # DOUBLE TEST
@@ -177,6 +210,7 @@ print(" = $i64\n");
 print("testDouble(-852.234234234)");
 my $dub = $testClient->testDouble(-852.234234234);
 print(" = $dub\n");
+exit(ERR_BASETYPES) if ($dub ne -852.234234234);
 
 #
 # BINARY TEST   ---  TODO
diff --git a/test/perl/TestServer.pl b/test/perl/TestServer.pl
index 1e23ce84a..7d8f929b4 100644
--- a/test/perl/TestServer.pl
+++ b/test/perl/TestServer.pl
@@ -33,11 +33,13 @@ use Thrift;
 use Thrift::BinaryProtocol;
 use Thrift::BufferedTransport;
 use Thrift::FramedTransport;
+use Thrift::MultiplexedProcessor;
 use Thrift::SSLServerSocket;
 use Thrift::ServerSocket;
 use Thrift::Server;
 use Thrift::UnixServerSocket;
 
+use ThriftTest::SecondService;
 use ThriftTest::ThriftTest;
 use ThriftTest::Types;
 
@@ -96,7 +98,9 @@ if ($opts{ssl} and not defined $opts{cert}) {
 }
 
 my $handler = new ThriftTestHandler();
+my $handler2 = new SecondServiceHandler();
 my $processor = new ThriftTest::ThriftTestProcessor($handler);
+my $processor2 = new ThriftTest::SecondServiceProcessor($handler2);
 my $serversocket;
 if ($opts{"domain-socket"}) {
     unlink($opts{"domain-socket"});
@@ -116,13 +120,21 @@ if ($opts{transport} eq 'buffered') {
     exit 1;
 }
 my $protocol;
-if ($opts{protocol} eq 'binary') {
+if ($opts{protocol} eq 'binary' || $opts{protocol} eq 'multi') {
     $protocol = new Thrift::BinaryProtocolFactory();
 } else {
     usage();
     exit 1;
 }
 
+if (index($opts{protocol}, 'multi') == 0) {
+  my $newProcessor = new Thrift::MultiplexedProcessor($protocol);
+  $newProcessor->defaultProcessor($processor);
+  $newProcessor->registerProcessor("ThriftTest", $processor);
+  $newProcessor->registerProcessor("SecondService", $processor2);
+  $processor = $newProcessor;
+}
+
 my $ssltag = '';
 if ($opts{ssl}) {
     $ssltag = "(SSL)";
@@ -390,11 +402,29 @@ sub testMultiException() {
 
 sub testOneway() {
   my $self = shift;
-  my $sleepFor = shift;
-  print("testOneway($sleepFor): Sleeping...\n");
-  sleep $sleepFor;
-  print("testOneway($sleepFor): done sleeping!\n");
+  my $num = shift;
+  print("testOneway($num): received\n");
+}
+
+###
+### Test server implementation
+###
+
+package SecondServiceHandler;
+
+use base qw( ThriftTest::SecondServiceIf );
+
+sub new {
+    my $classname = shift;
+    my $self = {};
+    return bless($self, $classname);
 }
 
+sub secondtestString() {
+  my $self = shift;
+  my $thing = shift;
+  print("testString($thing)\n");
+  return "testString(\"" . $thing . "\")";
+}
 
 1;