TAO/tests/Faults/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 my $middle = PerlACE::TestTarget::create_target (3) || die "Create target 3 failed\n";
  22
  23 my $iorbase = "server.ior";
  24 my $midiorbase = "middle.ior";
  25 my $server_iorfile = $server->LocalFile ($iorbase);
  26 my $client_iorfile = $client->LocalFile ($iorbase);
  27 my $client_midiorfile = $client->LocalFile ($midiorbase);
  28 my $middle_iorfile = $middle->LocalFile ($iorbase);
  29 my $middle_midiorfile = $middle->LocalFile ($midiorbase);
  30 $server->DeleteFile($iorbase);
  31 $client->DeleteFile($iorbase);
  32 $client->DeleteFile($midiorbase);
  33 $middle->DeleteFile($iorbase);
  34 $middle->DeleteFile($midiorbase);
  35
  36 my $svcconf = "server$PerlACE::svcconf_ext";
  37 my $server_svcfile = $server->LocalFile ($svcconf);
  38 if ($server->PutFile ($svcconf) == -1) {
  39     print STDERR "ERROR: cannot set file <$server_svcfile>\n";
  40     exit 1;
  41 }
  42
  43
  44 ###############################################################################
  45 print STDERR "################ Default ORB Config###############\n";
  46 print STDERR "===== Base test, no crashes\n";
  47
  48 $SV = $server->CreateProcess ("server",
  49                               "-ORBdebuglevel $debug_level ".
  50                               "-o $server_iorfile");
  51 $CL = $client->CreateProcess ("client", "-k file://$client_iorfile -i 100");
  52
  53 $server_status = $SV->Spawn ();
  54
  55 if ($server_status != 0) {
  56     print STDERR "ERROR: server returned $server_status\n";
  57     exit 1;
  58 }
  59
  60 if ($server->WaitForFileTimed ($iorbase,
  61                                $server->ProcessStartWaitInterval()) == -1) {
  62     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
  63     $SV->Kill (); $SV->TimedWait (1);
  64     exit 1;
  65 }
  66
  67 if ($server->GetFile ($iorbase) == -1) {
  68     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
  69     $SV->Kill (); $SV->TimedWait (1);
  70     exit 1;
  71 }
  72 if ($client->PutFile ($iorbase) == -1) {
  73     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
  74     $SV->Kill (); $SV->TimedWait (1);
  75     exit 1;
  76 }
  77
  78 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
  79
  80 if ($client_status != 0) {
  81     print STDERR "ERROR: client returned $client_status\n";
  82     $SV->Kill (); $SV->TimedWait (1);
  83     exit 1;
  84 }
  85
  86 ###############################################################################
  87 print STDERR "===== Client crash (abort) during upcall\n";
  88
  89 $CL->Arguments ("-k file://$client_iorfile -i 100 -s");
  90
  91 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval(), {self_crash => 1});
  92
  93 if ($client_status == -1) {
  94     print STDERR "ERROR: client returned $client_status\n";
  95     $SV->Kill (); $SV->TimedWait (1);
  96     exit 1;
  97 }
  98
  99 ###############################################################################
 100 print STDERR "===== Client crash during upcall\n";
 101
 102 $CL->Arguments ("-k file://$client_iorfile -i 100 -z");
 103
 104 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 105
 106 if ($client_status == -1) {
 107     print STDERR "ERROR: client returned $client_status\n";
 108     $SV->Kill (); $SV->TimedWait (1);
 109     exit 1;
 110 }
 111
 112 ###############################################################################
 113 print STDERR "===== Server crash (abort) during upcall\n";
 114
 115 $CL->Arguments ("-k file://$client_iorfile -i 100 -a");
 116
 117 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 118
 119 if ($client_status != 0) {
 120     print STDERR "ERROR: client returned $client_status\n";
 121     $SV->Kill (); $SV->TimedWait (1);
 122     exit 1;
 123 }
 124
 125 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval(), {self_crash => 1});
 126
 127 if ($server_status == -1) {
 128     print STDERR "ERROR: server returned $server_status\n";
 129     $SV->Kill (); $SV->TimedWait (1);
 130     exit 1;
 131 }
 132
 133 $server->DeleteFile($iorbase);
 134 $client->DeleteFile($iorbase);
 135
 136 ###############################################################################
 137 print STDERR "===== Server crash during upcall\n";
 138
 139 $server_status = $SV->Spawn ();
 140
 141 if ($server_status != 0) {
 142     print STDERR "ERROR: server returned $server_status\n";
 143     exit 1;
 144 }
 145
 146 if ($server->WaitForFileTimed ($iorbase,
 147                                $server->ProcessStartWaitInterval()) == -1) {
 148     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 149     $SV->Kill (); $SV->TimedWait (1);
 150     exit 1;
 151 }
 152
 153 if ($server->GetFile ($iorbase) == -1) {
 154     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 155     $SV->Kill (); $SV->TimedWait (1);
 156     exit 1;
 157 }
 158 if ($client->PutFile ($iorbase) == -1) {
 159     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 160     $SV->Kill (); $SV->TimedWait (1);
 161     exit 1;
 162 }
 163
 164 $CL->Arguments ("-k file://$client_iorfile -i 100 -c");
 165
 166 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 167
 168 if ($client_status != 0) {
 169     print STDERR "ERROR: client returned $client_status\n";
 170     $SV->Kill (); $SV->TimedWait (1);
 171     exit 1;
 172 }
 173
 174 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 175
 176 if ($server_status == -1) {
 177     print STDERR "ERROR: server returned $server_status\n";
 178     $SV->Kill (); $SV->TimedWait (1);
 179     exit 1;
 180 }
 181
 182 $server->DeleteFile($iorbase);
 183 $client->DeleteFile($iorbase);
 184
 185 ###############################################################################
 186 print STDERR "===== Three-way test, client crashes and server detects\n";
 187
 188 $MD = $middle->CreateProcess ("middle",
 189                               "-o $middle_midiorfile ".
 190                               "-k file://$middle_iorfile");
 191
 192 $server_status = $SV->Spawn ();
 193
 194 if ($server_status != 0) {
 195     print STDERR "ERROR: server returned $server_status\n";
 196     exit 1;
 197 }
 198
 199 if ($server->WaitForFileTimed ($iorbase,
 200                                $server->ProcessStartWaitInterval()) == -1) {
 201     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 202     $SV->Kill (); $SV->TimedWait (1);
 203     exit 1;
 204 }
 205
 206 if ($server->GetFile ($iorbase) == -1) {
 207     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 208     $SV->Kill (); $SV->TimedWait (1);
 209     exit 1;
 210 }
 211 if ($middle->PutFile ($iorbase) == -1) {
 212     print STDERR "ERROR: cannot set file <$middle_iorfile>\n";
 213     $SV->Kill (); $SV->TimedWait (1);
 214     exit 1;
 215 }
 216
 217 $middle_status = $MD->Spawn ();
 218
 219 if ($middle_status != 0) {
 220     print STDERR "ERROR: server returned $middle_status\n";
 221     $SV->Kill (); $SV->TimedWait (1);
 222     exit 1;
 223 }
 224
 225 if ($middle->WaitForFileTimed ($midiorbase,
 226                                $middle->ProcessStartWaitInterval()) == -1) {
 227     print STDERR "ERROR: cannot find file <$middle_midiorfile>\n";
 228     $SV->Kill (); $SV->TimedWait (1);
 229     $MD->Kill (); $MD->TimedWait (1);
 230     exit 1;
 231 }
 232
 233 if ($middle->GetFile ($midiorbase) == -1) {
 234     print STDERR "ERROR: cannot retrieve file <$middle_midiorfile>\n";
 235     $SV->Kill (); $SV->TimedWait (1);
 236     $MD->Kill (); $MD->TimedWait (1);
 237     exit 1;
 238 }
 239 if ($client->PutFile ($midiorbase) == -1) {
 240     print STDERR "ERROR: cannot set file <$client_midiorfile>\n";
 241     $SV->Kill (); $SV->TimedWait (1);
 242     $MD->Kill (); $MD->TimedWait (1);
 243     exit 1;
 244 }
 245
 246 $CL->Arguments ("-k file://$client_midiorfile -i 100 -s");
 247
 248 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 85, {self_crash => 1});
 249
 250 if ($client_status == -1) {
 251     print STDERR "ERROR: client returned $client_status\n";
 252     $SV->Kill (); $SV->TimedWait (1);
 253     $MD->Kill (); $MD->TimedWait (1);
 254     exit 1;
 255 }
 256
 257 $CL->Arguments ("-k file://$client_midiorfile -i 10 -x");
 258
 259 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 85);
 260
 261 if ($client_status == -1) {
 262     print STDERR "ERROR: client returned $client_status\n";
 263     $SV->Kill (); $SV->TimedWait (1);
 264     $MD->Kill (); $MD->TimedWait (1);
 265     exit 1;
 266 }
 267
 268 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 269
 270 if ($server_status != 0) {
 271     print STDERR "ERROR: server returned $server_status\n";
 272     $SV->Kill (); $SV->TimedWait (1);
 273     $MD->Kill (); $MD->TimedWait (1);
 274     exit 1;
 275 }
 276
 277 $middle_status = $MD->WaitKill ($middle->ProcessStopWaitInterval());
 278
 279 if ($middle_status != 0) {
 280     print STDERR "ERROR: server returned $middle_status\n";
 281     $SV->Kill (); $SV->TimedWait (1);
 282     exit 1;
 283 }
 284
 285 $server->DeleteFile($iorbase);
 286 $client->DeleteFile($midiorbase);
 287 $middle->DeleteFile($iorbase);
 288 $middle->DeleteFile($midiorbase);
 289
 290 ########################################################################
 291 ########################################################################
 292 ########################################################################
 293 print STDERR "################ Thread-Per-Connection Config###############\n";
 294 print STDERR "===== Base test, no crashes\n";
 295
 296 $SV->Arguments ("-ORBdebuglevel $debug_level ".
 297                 "-ORBSvcConf $server_svcfile -o $server_iorfile");
 298 $CL->Arguments ("-k file://$client_iorfile -i 100");
 299
 300 $server_status = $SV->Spawn ();
 301
 302 if ($server_status != 0) {
 303     print STDERR "ERROR: server returned $server_status\n";
 304     exit 1;
 305 }
 306
 307 if ($server->WaitForFileTimed ($iorbase,
 308                                $server->ProcessStartWaitInterval()) == -1) {
 309     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 310     $SV->Kill (); $SV->TimedWait (1);
 311     exit 1;
 312 }
 313
 314 if ($server->GetFile ($iorbase) == -1) {
 315     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 316     $SV->Kill (); $SV->TimedWait (1);
 317     exit 1;
 318 }
 319 if ($client->PutFile ($iorbase) == -1) {
 320     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 321     $SV->Kill (); $SV->TimedWait (1);
 322     exit 1;
 323 }
 324
 325 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 326
 327 if ($client_status != 0) {
 328     print STDERR "ERROR: client returned $client_status\n";
 329     $SV->Kill (); $SV->TimedWait (1);
 330     exit 1;
 331 }
 332
 333 ###############################################################################
 334 print STDERR "===== Client crash (abort) during upcall\n";
 335
 336 $CL->Arguments ("-k file://$client_iorfile -i 100 -s");
 337
 338 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval(), {self_crash => 1});
 339
 340 if ($client_status == -1) {
 341     print STDERR "ERROR: client returned $client_status\n";
 342     $SV->Kill (); $SV->TimedWait (1);
 343     exit 1;
 344 }
 345
 346 ###############################################################################
 347 print STDERR "===== Client crash during upcall\n";
 348
 349 $CL->Arguments ("-k file://$client_iorfile -i 100 -z");
 350
 351 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 352
 353 if ($client_status == -1) {
 354     print STDERR "ERROR: client returned $client_status\n";
 355     $SV->Kill (); $SV->TimedWait (1);
 356     exit 1;
 357 }
 358
 359 ###############################################################################
 360 print STDERR "===== Server crash (abort) during upcall\n";
 361
 362 $CL->Arguments ("-k file://$client_iorfile -i 100 -a");
 363
 364 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 365
 366 if ($client_status != 0) {
 367     print STDERR "ERROR: client returned $client_status\n";
 368     $SV->Kill (); $SV->TimedWait (1);
 369     exit 1;
 370 }
 371
 372 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval(), {self_crash => 1});
 373
 374 if ($server_status == -1) {
 375     print STDERR "ERROR: server returned $server_status\n";
 376     $SV->Kill (); $SV->TimedWait (1);
 377     exit 1;
 378 }
 379
 380 $server->DeleteFile($iorbase);
 381 $client->DeleteFile($iorbase);
 382
 383 ###############################################################################
 384 print STDERR "===== Server crash during upcall\n";
 385
 386 $server_status = $SV->Spawn ();
 387
 388 if ($server_status != 0) {
 389     print STDERR "ERROR: server returned $server_status\n";
 390     exit 1;
 391 }
 392
 393 if ($server->WaitForFileTimed ($iorbase,
 394                                $server->ProcessStartWaitInterval()) == -1) {
 395     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 396     $SV->Kill (); $SV->TimedWait (1);
 397     exit 1;
 398 }
 399
 400 if ($server->GetFile ($iorbase) == -1) {
 401     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 402     $SV->Kill (); $SV->TimedWait (1);
 403     exit 1;
 404 }
 405 if ($client->PutFile ($iorbase) == -1) {
 406     print STDERR "ERROR: cannot set file <$client_iorfile>\n";
 407     $SV->Kill (); $SV->TimedWait (1);
 408     exit 1;
 409 }
 410
 411 $CL->Arguments ("-k file://$client_iorfile -i 100 -c");
 412
 413 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval());
 414
 415 if ($client_status != 0) {
 416     print STDERR "ERROR: client returned $client_status\n";
 417     $SV->Kill (); $SV->TimedWait (1);
 418     exit 1;
 419 }
 420
 421 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 422
 423 if ($server_status == -1) {
 424     print STDERR "ERROR: server returned $server_status\n";
 425     $SV->Kill (); $SV->TimedWait (1);
 426     exit 1;
 427 }
 428
 429 $server->DeleteFile($iorbase);
 430 $client->DeleteFile($iorbase);
 431
 432 ###############################################################################
 433 print STDERR "===== Three-way test, client crashes and server detects\n";
 434
 435 $server_status = $SV->Spawn ();
 436
 437 if ($server_status != 0) {
 438     print STDERR "ERROR: server returned $server_status\n";
 439     exit 1;
 440 }
 441
 442 if ($server->WaitForFileTimed ($iorbase,
 443                                $server->ProcessStartWaitInterval()) == -1) {
 444     print STDERR "ERROR: cannot find file <$server_iorfile>\n";
 445     $SV->Kill (); $SV->TimedWait (1);
 446     exit 1;
 447 }
 448
 449 if ($server->GetFile ($iorbase) == -1) {
 450     print STDERR "ERROR: cannot retrieve file <$server_iorfile>\n";
 451     $SV->Kill (); $SV->TimedWait (1);
 452     exit 1;
 453 }
 454 if ($middle->PutFile ($iorbase) == -1) {
 455     print STDERR "ERROR: cannot set file <$middle_iorfile>\n";
 456     $SV->Kill (); $SV->TimedWait (1);
 457     exit 1;
 458 }
 459
 460 $middle_status = $MD->Spawn ();
 461
 462 if ($middle_status != 0) {
 463     print STDERR "ERROR: server returned $middle_status\n";
 464     $SV->Kill (); $SV->TimedWait (1);
 465     exit 1;
 466 }
 467
 468 if ($middle->WaitForFileTimed ($midiorbase,
 469                                $middle->ProcessStartWaitInterval()) == -1) {
 470     print STDERR "ERROR: cannot find file <$middle_midiorfile>\n";
 471     $SV->Kill (); $SV->TimedWait (1);
 472     $MD->Kill (); $MD->TimedWait (1);
 473     exit 1;
 474 }
 475
 476 if ($middle->GetFile ($midiorbase) == -1) {
 477     print STDERR "ERROR: cannot retrieve file <$middle_midiorfile>\n";
 478     $SV->Kill (); $SV->TimedWait (1);
 479     $MD->Kill (); $MD->TimedWait (1);
 480     exit 1;
 481 }
 482 if ($client->PutFile ($midiorbase) == -1) {
 483     print STDERR "ERROR: cannot set file <$client_midiorfile>\n";
 484     $SV->Kill (); $SV->TimedWait (1);
 485     $MD->Kill (); $MD->TimedWait (1);
 486     exit 1;
 487 }
 488
 489 $CL->Arguments ("-k file://$client_midiorfile -i 100 -s");
 490
 491 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 85, {self_crash => 1});
 492
 493 if ($client_status == -1) {
 494     print STDERR "ERROR: client returned $client_status\n";
 495     $SV->Kill (); $SV->TimedWait (1);
 496     $MD->Kill (); $MD->TimedWait (1);
 497     exit 1;
 498 }
 499
 500 $CL->Arguments ("-k file://$client_midiorfile -i 10 -x");
 501
 502 $client_status = $CL->SpawnWaitKill ($client->ProcessStartWaitInterval() + 85);
 503
 504 if ($client_status == -1) {
 505     print STDERR "ERROR: client returned $client_status\n";
 506     $SV->Kill (); $SV->TimedWait (1);
 507     $MD->Kill (); $MD->TimedWait (1);
 508     exit 1;
 509 }
 510
 511 $server_status = $SV->WaitKill ($server->ProcessStopWaitInterval());
 512
 513 if ($server_status != 0) {
 514     print STDERR "ERROR: server returned $server_status\n";
 515     $SV->Kill (); $SV->TimedWait (1);
 516     $MD->Kill (); $MD->TimedWait (1);
 517     exit 1;
 518 }
 519
 520 $middle_status = $MD->WaitKill ($middle->ProcessStopWaitInterval());
 521
 522 if ($middle_status != 0) {
 523     print STDERR "ERROR: server returned $middle_status\n";
 524     $SV->Kill (); $SV->TimedWait (1);
 525     exit 1;
 526 }
 527
 528 $server->DeleteFile($iorbase);
 529 $client->DeleteFile($midiorbase);
 530 $middle->DeleteFile($iorbase);
 531 $middle->DeleteFile($midiorbase);
 532
 533 exit $status;