Sync with 5.4.0

[deliverable/titan.core.git] / regression_test / logger_control / logfilecheck

#!/usr/bin/perl -w

use strict;
# No use warnings; in 5.005 but we have the -w flag

my @expected_filenames;

BEGIN { # @expected_filenames must be set at compile time
my    $host = $ENV{HOSTNAME} || $ENV{HOSTNAME} || `hostname`;
chomp $host;

my    $user = $ENV{USER} || $ENV{USERNAME};

@expected_filenames = (
"logcontrol.log",
"changed_name-changename-L.log",
"changed_name-changename-.log",
"changed_name--.log",
);
}

if ($] < 5.006) {
  # ancient perl, we must be on Solaris :(
  my @perlloc = qw( /proj/TTCN/Tools/perl-5.10.1/bin/perl /mnt/TTCN/Tools/perl-5.10.1/bin/perl );
  foreach (@perlloc) {
    if (-x $_) {
      warn "Let's try with $_ instead";
      exec( $_, '-wT', $0, @ARGV ) or die "That didn't work either: $!";
    }
  }
}
else {
  require Test::More;
  use constant NUM_LOGFILES => scalar @expected_filenames;
                            
  Test::More->import(
    tests =>
  1 # test number of log files
+ 2 * NUM_LOGFILES  # test existence + switched/not switched
+ 1 # lines to be seen
+ 1 # lines not to be seen
+ 1 # setverdict
+ 2 # entity info on/off
+ 2 # match hint verbosity
  );                             
}

use strict;

##############################################################
# grep a file. Returns the number of times (lines) it matched.
# Parameter 1: filename
# Parameter 2: regex
sub grepper($$) {
  local $_;
  my ($filename, $regex) = @_;
  my $result = 0;
  open (LOG, '< ' . $filename) or die "open $filename: $!, $^E";
  while (<LOG>) {
    if ( /$regex/ ) {
      ++$result;
    }
  }
  close(LOG) or die "close: $!, $^E";
  return $result;
}

##############################################################
# Return 1 if "switching to log file" appears in the file.
# One parameter, the file name
sub switched($) {
  return grepper($_[0], qr/EXECUTOR_RUNTIME \S+\.ttcn:\d+ Switching to log file/) != 0;
}

# Start !

# Collect the list of log files on the disk. There are two patterns.
my   @files = <changed_name*.log>;
push @files , <logcontrol[.]log>;

# Check that it is the correct number
is(scalar @files, NUM_LOGFILES, 'Number of log files');

foreach my $x ( @expected_filenames )
{
  # Filter the list of filenames, keep just the matching ones
  my @g = grep($_ =~ /^$x$/, @files);
  # There must be exactly one match
  is(scalar @g, 1, "Found        : $x");
}

foreach my $fn ( @files )
{
  chomp $fn;
=head
  if ($fn =~ /^e=no,h=[\w.]+,l=\w+,n=HC,r=hc,t=,c=,s=\.log$/ ) {
    ok( !switched($fn), "Not switched : $fn" );
    is( grepper($fn, qr/The address of MC was set to a local IP address\. This may cause incorrect behaviour/), 1,
        "Local IP warn: $fn" );
  }
  else {
    ok(  switched($fn), "Switched     : $fn" );
  }

  if ($fn =~ /^c=,s=.log$/) {
    is( grepper($fn, qr/does not guarantee unique log file name for every test system process/), 1,
        "Warns once   : $fn\n(about log file name not being unique)" );
  }
=cut
  #
  if ($fn =~ /changed_name-changename-/) {
    ok( switched($fn), "Switched     : $fn" );
  }
  else {
    ok(!switched($fn), "Not switched : $fn" );
  }

  if ($fn =~ /logcontrol\.log/) {
    # post-run checks for testcase on_off()
    is( grepper($fn, qr/[^n][^o][^t] see this/), 5, "Log lines that should be seen");
    # This number needs to be adjusted ---------^^ to match testcase on_off
    # The zero below is fixed :) ---------------VV
    is( grepper($fn, qr/not see this/)         , 0, "Log lines that should NOT be seen");
    is( grepper($fn, qr/VERDICTOP.*We\'re back/), 1, "Setverdict line that should be seen");

    # post-run checks for testcase entity()
    is( grepper($fn, qr/USER_UNQUALIFIED \S+.ttcn:\d+\(testcase:\w+\) The tc should be mentioned in this log line/), 1, "LogEntityInfo switched on");
    is( grepper($fn, qr/USER_UNQUALIFIED \S+.ttcn:\d+ The entity should not be logged anymore/)                    , 1, "LogEntityInfo switched off");

    # post-run checks for testcase hints()
    is( grepper($fn, qr/Compact:\Q[0 <-> 0].field2 := "forty-two" with "fourty-two" unmatched\E/), 1, "Matching hints compact");
    is( grepper($fn, qr/Full   :.*unmatched Some hints to find the reason of mismatch:/)         , 1, "Matching hints full");
  }
}


__END__

Note: logcontrol.log will look like this only if location info was enabled.
This means the -L flag *must* be supplied to the TTCN-3 compiler!
Check the compilation log if the "LogEntityInfo switched on/off" test fail.

16:33:40.464985 USER_UNQUALIFIED logcontrol.ttcn:64(testcase:entity) The tc should be mentioned in this log line
16:33:40.465002 USER_UNQUALIFIED logcontrol.ttcn:68 The entity should not be logged anymore