1# -*- cperl -*-
2# Copyright (c) 2004, 2011, Oracle and/or its affiliates.
3# Copyright (c) 2009-2011, Monty Program Ab
4#
5# This program is free software; you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation; version 2 of the License.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License
15# along with this program; if not, write to the Free Software
16# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1335  USA
17
18# This is a library file used by the Perl version of mysql-test-run,
19# and is part of the translation of the Bourne shell script with the
20# same name.
21
22package mtr_report;
23
24use strict;
25use Sys::Hostname;
26
27use base qw(Exporter);
28our @EXPORT= qw(report_option mtr_print_line mtr_print_thick_line
29		mtr_print_header mtr_report mtr_report_stats
30		mtr_warning mtr_error mtr_debug mtr_verbose
31		mtr_verbose_restart mtr_report_test_passed
32		mtr_report_test_skipped mtr_print
33		mtr_report_test isotime);
34
35use mtr_match;
36use My::Platform;
37use POSIX qw[ _exit ];
38use IO::Handle qw[ flush ];
39use mtr_results;
40use Term::ANSIColor;
41use English;
42
43my $tot_real_time= 0;
44my $tests_done= 0;
45my $tests_failed= 0;
46
47our $timestamp= 0;
48our $timediff= 0;
49our $name;
50our $verbose;
51our $verbose_restart= 0;
52our $timer= 1;
53our $tests_total;
54
55my %color_map = qw/pass green
56                   retry-pass green
57                   fail red
58                   retry-fail red
59                   disabled bright_black
60                   skipped yellow
61                   reset reset/;
62
63my $set_titlebar;
64my $set_color= sub { };
65
66if (-t STDOUT) {
67  if (IS_WINDOWS) {
68    eval {
69      require Win32::Console;
70      $set_titlebar = sub { &Win32::Console::Title($_[0]);};
71    }
72  } elsif ($ENV{TERM} =~ /xterm/) {
73    $set_titlebar = sub { syswrite STDOUT, "\e]0;$_[0]\a"; };
74    $set_color = sub { syswrite STDOUT, color($color_map{$_[0]}); }
75  }
76}
77
78sub titlebar_stat($) {
79
80  sub time_format($) {
81    sprintf '%d:%02d:%02d', $_[0]/3600, ($_[0]/60)%60, $_[0]%60;
82  }
83
84  $tests_done++;
85  $tests_failed++ if $_[0] =~ /fail/;
86  $tests_total++ if $_[0] =~ /retry/;
87
88  my $spent = time - $BASETIME;
89  my $left = $tests_total - $tests_done;
90
91  &$set_titlebar(sprintf "mtr: spent %s on %d tests. %s (%d tests) left, %d failed",
92           time_format($spent), $tests_done,
93           time_format($spent/$tests_done * $left), $left, $tests_failed);
94}
95
96sub report_option {
97  my ($opt, $value)= @_;
98
99  # Evaluate $opt as string to use "Getopt::Long::Callback legacy API"
100  my $opt_name = "$opt";
101
102  # Convert - to _ in option name
103  $opt_name =~ s/-/_/g;
104  no strict 'refs';
105  ${$opt_name}= $value;
106}
107
108sub _name {
109  return $name ? $name." " : undef;
110}
111
112sub _mtr_report_test_name ($) {
113  my $tinfo= shift;
114  my $tname= $tinfo->fullname();
115
116  return unless defined $verbose;
117
118  print _name(). _timestamp();
119  printf "%-40s ", $tname;
120  my $worker = $tinfo->{worker};
121  print "w$worker " if defined $worker;
122
123  return $tname;
124}
125
126
127sub mtr_report_test_skipped ($) {
128  my ($tinfo)= @_;
129  $tinfo->{'result'}= 'MTR_RES_SKIPPED';
130
131  mtr_report_test($tinfo);
132}
133
134
135sub mtr_report_test_passed ($) {
136  my ($tinfo)= @_;
137
138  # Save the timer value
139  my $timer_str=  "";
140  if ( $timer and -f "$::opt_vardir/log/timer" )
141  {
142    $timer_str= ::mtr_fromfile("$::opt_vardir/log/timer");
143    $tinfo->{timer}= $timer_str;
144    resfile_test_info('duration', $timer_str) if $::opt_resfile;
145  }
146
147  # Big warning if status already set
148  if ( $tinfo->{'result'} ){
149    mtr_warning("mtr_report_test_passed: Test result",
150		"already set to '", $tinfo->{'result'}, ",");
151  }
152
153  $tinfo->{'result'}= 'MTR_RES_PASSED';
154
155  mtr_report_test($tinfo);
156
157  resfile_global("endtime ", isotime (time));
158}
159
160
161sub mtr_report_test ($) {
162  my ($tinfo)= @_;
163  my $test_name = _mtr_report_test_name($tinfo);
164
165  my $comment=  $tinfo->{'comment'};
166  my $logfile=  $tinfo->{'logfile'};
167  my $warnings= $tinfo->{'warnings'};
168  my $result=   $tinfo->{'result'};
169  my $retry=    $tinfo->{'retries'} ? "retry-" : $tinfo->{'repeat'} ? "$tinfo->{'repeat'} " : "";
170
171  if ($result eq 'MTR_RES_FAILED'){
172
173    my $timest = format_time();
174    my $fail = "fail";
175
176    if ( @$::experimental_test_cases )
177    {
178      # Find out if this test case is an experimental one, so we can treat
179      # the failure as an expected failure instead of a regression.
180      for my $exp ( @$::experimental_test_cases ) {
181	# Include pattern match for combinations
182        if ( $exp ne $test_name && $test_name !~ /^$exp / ) {
183          # if the expression is not the name of this test case, but has
184          # an asterisk at the end, determine if the characters up to
185          # but excluding the asterisk are the same
186          if ( $exp ne "" && substr($exp, -1, 1) eq "*" ) {
187            my $nexp = substr($exp, 0, length($exp) - 1);
188            if ( substr($test_name, 0, length($nexp)) ne $nexp ) {
189              # no match, try next entry
190              next;
191            }
192            # if yes, fall through to set the exp-fail status
193          } else {
194            # no match, try next entry
195            next;
196          }
197        }
198        $fail = "exp-fail";
199        $tinfo->{exp_fail}= 1;
200        last;
201      }
202    }
203
204    if ( $warnings )
205    {
206      mtr_report("[ $retry$fail ]  Found warnings/errors in server log file!");
207      mtr_report("        Test ended at $timest");
208      mtr_report($warnings);
209      return;
210    }
211    my $timeout= $tinfo->{'timeout'};
212    if ( $timeout )
213    {
214      mtr_report("[ $retry$fail ]  timeout after $timeout seconds");
215      mtr_report("        Test ended at $timest");
216      mtr_report("\n$tinfo->{'comment'}");
217      return;
218    }
219    else
220    {
221      mtr_report("[ $retry$fail ]\n        Test ended at $timest");
222    }
223
224    if ( $logfile )
225    {
226      # Test failure was detected by test tool and its report
227      # about what failed has been saved to file. Display the report.
228      mtr_report("\n$logfile\n");
229    }
230    if ( $comment )
231    {
232      # The test failure has been detected by mysql-test-run.pl
233      # when starting the servers or due to other error, the reason for
234      # failing the test is saved in "comment"
235      mtr_report("\n$comment\n");
236    }
237
238    if ( !$logfile and !$comment )
239    {
240      # Neither this script or the test tool has recorded info
241      # about why the test has failed. Should be debugged.
242      mtr_report("\nUnknown result, neither 'comment' or 'logfile' set");
243    }
244  }
245  elsif ($result eq 'MTR_RES_SKIPPED')
246  {
247    if ( $tinfo->{'disable'} )
248    {
249      mtr_report("[ disabled ]  $comment");
250    }
251    elsif ( $comment )
252    {
253      mtr_report("[ skipped ]  $comment");
254    }
255    else
256    {
257      mtr_report("[ skipped ]");
258    }
259    if ( $tinfo->{'warnings'} )
260    {
261      mtr_report($tinfo->{'warnings'});
262    }
263  }
264  elsif ($result eq 'MTR_RES_PASSED')
265  {
266    my $timer_str= $tinfo->{timer} || "";
267    $tot_real_time += ($timer_str/1000);
268    mtr_report("[ ${retry}pass ] ", sprintf("%5s", $timer_str));
269
270    # Show any problems check-testcase found
271    if ( defined $tinfo->{'check'} )
272    {
273      mtr_report($tinfo->{'check'});
274    }
275  }
276}
277
278
279sub mtr_report_stats ($$$$) {
280  my $prefix= shift;
281  my $fail= shift;
282  my $tests= shift;
283  my $extra_warnings= shift;
284
285  # ----------------------------------------------------------------------
286  # Find out how we where doing
287  # ----------------------------------------------------------------------
288
289  my $tot_disabled = 0;
290  my $tot_skipped= 0;
291  my $tot_skipdetect= 0;
292  my $tot_passed= 0;
293  my $tot_failed= 0;
294  my $tot_tests=  0;
295  my $tot_restarts= 0;
296  my $found_problems= 0;
297
298  foreach my $tinfo (@$tests)
299  {
300    if ( $tinfo->{failures} )
301    {
302      # Test has failed at least one time
303      $tot_tests++;
304      $tot_failed++;
305    }
306    elsif ( $tinfo->{'result'} eq 'MTR_RES_SKIPPED' )
307    {
308      # Test was skipped (disabled not counted)
309      $tot_skipped++ unless $tinfo->{'disable'};
310      $tot_disabled++ if $tinfo->{'disable'};
311      $tot_skipdetect++ if $tinfo->{'skip_detected_by_test'};
312    }
313    elsif ( $tinfo->{'result'} eq 'MTR_RES_PASSED' )
314    {
315      # Test passed
316      $tot_tests++;
317      $tot_passed++;
318    }
319
320    if ( $tinfo->{'restarted'} )
321    {
322      # Servers was restarted
323      $tot_restarts++;
324    }
325
326    # Add counts for repeated runs, if any.
327    # Note that the last run has already been counted above.
328    my $num_repeat = $tinfo->{'repeat'} - 1;
329    if ( $num_repeat > 0 )
330    {
331      $tot_tests += $num_repeat;
332      my $rep_failed = $tinfo->{'rep_failures'} || 0;
333      $tot_failed += $rep_failed;
334      $tot_passed += $num_repeat - $rep_failed;
335    }
336
337    # Look for warnings produced by mysqltest
338    my $base_file= mtr_match_extension($tinfo->{'result_file'},
339				       "result"); # Trim extension
340    my $warning_file= "$base_file.warnings";
341    if ( -f $warning_file )
342    {
343      $found_problems= 1;
344      mtr_warning("Check myqltest warnings in '$warning_file'");
345    }
346  }
347
348  # ----------------------------------------------------------------------
349  # Print out a summary report to screen
350  # ----------------------------------------------------------------------
351  print "The servers were restarted $tot_restarts times\n";
352
353  if ( $timer )
354  {
355    mtr_report("Spent", sprintf("%.3f", $tot_real_time),"of",
356	       time - $BASETIME, "seconds executing testcases");
357  }
358
359  resfile_global("duration", time - $BASETIME) if $::opt_resfile;
360
361  my $warnlog= "$::opt_vardir/log/warnings";
362  if ( ! $::glob_use_running_server && !$::opt_extern && -f $warnlog)
363  {
364    mtr_warning("Got errors/warnings while running tests, please examine",
365		"'$warnlog' for details.");
366  }
367
368  print "\n";
369  # Print a list of check_testcases that failed(if any)
370  if ( $::opt_check_testcases )
371  {
372    my %check_testcases;
373
374    foreach my $tinfo (@$tests)
375    {
376      if ( defined $tinfo->{'check_testcase_failed'} )
377      {
378	$check_testcases{$tinfo->{'name'}}= 1;
379      }
380    }
381
382    if ( keys %check_testcases )
383    {
384      print "Check of testcase failed for: ";
385      print join(" ", keys %check_testcases);
386      print "\n\n";
387    }
388  }
389
390  # Print summary line prefix
391  print "$prefix: ";
392
393  # Print a list of testcases that failed
394  if ( $tot_failed != 0 )
395  {
396
397    # Print each failed test, again
398    #foreach my $test ( @$tests ){
399    #  if ( $test->{failures} ) {
400    #    mtr_report_test($test);
401    #  }
402    #}
403
404    my $ratio=  $tot_passed * 100 / $tot_tests;
405    print "Failed $tot_failed/$tot_tests tests, ";
406    printf("%.2f", $ratio);
407    print "\% were successful.\n\n";
408
409    # Print the list of test that failed in a format
410    # that can be copy pasted to rerun only failing tests
411    print "Failing test(s):";
412
413    my %seen= ();
414    foreach my $tinfo (@$tests)
415    {
416      my $tname= $tinfo->{'name'};
417      if ( ($tinfo->{failures} || $tinfo->{rep_failures}) and ! $seen{$tname})
418      {
419        print " $tname";
420	$seen{$tname}= 1;
421      }
422    }
423    print "\n\n";
424
425    # Print info about reporting the error
426    print
427      "The log files in var/log may give you some hint of what went wrong.\n\n",
428      "If you want to report this error, please read first ",
429      "the documentation\n",
430      "at http://dev.mysql.com/doc/mysql/en/mysql-test-suite.html\n\n";
431
432   }
433  else
434  {
435    print "All $tot_tests tests were successful.\n\n";
436  }
437
438  if ($::opt_xml_report) {
439    my $xml_report = "";
440    my @sorted_tests = sort {$a->{'name'} cmp $b->{'name'}} @$tests;
441    my $last_suite = "";
442    my $current_suite = "";
443    my $timest = isotime(time);
444    my %suite_totals;
445    my %suite_time;
446    my %suite_tests;
447    my %suite_failed;
448    my %suite_disabled;
449    my %suite_skipped;
450    my $host = hostname;
451    my $suiteNo = 0;
452
453    # loop through test results to count totals
454    foreach my $test ( @sorted_tests ) {
455      $current_suite = $test->{'suite'}->{'name'};
456
457      if ($test->{'timer'} eq "") {
458        $test->{'timer'} = 0;
459      }
460
461      $suite_time{$current_suite} = $suite_time{$current_suite} + $test->{'timer'};
462      $suite_tests{$current_suite} = $suite_tests{$current_suite} + 1;
463
464      if ($test->{'result'} eq "MTR_RES_FAILED") {
465        $suite_failed{$current_suite} = $suite_failed{$current_suite} + 1;
466      } elsif ($test->{'result'} eq "MTR_RES_SKIPPED" && $test->{'disable'}) {
467        $suite_disabled{$current_suite} = $suite_disabled{$current_suite} + 1;
468      } elsif ($test->{'result'} eq "MTR_RES_SKIPPED") {
469        $suite_skipped{$current_suite} = $suite_skipped{$current_suite} + 1;
470      }
471
472      $suite_totals{"all_time"} = $suite_totals{"all_time"} + $test->{'timer'};
473    }
474
475    my $all_time = sprintf("%.3f", $suite_totals{"all_time"} / 1000);
476    my $suite_time = 0;
477    my $test_time = 0;
478
479    # generate xml
480    $xml_report = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
481    $xml_report .= qq(<testsuites disabled="$tot_disabled" errors="" failures="$tot_failed" name="" tests="$tot_tests" time="$all_time">\n);
482
483    foreach my $test ( @sorted_tests ) {
484      $current_suite = $test->{'suite'}->{'name'};
485
486      if ($current_suite ne $last_suite) {
487        if ($last_suite ne "") {
488          $xml_report .= "\t</testsuite>\n";
489          $suiteNo++;
490        }
491
492        $suite_time = sprintf("%.3f", $suite_time{$current_suite} / 1000);
493        $xml_report .= qq(\t<testsuite disabled="$suite_disabled{$current_suite}" errors="" failures="$suite_failed{$current_suite}" hostname="$host" id="$suiteNo" name="$current_suite" package="" skipped="$suite_skipped{$current_suite}" tests="$suite_tests{$current_suite}" time="$suite_time" timestamp="$timest">\n);
494        $last_suite = $current_suite;
495      }
496
497      $test_time = sprintf("%.3f", $test->{timer} / 1000);
498      $test->{'name'} =~ s/$current_suite\.//;
499
500      my $combinations;
501      if (defined($test->{combinations})){
502        $combinations = join ',', sort @{$test->{combinations}};
503      } else {
504        $combinations = "";
505      }
506
507      $xml_report .= qq(\t\t<testcase assertions="" classname="$current_suite" name="$test->{'name'}" ).
508                     qq(status="$test->{'result'}" time="$test_time" combinations="$combinations");
509
510      my $comment= replace_special_symbols($test->{'comment'});
511
512      if ($test->{'result'} eq "MTR_RES_FAILED") {
513        my $logcontents = $test->{'logfile-failed'} || $test->{'logfile'};
514        $logcontents= $logcontents.$test->{'warnings'}."\n";
515        # remove any double ] that would end the cdata
516        $logcontents =~ s/]]/\x{fffd}/g;
517        # replace wide characters that aren't allowed in XML 1.0
518        $logcontents =~ s/[\x00-\x08\x0B\x0C\x0E-\x1F]/\x{fffd}/g;
519
520        $xml_report .= qq(>\n\t\t\t<failure message="" type="MTR_RES_FAILED">\n<![CDATA[$logcontents]]>\n\t\t\t</failure>\n\t\t</testcase>\n);
521      } elsif ($test->{'result'} eq "MTR_RES_SKIPPED" && $test->{'disable'}) {
522        $xml_report .= qq(>\n\t\t\t<disabled message="$comment" type="MTR_RES_SKIPPED"/>\n\t\t</testcase>\n);
523      } elsif ($test->{'result'} eq "MTR_RES_SKIPPED") {
524        $xml_report .= qq(>\n\t\t\t<skipped message="$comment" type="MTR_RES_SKIPPED"/>\n\t\t</testcase>\n);
525      } else {
526        $xml_report .= " />\n";
527      }
528    }
529
530    $xml_report .= "\t</testsuite>\n</testsuites>\n";
531
532    # save to file
533    my $xml_file = $::opt_xml_report;
534
535    open (my $XML_UFILE, '>:encoding(UTF-8)', $xml_file) or die 'Cannot create file $xml_file: $!';
536    print $XML_UFILE $xml_report;
537    close $XML_UFILE or warn "File close failed!";
538  }
539
540  if (@$extra_warnings)
541  {
542    print <<MSG;
543Errors/warnings were found in logfiles during server shutdown after running the
544following sequence(s) of tests:
545MSG
546    print "    $_\n" for @$extra_warnings;
547  }
548
549  print "$tot_skipped tests were skipped, ".
550    "$tot_skipdetect by the test itself.\n\n" if $tot_skipped;
551
552  if ( $tot_failed != 0 || $found_problems)
553  {
554    mtr_error("there were failing test cases");
555  }
556  elsif (@$extra_warnings)
557  {
558    mtr_error("There where errors/warnings in server logs after running test cases.");
559  }
560  elsif ($fail)
561  {
562    mtr_error("Test suite failure, see messages above for possible cause(s).");
563  }
564}
565
566
567##############################################################################
568#
569#  Text formatting
570#
571##############################################################################
572
573sub mtr_print_line () {
574  print '-' x 74 . "\n";
575}
576
577sub replace_special_symbols($) {
578  my $text= shift;
579  $text =~ s/&/&#38;/g;
580  $text =~ s/'/&#39;/g;
581  $text =~ s/"/&#34;/g;
582  $text =~ s/</&lt;/g;
583  $text =~ s/>/&gt;/g;
584  return $text;
585}
586
587
588sub mtr_print_thick_line {
589  my $char= shift || '=';
590  print $char x 78 . "\n";
591}
592
593
594sub mtr_print_header ($) {
595  my ($wid) = @_;
596  print "\n";
597  printf "TEST";
598  if ($wid) {
599    print " " x 34 . "WORKER ";
600  } else {
601    print " " x 38;
602  }
603  print "RESULT   ";
604  print "TIME (ms) or " if $timer;
605  print "COMMENT\n";
606  mtr_print_line();
607  print "\n";
608}
609
610
611##############################################################################
612#
613#  Log and reporting functions
614#
615##############################################################################
616
617use Time::localtime;
618
619use Time::HiRes qw(gettimeofday);
620
621sub format_time {
622  my $tm= localtime();
623  return sprintf("%4d-%02d-%02d %02d:%02d:%02d",
624		 $tm->year + 1900, $tm->mon+1, $tm->mday,
625		 $tm->hour, $tm->min, $tm->sec);
626}
627
628my $t0= gettimeofday();
629
630sub _timestamp {
631  return "" unless $timestamp;
632
633  my $diff;
634  if ($timediff){
635    my $t1= gettimeofday();
636    my $elapsed= $t1 - $t0;
637
638    $diff= sprintf(" +%02.3f", $elapsed);
639
640    # Save current time for next lap
641    $t0= $t1;
642
643  }
644
645  my $tm= localtime();
646  return sprintf("%02d%02d%02d %2d:%02d:%02d%s ",
647		 $tm->year % 100, $tm->mon+1, $tm->mday,
648		 $tm->hour, $tm->min, $tm->sec, $diff);
649}
650
651# Always print message to screen
652sub mtr_print (@) {
653  print _name(). join(" ", @_). "\n";
654}
655
656
657# Print message to screen if verbose is defined
658sub mtr_report (@) {
659  if (defined $verbose)
660  {
661    my @s = split /\[ (\S+) \]/, _name() . "@_\n";
662    if (@s > 1) {
663      print $s[0];
664      &$set_color($s[1]);
665      print "[ $s[1] ]";
666      &$set_color('reset');
667      print $s[2];
668      titlebar_stat($s[1]) if $set_titlebar;
669    } else {
670      print $s[0];
671    }
672  }
673}
674
675
676# Print warning to screen
677sub mtr_warning (@) {
678  print STDERR _name(). _timestamp().
679    "mysql-test-run: WARNING: ". join(" ", @_). "\n";
680}
681
682
683# Print error to screen and then exit
684sub mtr_error (@) {
685  IO::Handle::flush(\*STDOUT) if IS_WINDOWS;
686  print STDERR _name(). _timestamp().
687    "mysql-test-run: *** ERROR: ". join(" ", @_). "\n";
688  if (IS_WINDOWS)
689  {
690    POSIX::_exit(1);
691  }
692  else
693  {
694    use Carp qw(cluck);
695    cluck "Error happened" if $verbose > 0;
696    exit(1);
697  }
698}
699
700
701sub mtr_debug (@) {
702  if ( $verbose > 2 )
703  {
704    print STDERR _name().
705      _timestamp(). "####: ". join(" ", @_). "\n";
706  }
707}
708
709
710sub mtr_verbose (@) {
711  if ( $verbose )
712  {
713    print STDERR _name(). _timestamp().
714      "> ".join(" ", @_)."\n";
715  }
716}
717
718
719sub mtr_verbose_restart (@) {
720  my ($server, @args)= @_;
721  my $proc= $server->{proc};
722  if ( $verbose_restart )
723  {
724    print STDERR _name()._timestamp().
725      "> Restart $proc - ".join(" ", @args)."\n";
726  }
727}
728
729
730# Used by --result-file for for formatting times
731
732sub isotime($) {
733  my ($sec,$min,$hr,$day,$mon,$yr)= gmtime($_[0]);
734  return sprintf "%d-%02d-%02dT%02d:%02d:%02dZ",
735    $yr+1900, $mon+1, $day, $hr, $min, $sec;
736}
737
7381;
739