ACE/bin/PerlACE/Run_Test.pm

   1 #!/usr/bin/env perl
   2
   3 # This module contains a few miscellaneous functions and some
   4 # startup ARGV processing that is used by all tests.
   5
   6 use PerlACE::Process;
   7 use PerlACE::ConfigList;
   8
   9 package PerlACE;
  10 use File::Spec;
  11 use Cwd;
  12
  13 $PerlACE::ACE_ROOT = $ENV{ACE_ROOT};
  14 if(exists $ENV{TAO_ROOT}) {
  15     $PerlACE::TAO_ROOT = $ENV{TAO_ROOT};
  16 } else {
  17     $PerlACE::TAO_ROOT = "$PerlACE::ACE_ROOT/TAO";
  18 }
  19
  20 my $config = new PerlACE::ConfigList;
  21 $PerlACE::TestConfig = $config;
  22
  23 # load VxWorks Process helpers in case this is a VxWorks target build
  24 $PerlACE::Static = $config->check_config("STATIC");
  25 $PerlACE::VxWorks_Test = $config->check_config("VxWorks");
  26 $PerlACE::VxWorks_RTP_Test = $config->check_config("VxWorks_RTP");
  27 if ($PerlACE::VxWorks_Test or $PerlACE::VxWorks_RTP_Test) {
  28     require PerlACE::ProcessVX;
  29 }
  30
  31 # Load LabVIEW RT Process helpers in case this is a LabVIEW RT target build.
  32 $PerlACE::LabVIEW_RT_Test = $config->check_config("LabVIEW_RT");
  33 if ($PerlACE::LabVIEW_RT_Test) {
  34     require PerlACE::ProcessLVRT;
  35 }
  36
  37 $PerlACE::WinCE_Test = $config->check_config("WINCE");
  38 if ($PerlACE::WinCE_Test) {
  39     if ($OSNAME eq "MSWin32") {
  40         require PerlACE::ProcessWinCE;
  41     } else {
  42         require PerlACE::ProcessWinCE_Unix;
  43     }
  44 }
  45
  46 $PerlACE::Android_Test = $config->check_config("ANDROID");
  47 if ($PerlACE::Android_Test) {
  48     require PerlACE::ProcessAndroid;
  49 }
  50
  51 # Figure out the svc.conf extension
  52 $svcconf_ext = $ENV{'ACE_RUNTEST_SVCCONF_EXT'};
  53 if (!defined $svcconf_ext) {
  54     $svcconf_ext = ".conf";
  55 }
  56
  57 # Default timeout.  NSCORBA needs more time for process start up.
  58 $wait_interval_for_process_creation = (($PerlACE::VxWorks_Test or $PerlACE::VxWorks_RTP_Test) ? 60 : 15);
  59 if ($^O eq 'VMS') {
  60     $wait_interval_for_process_creation *= 3;
  61 }
  62 elsif ($^O eq 'nto') {
  63     ## QNX can be slow to start processes
  64     $wait_interval_for_process_creation += 5;
  65 }
  66
  67 $wait_interval_for_process_shutdown = (($PerlACE::VxWorks_Test or $PerlACE::VxWorks_RTP_Test) ? 30 : 10);
  68
  69 # Turn on autoflush
  70 $| = 1;
  71
  72 sub LocalFile ($)
  73 {
  74     my $file = shift;
  75     if (File::Spec->file_name_is_absolute( $file )) {
  76        return $file;
  77     }
  78     my $newfile = getcwd () . '/' . $file;
  79
  80     if ($^O eq "MSWin32") {
  81         $newfile =~ s/\//\\/g;
  82     }
  83     elsif ($^O eq 'cygwin') {
  84         chop($newfile = `/usr/bin/cygpath -w $newfile`);
  85         $newfile =~ s/\\/\\\\/g;
  86     }
  87
  88     return $newfile;
  89 }
  90
  91 sub rebase_path {
  92     my $path = shift;
  93     my $cur_root = shift;
  94     my $new_root = shift;
  95     $path = File::Spec->rel2abs ($path);
  96     $path = File::Spec->abs2rel ($path, $cur_root);
  97     return $new_root."/".$path;
  98 }
  99
 100 sub VX_HostFile($)
 101 {
 102     my $file = shift;
 103     return rebase_path ($file, $ENV{'ACE_ROOT'}, $ENV{'HOST_ROOT'});
 104 }
 105
 106 # Returns a random port within the range of 10002 - 32767
 107 sub random_port {
 108     return (int(rand($$)) % 22766) + 10002;
 109 }
 110
 111 # Returns a unique id, uid for unix, last digit of IP for NT
 112 sub uniqueid
 113 {
 114     if ($^O eq "MSWin32") {
 115         my $uid = 1;
 116
 117         open (IPNUM, "ipconfig|") || die "Can't run ipconfig: $!\n";
 118
 119         while (<IPNUM>) {
 120             if (/Address/) {
 121                 $uid = (split (/: (\d+)\.(\d+)\.(\d+)\.(\d+)/))[4];
 122             }
 123         }
 124
 125         close IPNUM;
 126
 127         return $uid;
 128     }
 129     else {
 130         return $>;
 131     }
 132 }
 133
 134 # Waits until a file exists
 135 sub waitforfile
 136 {
 137     local($file) = @_;
 138     select(undef, undef, undef, 0.1) while (!(-e $file && -s $file));
 139 }
 140
 141 sub waitforfile_timed
 142 {
 143     my $file = shift;
 144     my $maxtime = shift;
 145     $maxtime *= (($PerlACE::VxWorks_Test || $PerlACE::VxWorks_RTP_Test) ?
 146                   $PerlACE::ProcessVX::WAIT_DELAY_FACTOR :
 147                   $PerlACE::Process::WAIT_DELAY_FACTOR);
 148     # Multiply with 10 because we wait a tenth of a second each time
 149     $maxtime *= 10;
 150
 151     while ($maxtime-- != 0) {
 152         if (-e $file && -s $file) {
 153             return 0;
 154         }
 155         select(undef, undef, undef, 0.1);
 156     }
 157     return -1;
 158 }
 159
 160 sub check_n_cleanup_files
 161 {
 162     my $file = shift;
 163     my @flist = glob ($file);
 164
 165     my $cntr = 0;
 166     my $nfile = scalar(@flist);
 167
 168     if ($nfile != 0) {
 169         for (; $cntr < $nfile; $cntr++) {
 170             print STDERR "File <$flist[$cntr]> exists but should be cleaned up\n";
 171         }
 172         unlink @flist;
 173     }
 174 }
 175
 176 sub generate_test_file
 177 {
 178     my $file = shift;
 179     my $size = shift;
 180
 181     while ( -e $file ) {
 182         $file = $file."X";
 183     }
 184
 185     my $data = "abcdefghijklmnopqrstuvwxyz";
 186     $data = $data.uc($data)."0123456789";
 187
 188     open( INPUT, "> $file" ) || die( "can't create input file: $file" );
 189     for($i=62; $i < $size ; $i += 62 ) {
 190         print INPUT $data;
 191     }
 192     $i -= 62;
 193     if ($i < $size) {
 194         print INPUT substr($data, 0, $size-$i);
 195     }
 196     close(INPUT);
 197
 198     return $file;
 199 }
 200
 201 sub is_labview_rt_test()
 202 {
 203     return ($PerlACE::LabVIEW_RT_Test);
 204 }
 205
 206 sub is_vxworks_test()
 207 {
 208     return ($PerlACE::VxWorks_Test || $PerlACE::VxWorks_RTP_Test);
 209 }
 210
 211 sub is_vxworks_rtp_test()
 212 {
 213     return ($PerlACE::VxWorks_RTP_Test);
 214 }
 215
 216 sub concat_path {
 217     my $pathlist   = shift;
 218     my $path       = shift;
 219     if ((!defined $pathlist) || $pathlist =~ /^\s*$/) {
 220         return $path;
 221     } else {
 222         return $pathlist . ($^O eq 'MSWin32' ? ';' : ':') . $path;
 223     }
 224 }
 225
 226 sub add_path {
 227     my $name   = shift;
 228     my $value  = shift;
 229     $ENV{$name} = concat_path ($ENV{$name}, $value);
 230 }
 231
 232 sub add_lib_path {
 233     my($value) = shift;
 234
 235     # Set the library path supporting various platforms.
 236     foreach my $env ('PATH', 'DYLD_LIBRARY_PATH', 'LD_LIBRARY_PATH',
 237                      'SHLIB_PATH') {
 238         add_path($env, $value);
 239         if (grep(($_ eq 'ARCH'), @PerlACE::ConfigList::Configs)) {
 240             add_path($env, $value . '/' . $PerlACE::Process::ExeSubDir);
 241         }
 242     }
 243
 244     if (defined $ENV{'HOST_ROOT'}) {
 245         add_path('PATH', VX_HostFile ($value));
 246         add_path('LD_LIBRARY_PATH', VX_HostFile ($value));
 247         add_path('LIBPATH', VX_HostFile ($value));
 248         add_path('SHLIB_PATH', VX_HostFile ($value));
 249     }
 250 }
 251
 252 sub check_privilege_group
 253 {
 254 }
 255
 256 # waits until it finds a matching regular expression in a file
 257 #  escape metacharacters in the text to wait for
 258 sub waitforfileoutput
 259 {
 260     my $file = shift;
 261     my $waittext = shift;
 262
 263     if (-e $file && -s $file) {
 264         open (DATA, $file);
 265         while (my $line = <DATA>) {
 266             if ($line =~ /($waittext)/) {
 267                 close(DATA);
 268                 return 0;
 269             }
 270         }
 271         close(DATA);
 272     }
 273     sleep 1;
 274 }
 275
 276 sub waitforfileoutput_timed
 277 {
 278     my $file = shift;
 279     my $waittext = shift;
 280     my $maxtime = shift;
 281
 282     $maxtime *= (($PerlACE::VxWorks_Test || $PerlACE::VxWorks_RTP_Test) ?
 283                   $PerlACE::ProcessVX::WAIT_DELAY_FACTOR :
 284                   $PerlACE::Process::WAIT_DELAY_FACTOR);
 285     # Multiply with 10 because we wait a tenth of a second each time
 286     $maxtime *= 10;
 287
 288     while ($maxtime-- != 0) {
 289         if (-e $file && -s $file) {
 290               open (DATA, $file);
 291               while (my $line = <DATA>) {
 292                   if ($line =~ /($waittext)/) {
 293                       close(DATA);
 294                       return 0;
 295                   }
 296               }
 297               close(DATA);
 298         }
 299         select(undef, undef, undef, 0.1);
 300     }
 301     return -1;
 302 }
 303
 304 sub GetArchDir
 305 {
 306     my $dir = shift;
 307     if (grep(($_ eq 'ARCH'), @PerlACE::ConfigList::Configs)) {
 308         return $dir . $PerlACE::Process::ExeSubDir;
 309     }
 310     return $dir;
 311 }
 312
 313 # Add PWD to the load library path
 314 add_lib_path ('.');
 315
 316 $sleeptime = 5;
 317
 318 1;