regression_test/CRTR00015758/logfilecheck

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 # No use warnings; in 5.005 but we have the -w flag
   5
   6 my @expected_filenames;
   7
   8 BEGIN { # @expected_filenames must be set at compile time
   9 my    $host = $ENV{HOSTNAME} || $ENV{HOSTNAME} || `hostname`;
  10 chomp $host;
  11 $host =~ s/\.\S+//;
  12
  13 my    $user = $ENV{USER} || $ENV{USERNAME};
  14
  15 @expected_filenames = (
  16 "e=no,h=$host,l=$user,n=HC,r=hc,t=,c=,s=\.log",
  17 "e=no,h=$host,l=$user,n=MTC,r=mtc,t=,c=,s=\.log",
  18 "e=no,h=$host,l=$user,n=MTC,r=mtc,t=,c=tc_nooooo,s=\.log",
  19 "e=no,h=$host,l=$user,n=MTC,r=mtc,t=,c=tc_no,s=\.log",
  20 "e=no,h=$host,l=$user,n=MTC,r=mtc,t=No,c=tc_nooooo,s=\.log",
  21 "e=no,h=$host,l=$user,n=MTC,r=mtc,t=No,c=tc_no,s=\.log",
  22                                       "c=,s=.log",
  23                                       "c=tc_nooooo,s=\.log",
  24                                       "c=tc_no,s=\.log",
  25 );
  26 }
  27
  28 if ($] < 5.006) {
  29   # ancient perl, we must be on Solaris :(
  30   my @perlloc = qw( /proj/TTCN/Tools/perl-5.10.1/bin/perl /mnt/TTCN/Tools/perl-5.10.1/bin/perl );
  31   foreach (@perlloc) {
  32     if (-x $_) {
  33       warn "Let's try with $_ instead";
  34       exec( $_, '-wT', $0, @ARGV ) or die "That didn't work either: $!";
  35     }
  36   }
  37 }
  38 else {
  39   require Test::More;
  40   use constant NUM_LOGFILES => scalar @expected_filenames;
  41
  42   Test::More->import(
  43     tests =>
  44   1 # test number of log files
  45 + 2 * NUM_LOGFILES  # test existence + switched/not switched
  46 + 1 # Local IP address warning
  47 + 1 # Non-unique log file name warning
  48   );
  49 }
  50
  51 use strict;
  52
  53 # grep a file. Returns the number of times (lines) it matched.
  54 # Parameter 1: filename
  55 # Parameter 2: regex
  56 sub grepper($$) {
  57   local $_;
  58   my ($filename, $regex) = @_;
  59   my $result = 0;
  60   open (LOG, '< ' . $filename) or die "open : $!, $^E";
  61   while (<LOG>) {
  62     if ( /$regex/ ) {
  63       ++$result;
  64     }
  65   }
  66   close(LOG) or die "close: $!, $^E";
  67   return $result;
  68 }
  69
  70 # Return 1 if "switching to log file" appears in the file.
  71 # One parameter, the file name
  72 sub switched($) {
  73   return grepper($_[0], qr/EXECUTOR_RUNTIME [sS]witching to log file/) != 0;
  74 }
  75
  76 # Start !
  77
  78 # Collect the list of log files on the disk. There are two patterns.
  79 my   @files = <e=no,h=*,l=*,n={HC\,r=hc,MTC\,r=mtc},*.log>;
  80 push @files , <c=*.log>;
  81
  82 # Check that it is the correct number
  83 is(scalar @files, NUM_LOGFILES, 'Number of log files');
  84
  85 foreach my $x ( @expected_filenames )
  86 {
  87   # Filter the list of filenames, keep just the matching ones
  88   my @g = grep($_ =~ /^$x$/, @files);
  89   # There must be exactly one match
  90   is(scalar @g, 1, "Found        : $x");
  91 }
  92
  93 foreach my $fn ( @files )
  94 {
  95   chomp $fn;
  96   if ($fn =~ /^e=no,h=[\w.-]+,l=\w+,n=HC,r=hc,t=,c=,s=\.log$/ ) {
  97     ok( !switched($fn), "Not switched : $fn" );
  98     is( grepper($fn, qr/The address of MC was set to a local IP address\. This may cause incorrect behavior/), 1,
  99         "Local IP warn: $fn" );
 100   }
 101   else {
 102     ok(  switched($fn), "Switched     : $fn" );
 103   }
 104
 105   if ($fn =~ /^c=,s=.log$/) {
 106     is( grepper($fn, qr/does not guarantee unique log file name for every test system process/), 1,
 107         "Warns once   : $fn\n(about log file name not being unique)" );
 108   }
 109 }
 110
 111
 112 __END__