TAO/tests/Oneway_Timeouts/run_test.pl

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2      & eval 'exec perl -S $0 $argv:q'
   3      if 0;
   4
   5 # -*- perl -*-
   6
   7 use lib "$ENV{ACE_ROOT}/bin";
   8 use PerlACE::TestTarget;
   9
  10 $status = 0;
  11 $debug_level = '0';
  12
  13 foreach $i (@ARGV) {
  14     if ($i eq '-debug') {
  15         $debug_level = '10';
  16     }
  17 }
  18
  19 my $server = PerlACE::TestTarget::create_target (1) || die "Create target 1 failed\n";
  20 my $client = PerlACE::TestTarget::create_target (2) || die "Create target 2 failed\n";
  21
  22 my $iorbase = "server.ior";
  23 my $server_iorfile = $server->LocalFile ($iorbase);
  24 my $client_iorfile = $client->LocalFile ($iorbase);
  25 $server->DeleteFile($iorbase);
  26 $client->DeleteFile($iorbase);
  27
  28 $SV_PORT = $server->RandomPort();
  29 $SV_ARGS = "-ORBListenEndpoints iiop://:$SV_PORT -server_ior $server_iorfile";
  30 $CL_ARGS = "-server_ior file://$client_iorfile";
  31
  32 $SV = $server->CreateProcess ("server");
  33 $CL = $client->CreateProcess ("client");
  34
  35 sub run_only_client
  36 {
  37     my $ret = $CL->SpawnWaitKill($client->ProcessStartWaitInterval());
  38     if ($ret != 0) {
  39         print STDERR "ERROR: client returned $ret\n";
  40         exit 1;
  41     }
  42 }
  43
  44 sub run_client_n_server
  45 {
  46     $server->DeleteFile($iorbase);
  47     $client->DeleteFile($iorbase);
  48     my $ret = $SV->Spawn();
  49     if ($ret != 0) {
  50         print STDERR "ERROR: server returned $ret\n";
  51         exit 1;
  52     }
  53     if ($server->WaitForFileTimed ($iorbase,
  54                                $server->ProcessStartWaitInterval()) == -1) {
  55         print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  56         $SV->Kill (); $SV->TimedWait (1);
  57         exit 1;
  58     }
  59     if ($server->GetFile ($iorbase) == -1) {
  60         print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  61         $SV->Kill (); $SV->TimedWait (1);
  62         exit 1;
  63     }
  64     if ($client->PutFile ($iorbase) == -1) {
  65         print STDERR "ERROR: cannot set file <$client_iorfile>\n";
  66         $SV->Kill (); $SV->TimedWait (1);
  67         exit 1;
  68     }
  69     $ret = $CL->SpawnWaitKill($client->ProcessStartWaitInterval());
  70     if ($ret != 0) {
  71         print STDERR "ERROR: client returned $ret\n";
  72         $SV->Kill (); $SV->TimedWait (1);
  73         exit 1;
  74     }
  75     $ret = $SV->WaitKill ($server->ProcessStopWaitInterval());
  76     if ($ret != 0) {
  77         print STDERR "ERROR: server returned $ret\n";
  78         exit 1;
  79     }
  80     $server->DeleteFile($iorbase);
  81     $client->DeleteFile($iorbase);
  82 }
  83
  84 sub test_timeouts
  85 {
  86     print "test_timeouts 1 testing...\n";
  87     $CL->Arguments("-force_timeout -connect_timeout 200");
  88     run_only_client;
  89     print "test_timeouts 1 passed...\n";
  90     print "test_timeouts 2 testing...\n";
  91     # request timeout should override connect timeout
  92     $CL->Arguments("-force_timeout -request_timeout 100 -connect_timeout 200");
  93     run_only_client;
  94     print "test_timeouts 2 passed...\n";
  95     print "test_timeouts 3 testing...\n";
  96     $CL->Arguments("-use_twoway -force_timeout -connect_timeout 200");
  97     run_only_client;
  98     print "test_timeouts 3 passed...\n";
  99     print "test_timeouts 4 testing...\n";
 100     # request timeout should override connect timeout
 101     $CL->Arguments("-use_twoway -force_timeout -request_timeout 200 -connect_timeout 1000");
 102     run_only_client;
 103     print "test_timeouts 4 passed...\n";
 104     print "test_timeouts 5 testing...\n";
 105     # request_timeout ignored for other sync_scopes
 106     $CL->Arguments("-sync none -force_timeout -request_timeout 100 -connect_timeout 200 -max_request_time 30");
 107     run_only_client;
 108     print "test_timeouts 5 passed...\n";
 109     print "test_timeouts 6 testing...\n";
 110     $CL->Arguments("-sync delayed -force_timeout -request_timeout 100 -connect_timeout 200 -max_request_time 30");
 111     run_only_client;
 112     print "test_timeouts 6 passed...\n";
 113     return 0;
 114 }
 115
 116 sub test_buffering
 117 {
 118     print "test_buffering 1 testing...\n";
 119     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_min 350");
 120     $CL->Arguments("$CL_ARGS -sync none -max_request_time 30");
 121     run_client_n_server;
 122     print "test_buffering 1 passed...\n";
 123     print "test_buffering 2 testing...\n";
 124     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_min 350");
 125     $CL->Arguments("$CL_ARGS -sync delayed -max_request_time 30");
 126     run_client_n_server;
 127     print "test_buffering 2 passed...\n";
 128     print "test_buffering 3 testing...\n";
 129     # Using sleep() instead of orb->run() for the interval
 130     # should cause all requests to be sent at once.
 131     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_max 50");
 132     $CL->Arguments("$CL_ARGS -sync none -max_request_time 30 -use_sleep -run_orb_time 500");
 133     run_client_n_server;
 134     print "test_buffering 3 passed...\n";
 135     print "test_buffering 4 testing...\n";
 136     # Even delayed buffering will work this way, because the
 137     # connection won't be established until the orb is run.
 138     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_max 50");
 139     $CL->Arguments("$CL_ARGS -sync delayed -max_request_time 30 -use_sleep -run_orb_time 500 -make_request_queued");
 140     run_client_n_server;
 141     print "test_buffering 4 passed...\n";
 142     print "test_buffering 5 testing...\n";
 143     # However, if we connect first, then delayed buffering will
 144     # cause the data to be sent right away
 145     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_min 350");
 146     $CL->Arguments("$CL_ARGS -sync delayed -max_request_time 30 -use_sleep -run_orb_time 500 -force_connect");
 147     run_client_n_server;
 148     print "test_buffering 5 passed...\n";
 149     print "test_buffering 6 testing...\n";
 150     # Forcing the connection won't help sync_none, because it always buffers
 151     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_max 50");
 152     $CL->Arguments("$CL_ARGS -sync none -max_request_time 30 -use_sleep -run_orb_time 500 -force_connect");
 153     run_client_n_server;
 154     print "test_buffering 6 passed...\n";
 155     return 0;
 156 }
 157
 158 # Set a buffer count trigger and a request timeout so that a
 159 # predictable number will be discarded.
 160 sub test_buffer_count_timeout
 161 {
 162     print "test_buffer_count_timeout testing...\n";
 163     $SV->Arguments("$SV_ARGS -expected 2");
 164     $CL->Arguments("$CL_ARGS -sync none -buffer_count 5 -max_request_time 30 -request_timeout 10");
 165     run_client_n_server;
 166     print "test_buffer_count_timeout passed...\n";
 167     return 0;
 168 }
 169
 170 sub test_buffer_bytes_timeout
 171 {
 172     print "test_buffer_bytes_timeout testing...\n";
 173     $SV->Arguments("$SV_ARGS -expected 3");
 174     $CL->Arguments("$CL_ARGS -sync none -buffer_bytes 200 -max_request_time 30 -request_timeout 10");
 175     run_client_n_server;
 176     print "test_buffer_bytes_timeout passed...\n";
 177     return 0;
 178 }
 179
 180 sub test_buffer_timeout
 181 {
 182     print "test_buffer_timeout 1 testing...\n";
 183     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_max 50 -first_min 1000");
 184     # Must use run_orb_time so that the timer will fire, and to prevent sending the
 185     # test_done twoway request which would flush the queue.
 186     $CL->Arguments("$CL_ARGS -sync none -buffer_timeout 1000 -max_request_time 30 -run_orb_time 1500");
 187     run_client_n_server;
 188     print "test_buffer_timeout 1 passed...\n";
 189     print "test_buffer_timeout 2 testing...\n";
 190     # delayed buffering should behave as above, because it will start out buffering
 191     # due to the connection not being established.  However, the when the
 192     # actual connection is made, it will flush the queued messages which
 193     # may take up to 550ms.
 194     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_max 550 -first_min 990");
 195     # Must use run_orb_time so that the timer will fire, and to prevent sending the
 196     # test_done twoway request which would flush the queue.
 197     $CL->Arguments("$CL_ARGS -sync delayed -buffer_timeout 1000 -max_request_time 30 -run_orb_time 1500 -make_request_queued");
 198     run_client_n_server;
 199     print "test_buffer_timeout 2 passed...\n";
 200     print "test_buffer_timeout 3 testing...\n";
 201     # delayed buffering will ignore constraints if the connection is forced
 202     $SV->Arguments("$SV_ARGS -expected 10 -elapsed_min 450 -first_max 50");
 203     # Must use run_orb_time so that the timer will fire, and to prevent sending the
 204     # test_done twoway request which would flush the queue.
 205     $CL->Arguments("$CL_ARGS -sync delayed -force_connect -buffer_timeout 1000 -max_request_time 30 -run_orb_time 1500");
 206     run_client_n_server;
 207     print "test_buffer_timeout 3 passed...\n";
 208     return 0;
 209 }
 210
 211 # test sending one request with buffering timeout constraint.
 212 sub test_one_request
 213 {
 214     print "test_one_request testing...\n";
 215     $SV->Arguments("$SV_ARGS -expected 1 -first_min 1000");
 216     # Must use run_orb_time so that the timer will fire, and to prevent sending the
 217     # test_done twoway request which would flush the queue.
 218     $CL->Arguments("$CL_ARGS -sync none -buffer_timeout 1000 -max_request_time 30 -run_orb_time 1500 -num_requests 1");
 219     run_client_n_server;
 220     print "test_one_request passed...\n";
 221     return 0;
 222 }
 223
 224 $status |= test_timeouts();
 225 $status |= test_buffering();
 226 $status |= test_buffer_count_timeout();
 227 $status |= test_buffer_bytes_timeout();
 228 $status |= test_buffer_timeout();
 229 $status |= test_one_request();
 230
 231 # Regardless of the return value, ensure that the processes
 232 # are terminated before exiting
 233
 234 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 235 if ($server_status != 0) {
 236     print STDERR "ERROR: server returned $server_status\n";
 237     $status = 1;
 238 }
 239
 240 $client_status = $CL->Kill ();
 241 if ($client_status != 0) {
 242     print STDERR "ERROR: client returned $client_status\n";
 243     $status = 1;
 244 }
 245
 246 $server->DeleteFile($iorbase);
 247 $client->DeleteFile($iorbase);
 248
 249 exit $status;