ACE/tests/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 # This file is for running the tests in the ACE tests directory.
   7 # It is usually used for auto_compiles.
   8
   9 if (defined $ENV{ACE_ROOT}) {
  10   use lib "$ENV{ACE_ROOT}/bin";
  11 } else {
  12   use lib '../bin';
  13 }
  14 if (defined $ENV{top_srcdir}) {
  15   use lib "$ENV{top_srcdir}/bin";
  16 }
  17
  18 use PerlACE::TestTarget;
  19
  20 use Cwd;
  21 use English;
  22 use Getopt::Std;
  23 use FileHandle;
  24 use File::Basename;
  25
  26 $config_list = new PerlACE::ConfigList;
  27
  28 if (grep(($_ eq 'ARCH'), @PerlACE::ConfigList::Configs)) {
  29   my $subdir = $PerlACE::Process::ExeSubDir;
  30   $subdir =~ s/\/$//;
  31   $ENV{'ACE_EXE_SUB_DIR'} = $subdir;
  32 }
  33
  34
  35 ################################################################################
  36
  37 sub check_for_more_configs ()
  38 {
  39     my $fh = new FileHandle;
  40
  41     if ($fh->open ("< ../ace/ACE_COMPONENTS.list")) {
  42         while (<$fh>) {
  43             if (m/ Other /) {
  44                 print "Adding 'Other' as my config\n" if defined $opt_d;
  45                 $config_list->add_one_config ('OTHER');
  46             }
  47             if (m/ Token /) {
  48                 print "Adding 'Token' as my config\n" if defined $opt_d;
  49                 $config_list->add_one_config ('TOKEN');
  50             }
  51         }
  52
  53         $fh->close ();
  54     }
  55     elsif (defined $opt_d) {
  56        print "Could not open ACE_COMPONENTS.list file\n" if defined $opt_d;
  57        print "Assuming TOKEN and OTHER subsets are included\n" if defined $opt_d;
  58        $config_list->add_one_config ('OTHER');
  59        $config_list->add_one_config ('TOKEN');
  60     }
  61
  62     my $P = new PerlACE::Process ("../netsvcs/servers/main");
  63
  64     if (!-x $P->Executable ()) {
  65         $config_list->add_one_config ('missing_netsvcs');
  66     }
  67 }
  68
  69 ################################################################################
  70
  71 sub record_resources ()
  72 {
  73     if ($config_list->check_config ('CHECK_RESOURCES')) {
  74         if (!defined $ENV{'LOGNAME'}) {
  75             $user=`whoami`;
  76         }
  77         else {
  78             $user = $ENV{'LOGNAME'};
  79         }
  80
  81         $start_test_resources=`ipcs | egrep $user`;
  82     }
  83 }
  84
  85 ################################################################################
  86
  87 sub check_resources
  88 {
  89     my($oh) = shift;
  90     if ($config_list->check_config ('CHECK_RESOURCES')) {
  91         $end_test_resources=`ipcs | egrep $user`;
  92          if ("$start_test_resources" ne "$end_test_resources") {
  93             print STDERR "Warning: the ACE tests _may_ have leaked OS ".
  94                          "resources!\n";
  95             print STDERR "Warning: Before: $start_test_resources\n";
  96             print STDERR "Warning: After:  $end_test_resources\n";
  97         }
  98     }
  99 }
 100
 101 ################################################################################
 102
 103 sub run_program ($@)
 104 {
 105     my $target = shift;
 106     my $path = shift;
 107     my $arguments = shift;
 108     if ($path =~ /^(\S*)\s*(.*)/ ) {
 109         $path = $1;
 110         $arguments = $2 . $arguments;
 111     }
 112
 113     ## Print it out before we check for the executable
 114     ## if the executable doesn't exist, the error will show
 115     ## up as part of the previous test.
 116     print "auto_run_tests: tests/$path $arguments\n";
 117     if ($config_list->check_config ('Coverity')) {
 118       $ENV{COVERITY_TEST_NAME} = "tests/$path";
 119     }
 120
 121     my ($program, $dir, $suffix) = fileparse($path);
 122     my $start_dir = getcwd ();
 123     if ($dir ne "" && !chdir $dir) {
 124         print STDERR "Error: Can\'t chdir to $dir for $path\n";
 125         return;
 126     }
 127
 128     unlink <log/$program*.log>;
 129     unlink "core";
 130
 131     my $P = $target->CreateProcess($program, $arguments);
 132     if ($config_list->check_config ('Valgrind')) {
 133       $P->IgnoreExeSubDir(1);
 134     }
 135     else {
 136       ### Try to run the program
 137       if (! -e $P->Executable ()) {
 138           print STDERR "Error: " . $P->Executable () .
 139                        " does not exist or is not runnable\n";
 140           chdir $start_dir;
 141           return;
 142        }
 143     }
 144
 145     my $start_time = time();
 146     $status = $P->SpawnWaitKill (300 + $target->ProcessStartWaitInterval());
 147     my $time = time() - $start_time;
 148
 149     ### Check for problems
 150
 151     if ($status == -1) {
 152         print STDERR "Error: $program FAILED (time out after Time:$time"."s)\n";
 153         $P->Kill ();
 154         $P->TimedWait (1);
 155     }
 156     elsif ($status != 0) {
 157         print STDERR "Error: $program $arguments FAILED with exit status $status after Time:$time"."s\n";
 158     }
 159
 160     print "\nauto_run_tests_finished: tests/$program $arguments Time:$time"."s Result:$status\n";
 161
 162     check_log ($target, $program);
 163
 164     if ($config_list->check_config ('Codeguard')) {
 165         check_codeguard_log ($program);
 166     }
 167     chdir $start_dir;
 168 }
 169
 170 ################################################################################
 171
 172 sub purify_program ($)
 173 {
 174     ### @todo
 175
 176     my $program = shift;
 177
 178     $program_exe = $program;
 179
 180     print STDERR "Purifying $program\n";
 181
 182     system ("purify ".
 183             "/run ".
 184             "/save-data=purify_results\$program.pfy ".
 185             "/save-text-data=purify_results\$program.txt ".
 186             "/AllocCallStackLength=20 ".
 187             "/ErrorCallStackLength=20 ".
 188             "/HandlesInUseAtExit ".
 189             "/InUseAtExit ".
 190             "/LeaksAtExit ".
 191             "$program_exe");
 192 }
 193
 194 ################################################################################
 195
 196 sub check_log ($)
 197 {
 198     my $target = shift;
 199     my $program = shift;
 200
 201     ### Check the logs
 202     local $log_suffix = ".log";
 203
 204     # Support logs generated by tests in subdirectories, such as tests
 205     # found in the SSL subdirectory.
 206     local $the_program = basename($program);
 207     local $log = "log/".$the_program.$log_suffix;
 208
 209     if ($target->GetFile ($log, $log) == -1) {
 210         print STDERR "ERROR: cannot retrieve file <$log>\n";
 211     }
 212
 213     if (-e "core") {
 214         print STDERR "Error: $program dumped core\n";
 215         unlink "core";
 216     }
 217
 218     if (! -e $log ) {
 219         print STDERR "Error: No log file ($log) is present\n";
 220     }
 221     else {
 222         if (open (LOG, "<".$log) == 0) {
 223             print STDERR "Error: Cannot open log file $log\n";
 224         }
 225         else {
 226             my $print_log = 0;
 227             my $starting_matched = 0;
 228             my $ending_matched = 0;
 229
 230             while (<LOG>) {
 231                 chomp;
 232
 233                 if (m/Starting/) {
 234                     $starting_matched = 1;
 235                 }
 236
 237                 if (m/Ending/) {
 238                     $ending_matched = 1;
 239                 }
 240
 241                 if (/LM\_ERROR\@(.*)$/) {
 242                     print STDERR "Error: ($log): $1\n";
 243                     $print_log = 1;
 244                 }
 245                 if (/LM\_WARNING\@(.*)$/) {
 246                     print STDERR "Warning: ($log): $1\n";
 247                     $print_log = 1;
 248                 }
 249             }
 250
 251             close (LOG); # ignore errors
 252
 253             if ($starting_matched == 0) {
 254                 print STDERR "Error ($log): no line with 'Starting'\n";
 255                 $print_log = 1;
 256             }
 257
 258             if ($ending_matched == 0) {
 259                 print STDERR "Error ($log): no line with 'Ending'\n";
 260                 $print_log = 1;
 261             }
 262
 263             if ($print_log == 1) {
 264                 print STDERR "======= Begin Log File \n";
 265                 if (open (LOG, "<".$log) == 0) {
 266                     print STDERR "Error: Cannot open log file $log\n";
 267                 }
 268                 else {
 269                     my @log = <LOG>;
 270                     print STDERR @log;
 271                     close (LOG);
 272                 }
 273                 print STDERR "======= End Log File \n";
 274             }
 275
 276             # Now check for any sub-logs. If either the main log or a
 277             # sub-log has an error, print the sub-log.
 278             opendir (THISDIR, "log");
 279             local $sublognames = "$program\-.*".$log_suffix;
 280             @sublogs = grep (/^$sublognames/, readdir (THISDIR));
 281             closedir (THISDIR);
 282             my $saw_short_process_manager_child_log = 0;
 283             foreach $log (@sublogs) {
 284                 # Just like the main log, but note that Process_Manager_Test
 285                 # kills (signal 9) one of its children so the log may get
 286                 # deleted, or it may be incomplete. So let this one go, but
 287                 # only once per Process_Manager_Test.
 288                 if (open (LOG, "<log/".$log) == 0) {
 289                     print STDERR "Error: Cannot open sublog file $log\n";
 290                 }
 291                 else {
 292                     my $number_starting = 0;
 293                     my $number_ending = 0;
 294                     while (<LOG>) {
 295                         chomp;
 296                         if (m/Starting/) {
 297                             $number_starting++;
 298                         }
 299                         if (m/Ending/) {
 300                             $number_ending++;
 301                         }
 302                         if (/LM\_ERROR\@(.*)$/) {
 303                             print STDERR "Error: ($log): $1\n";
 304                             $print_log = 1;
 305                         }
 306                         if (/LM\_WARNING\@(.*)$/) {
 307                             print STDERR "Warning: ($log): $1\n";
 308                             $print_log = 1;
 309                         }
 310                     }
 311
 312                     if ($number_starting == 0) {
 313                        print STDERR "Error ($log): no line with 'Starting'\n";
 314                        $print_log = 1;
 315                     }
 316
 317                     if ($number_ending == 0) {
 318                        if ($program eq 'Process_Manager_Test' &&
 319                            $saw_short_process_manager_child_log == 0) {
 320                            $saw_short_process_manager_child_log = 1;
 321                            $number_ending = 1;
 322                        }
 323                        else {
 324                            print STDERR "Error ($log): no line with 'Ending'\n";
 325                            $print_log = 1;
 326                        }
 327                     }
 328
 329                     if ($number_starting != $number_ending) {
 330                        print STDERR "Error ($log): Number of 'Starting' does not match number of 'Ending' ($number_starting != $number_ending)\n";
 331                        $print_log = 1;
 332                     }
 333
 334                     close (LOG); # ignore errors
 335                     if ($print_log == 1) {
 336                         print STDERR "======= Begin Sublog File ".$log."\n";
 337                         if (open (LOG, "<log/".$log) == 0) {
 338                             print STDERR "Error: Cannot open sublog file $log\n";
 339                         }
 340                         else {
 341                             my @log = <LOG>;
 342                             print STDERR @log;
 343                             close (LOG);
 344                         }
 345                         print STDERR "======= End Sublog File \n";
 346                     }
 347                 }
 348             }
 349         }
 350     }
 351 }
 352
 353 sub check_codeguard_log ($)
 354 {
 355     my $program = shift;
 356
 357     ### Check the logs
 358
 359     local $log = $program.".cgl";
 360
 361     if (-e $log ) {
 362        print STDERR "======= Begin Codeguard Log File \n";
 363        if (open (LOG, "<".$log) == 0) {
 364            print STDERR "Error: Cannot open codeguard log file $log\n";
 365        }
 366        else {
 367            my @log = <LOG>;
 368            print STDERR @log;
 369            close (LOG);
 370        }
 371        print STDERR "======= End Codeguard Log File \n";
 372     }
 373 }
 374
 375 ################################################################################
 376
 377 sub delete_temp_files ()
 378 {
 379     my @files = ('ace_pipe_name', 'pattern');
 380     my $file = '';
 381
 382     if (!opendir (DIR, $tmp)) {
 383         warn "Cannot open temp directory $tmp\n";
 384         return;
 385     }
 386
 387     foreach $file (readdir (DIR)) {
 388       if ($file =~ /^ace_temp_file/ || $file =~ /^Naming_Test/) {
 389           push @files, $tmp . '/' . $file;
 390       }
 391     }
 392     closedir (DIR);
 393
 394     PerlACE::check_n_cleanup_files ('MEM_Acceptor_*');
 395     PerlACE::check_n_cleanup_files ('backing_store_*');
 396 }
 397
 398 ################################################################################
 399
 400 if (!getopts ('dhtvo:l:') || $opt_h) {
 401     print "run_test.pl [-h] [-v] [-o <output file>] [-t file1 file2 ...]\n";
 402     print "\n";
 403     print "Runs the tests listed in run_test.lst\n";
 404     print "\n";
 405     print "Options:\n";
 406     print "    -d         Debug mode (do not run tests)\n";
 407     print "    -h         Display this help\n";
 408     print "    -t         Runs all the tests passed via the cmd line\n";
 409     print "    -l list    Load the list and run only those tests\n";
 410     print "\n";
 411     print "Pass in configs using \"-Config XXXXX\"\n";
 412     print "\n";
 413     print "Possible Configs: CHECK_RESOURCES Purify Codeguard Valgrind Coverity ",
 414            $config_list->list_configs (), "\n";
 415     exit (1);
 416 }
 417
 418 ## since we can't use "our" to get rid of warnings.
 419 $opt_h = $opt_h if (defined $opt_h);
 420 $opt_t = $opt_t if (defined $opt_t);
 421 $opt_g = $opt_g if (defined $opt_g);
 422
 423 if (!($tmp = $ENV{TMP}) && !($tmp = $ENV{TEMP})) {
 424     $tmp="/tmp";
 425 }
 426
 427 check_for_more_configs ();
 428
 429 @tests = ();
 430
 431 if (defined $opt_t) {
 432     @tests = @ARGV;
 433 }
 434 elsif (defined $opt_l) {
 435     $config_list->load ("$opt_l");
 436     @tests = $config_list->valid_entries ();
 437 }
 438 else {
 439     $config_list->load ("run_test.lst");
 440     @tests = $config_list->valid_entries ();
 441 }
 442
 443 if (defined $opt_d) {
 444     $config_list->dump ();
 445 }
 446
 447 record_resources () if (!defined $opt_d);
 448
 449 my($oh) = \*STDOUT;
 450
 451 my $target = PerlACE::TestTarget::create_target (1);
 452
 453 $target->AddLibPath("$ENV{ACE_ROOT}/tests");
 454
 455 # Put needed files in place for targets that require them.
 456 # Service_Config_Test needs service config file.
 457 my $svc_conf_file = "Service_Config_Test.conf";
 458 if ($target->PutFile ($svc_conf_file) == -1) {
 459     print STDERR "WARNING: Cannot send $svc_conf_file to target\n";
 460 }
 461 # Config_Test needs config ini file.
 462 my $conf_ini_file = "Config_Test_Import_1.ini";
 463 if ($target->PutFile ($conf_ini_file) == -1) {
 464     print STDERR "WARNING: Cannot send $conf_ini_file to target\n";
 465 }
 466 # Service_Config_Stream_Test needs service config file.
 467 $svc_conf_file = "Service_Config_Stream_Test.conf";
 468 if ($target->PutFile ($svc_conf_file) == -1) {
 469     print STDERR "WARNING: Cannot send $svc_conf_file to target\n";
 470 }
 471 # Bug_3334_Regression_Test needs service config file.
 472 $svc_conf_file = "Bug_3334_Regression_Test.conf";
 473 if ($target->PutFile ($svc_conf_file) == -1) {
 474     print STDERR "WARNING: Cannot send $svc_conf_file to target\n";
 475 }
 476 # Bug_3912_Regression_Test needs service config file.
 477 $svc_conf_file = "Bug_3912_Regression_Test.conf";
 478 if ($target->PutFile ($svc_conf_file) == -1) {
 479     print STDERR "WARNING: Cannot send $svc_conf_file to target\n";
 480 }
 481
 482 foreach $test (@tests) {
 483
 484     if (defined $opt_d) {
 485         print "Would run test $test now\n";
 486     }
 487     elsif ($config_list->check_config ('Purify')) {
 488         purify_program ($test);
 489     }
 490     else {
 491         run_program ($target, $test);
 492     }
 493     $target->GetStderrLog();
 494 }
 495
 496 check_resources ($oh) if (!defined $opt_d);
 497
 498 delete_temp_files ();