mono/profiler/ptestrunner.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use File::Basename;
   5
   6 sub print_usage
   7 {
   8         die "Usage: ptestrunner.pl mono_build_dir <nunit|xunit> xml_report_filename\n";
   9 }
  10
  11 # run the log profiler test suite
  12
  13 my $builddir = shift || print_usage ();
  14 my $xml_report_type = shift || print_usage ();
  15 my $xml_report_filename = shift || print_usage ();
  16 my @errors = ();
  17 my $total_errors = 0; # this is reset before each test
  18 my $global_errors = 0;
  19 my $testcases_succeeded = 0;
  20 my $testcases_failed = 0;
  21 my $report;
  22 my $testcase_name;
  23 my $testcase_xml;
  24 my $monosgen;
  25 my $profmoduledir;
  26 my $mprofreportdir;
  27
  28 if ($builddir eq "out-of-tree") {
  29         $monosgen = $ENV{'MONO_EXECUTABLE'};
  30         $profmoduledir = dirname ($monosgen);
  31         $mprofreportdir = dirname ($monosgen);
  32 } else {
  33         $monosgen = "$builddir/mono/mini/mono-sgen";
  34         $profmoduledir = "$builddir/mono/profiler/.libs";
  35         $mprofreportdir = "$builddir/mono/profiler";
  36 }
  37
  38 # Setup the execution environment
  39 # for the profiler module
  40 append_path ("LD_LIBRARY_PATH", $profmoduledir);
  41 append_path ("DYLD_LIBRARY_PATH", $profmoduledir);
  42 append_path ("PATH", $mprofreportdir);
  43
  44 # first a basic test
  45 $report = run_test ("test-alloc.exe", "report,legacy,calls,alloc");
  46 check_report_basics ($report);
  47 check_report_calls ($report, "T:Main (string[])" => 1);
  48 check_report_allocation ($report, "System.Object" => 1000000);
  49 report_errors ();
  50 add_xml_testcase_result ();
  51 # test additional named threads and method calls
  52 $report = run_test ("test-busy.exe", "report,legacy,calls,alloc");
  53 check_report_basics ($report);
  54 check_report_calls ($report, "T:Main (string[])" => 1);
  55 check_report_threads ($report, "BusyHelper");
  56 check_report_calls ($report, "T:test ()" => 10, "T:test3 ()" => 10, "T:test2 ()" => 1);
  57 report_errors ();
  58 add_xml_testcase_result ();
  59 # test with the sampling profiler
  60 $report = run_test ("test-busy.exe", "report,legacy,sample");
  61 check_report_basics ($report);
  62 check_report_threads ($report, "BusyHelper");
  63 # at least 40% of the samples should hit each of the two busy methods
  64 # This seems to fail on osx, where the main thread gets the majority of SIGPROF signals
  65 #check_report_samples ($report, "T:test ()" => 40, "T:test3 ()" => 40);
  66 report_errors ();
  67 add_xml_testcase_result ();
  68 # test lock events
  69 $report = run_test ("test-monitor.exe", "report,legacy,calls,alloc");
  70 check_report_basics ($report);
  71 check_report_calls ($report, "T:Main (string[])" => 1);
  72 # we hope for at least some contention, this is not entirely reliable
  73 check_report_locks ($report, 1, 1);
  74 report_errors ();
  75 add_xml_testcase_result ();
  76 # test exceptions
  77 $report = run_test ("test-excleave.exe", "report,legacy,calls");
  78 check_report_basics ($report);
  79 check_report_calls ($report, "T:Main (string[])" => 1, "T:throw_ex ()" => 1000);
  80 check_report_exceptions ($report, 1000, 1000, 1000);
  81 report_errors ();
  82 add_xml_testcase_result ();
  83 # test native-to-managed and managed-to-native wrappers
  84 $report = run_test ("test-pinvokes.exe", "report,calls");
  85 check_report_basics ($report);
  86 check_report_calls ($report, "(wrapper managed-to-native) T:test_reverse_pinvoke (System.Action)" => 1, "(wrapper native-to-managed) T:CallBack ()" => 1, "T:CallBack ()" => 1);
  87 report_errors ();
  88 add_xml_testcase_result ();
  89 # test heapshot
  90 $report = run_test ("test-heapshot.exe", "report,heapshot,legacy");
  91 if ($report ne "missing binary") {
  92         check_report_basics ($report);
  93         check_report_heapshot ($report, 0, {"T" => 5000});
  94         check_report_heapshot ($report, 1, {"T" => 5023});
  95         report_errors ();
  96         add_xml_testcase_result ();
  97 }
  98 # test heapshot traces
  99 $report = run_test ("test-heapshot.exe", "heapshot,output=traces.mlpd,legacy", "--traces traces.mlpd");
 100 if ($report ne "missing binary") {
 101         check_report_basics ($report);
 102         check_report_heapshot ($report, 0, {"T" => 5000});
 103         check_report_heapshot ($report, 1, {"T" => 5023});
 104         check_heapshot_traces ($report, 0,
 105                 T => [4999, "T"]
 106         );
 107         check_heapshot_traces ($report, 1,
 108                 T => [5022, "T"]
 109         );
 110         report_errors ();
 111         add_xml_testcase_result ();
 112 }
 113 # test traces
 114 $report = run_test ("test-traces.exe", "legacy,calls,alloc,output=traces.mlpd", "--maxframes=7 --traces traces.mlpd");
 115 check_report_basics ($report);
 116 check_call_traces ($report,
 117         "T:level3 (int)" => [2020, "T:Main (string[])"],
 118         "T:level2 (int)" => [2020, "T:Main (string[])", "T:level3 (int)"],
 119         "T:level1 (int)" => [2020, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)"],
 120         "T:level0 (int)" => [2020, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)"]
 121 );
 122 check_exception_traces ($report,
 123         [1010, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)", "T:level0 (int)"]
 124 );
 125 check_alloc_traces ($report,
 126         T => [1010, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)", "T:level0 (int)"]
 127 );
 128 report_errors ();
 129 add_xml_testcase_result ();
 130 # test traces without enter/leave events
 131 $report = run_test ("test-traces.exe", "legacy,alloc,output=traces.mlpd", "--traces traces.mlpd");
 132 check_report_basics ($report);
 133 # this has been broken recently
 134 check_exception_traces ($report,
 135         [1010, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)", "T:level0 (int)"]
 136 );
 137 check_alloc_traces ($report,
 138         T => [1010, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)", "T:level0 (int)"]
 139 );
 140 report_errors ();
 141 add_xml_testcase_result ();
 142
 143 emit_xml_report();
 144
 145 exit ($global_errors ? 1 : 0);
 146
 147 # utility functions
 148 sub append_path {
 149         my $var = shift;
 150         my $value = shift;
 151         if (exists $ENV{$var}) {
 152                 $ENV{$var} = $value . ":" . $ENV{$var};
 153         } else {
 154                 $ENV{$var} = $value;
 155         }
 156 }
 157
 158 sub run_test
 159 {
 160         my $bin = $monosgen;
 161         my $test_name = shift;
 162         my $option = shift || "report";
 163         my $roptions = shift;
 164         #clear the errors
 165         @errors = ();
 166         $total_errors = 0;
 167         print "Checking $test_name with $option ...";
 168         $testcase_name = "$test_name($option)";
 169         unless (-x $bin) {
 170                 print "missing $bin, skipped.\n";
 171                 return "missing binary";
 172         }
 173         my $report = `$bin --profile=log:$option $test_name`;
 174         print "\n";
 175         if (defined $roptions) {
 176                 return `$mprofreportdir/mprof-report $roptions`;
 177         }
 178         return $report;
 179 }
 180
 181 sub report_errors
 182 {
 183         foreach my $e (@errors) {
 184                 print "Error: $e\n";
 185                 $total_errors++;
 186                 $global_errors++;
 187         }
 188         print "Total errors: $total_errors\n" if $total_errors;
 189         #print $report;
 190 }
 191
 192 sub add_xml_testcase_result
 193 {
 194         if ($xml_report_type eq "nunit") {
 195                 add_nunit_testcase_result (@_);
 196         } elsif ($xml_report_type eq "xunit") {
 197                 add_xunit_testcase_result (@_);
 198         } else {
 199                 die "Unknown XML report type '$xml_report_type'.";
 200         }
 201 }
 202
 203 sub emit_xml_report
 204 {
 205         if ($xml_report_type eq "nunit") {
 206                 emit_nunit_report (@_);
 207         } elsif ($xml_report_type eq "xunit") {
 208                 emit_xunit_report (@_);
 209         } else {
 210                 die "Unknown XML report type '$xml_report_type'.";
 211         }
 212 }
 213
 214 sub add_nunit_testcase_result
 215 {
 216         my $successbool;
 217         if ($total_errors > 0) {
 218                 $successbool = "False";
 219                 $testcases_failed++;
 220         } else {
 221                 $successbool = "True";
 222                 $testcases_succeeded++;
 223         }
 224
 225         $testcase_xml .= "              <test-case name=\"MonoTests.profiler.$testcase_name\" executed=\"True\" success=\"$successbool\" time=\"0\" asserts=\"0\"";
 226         if ($total_errors > 0) {
 227                 $testcase_xml .=  ">\n";
 228                 $testcase_xml .=  "                <failure>\n";
 229                 $testcase_xml .=  "                  <message><![CDATA[";
 230                 foreach my $e (@errors) {
 231                         $testcase_xml .= "Error: $e\n";
 232                 }
 233                 $testcase_xml .= "]]></message>\n";
 234                 $testcase_xml .=  "                  <stack-trace><![CDATA[";
 235                 $testcase_xml .=  $report;
 236                 $testcase_xml .=  "]]></stack-trace>\n";
 237                 $testcase_xml .=  "                </failure>\n";
 238                 $testcase_xml .=  "              </test-case>\n";
 239         } else {
 240                 $testcase_xml .= " />\n";
 241         }
 242 }
 243
 244 sub emit_nunit_report
 245 {
 246         use Cwd;
 247         use POSIX qw(strftime uname locale_h);
 248         use Net::Domain qw(hostname hostfqdn);
 249         use locale;
 250
 251         my $failed = $global_errors ? 1 : 0;
 252         my $successbool;
 253         my $total = 1;
 254         my $mylocale = setlocale (LC_CTYPE);
 255         $mylocale = substr($mylocale, 0, index($mylocale, '.'));
 256         $mylocale =~ s/_/-/;
 257
 258         if ($failed > 0) {
 259                 $successbool = "False";
 260         } else {
 261                 $successbool = "True";
 262         }
 263         open (my $nunitxml, '>', $xml_report_filename) or die "Could not write to '$xml_report_filename' $!";
 264         print $nunitxml "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>\n";
 265         print $nunitxml "<!--This file represents the results of running a test suite-->\n";
 266         print $nunitxml "<test-results name=\"profiler-tests.dummy\" total=\"$total\" failures=\"$failed\" not-run=\"0\" date=\"" . strftime ("%F", localtime) . "\" time=\"" . strftime ("%T", localtime) . "\">\n";
 267         print $nunitxml "  <environment nunit-version=\"2.4.8.0\" clr-version=\"4.0.30319.17020\" os-version=\"Unix " . (uname ())[2]  . "\" platform=\"Unix\" cwd=\"" . getcwd . "\" machine-name=\"" . hostname . "\" user=\"" . getpwuid ($<) . "\" user-domain=\"" . hostfqdn  . "\" />\n";
 268         print $nunitxml "  <culture-info current-culture=\"$mylocale\" current-uiculture=\"$mylocale\" />\n";
 269         print $nunitxml "  <test-suite name=\"profiler-tests.dummy\" success=\"$successbool\" time=\"0\" asserts=\"0\">\n";
 270         print $nunitxml "    <results>\n";
 271         print $nunitxml "      <test-suite name=\"MonoTests\" success=\"$successbool\" time=\"0\" asserts=\"0\">\n";
 272         print $nunitxml "        <results>\n";
 273         print $nunitxml "          <test-suite name=\"profiler\" success=\"$successbool\" time=\"0\" asserts=\"0\">\n";
 274         print $nunitxml "            <results>\n";
 275         print $nunitxml $testcase_xml;
 276         print $nunitxml "            </results>\n";
 277         print $nunitxml "          </test-suite>\n";
 278         print $nunitxml "        </results>\n";
 279         print $nunitxml "      </test-suite>\n";
 280         print $nunitxml "    </results>\n";
 281         print $nunitxml "  </test-suite>\n";
 282         print $nunitxml "</test-results>\n";
 283         close $nunitxml;
 284 }
 285
 286 sub add_xunit_testcase_result
 287 {
 288         my $testcase_simple_name = substr ($testcase_name, 0, index ($testcase_name, "("));
 289         my $resultstring;
 290         if ($total_errors > 0) {
 291                 $resultstring = "Fail";
 292                 $testcases_failed++;
 293         } else {
 294                 $resultstring = "Pass";
 295                 $testcases_succeeded++;
 296         }
 297
 298         $testcase_xml .= "        <test name=\"profiler.tests.$testcase_name\" type=\"profiler.tests\" method=\"$testcase_simple_name\" time=\"0\" result=\"$resultstring\"";
 299         if ($total_errors > 0) {
 300                 $testcase_xml .=  ">\n";
 301                 $testcase_xml .=  "          <failure exception-type=\"ProfilerTestsException\">\n";
 302                 $testcase_xml .=  "            <message><![CDATA[";
 303                 foreach my $e (@errors) {
 304                         $testcase_xml .= "Error: $e\n";
 305                 }
 306                 $testcase_xml .= "\nSTDOUT/STDERR:\n";
 307                 $testcase_xml .=  $report;
 308                 $testcase_xml .= "]]></message>\n";
 309                 $testcase_xml .=  "          </failure>\n";
 310                 $testcase_xml .=  "        </test>\n";
 311         } else {
 312                 $testcase_xml .= " />\n";
 313         }
 314 }
 315
 316 sub emit_xunit_report
 317 {
 318         my $total = $testcases_succeeded + $testcases_failed;
 319         open (my $xunitxml, '>', $xml_report_filename) or die "Could not write to '$xml_report_filename' $!";
 320         print $xunitxml "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
 321         print $xunitxml "<assemblies>\n";
 322         print $xunitxml "  <assembly name=\"profiler\" environment=\"Mono\" test-framework=\"custom\" run-date=\"". strftime ("%F", localtime) . "\" run-time=\"" . strftime ("%T", localtime) . "\" total=\"$total\" passed=\"$testcases_succeeded\" failed=\"$testcases_failed\" skipped=\"0\" errors=\"0\" time=\"0\">\n";
 323         print $xunitxml "    <collection total=\"$total\" passed=\"$testcases_succeeded\" failed=\"$testcases_failed\" skipped=\"0\" name=\"Test collection for profiler\" time=\"0\">\n";
 324         print $xunitxml $testcase_xml;
 325         print $xunitxml "    </collection>\n";
 326         print $xunitxml "  </assembly>\n";
 327         print $xunitxml "</assemblies>\n";
 328         close $xunitxml;
 329 }
 330
 331 sub get_delim_data
 332 {
 333         my $report = shift;
 334         my $start = shift;
 335         my $end = shift;
 336         my $section = "";
 337         my $insection = 0;
 338         foreach (split (/\n/, $report)) {
 339                 if ($insection) {
 340                         #print "matching end $end vs $_\n";
 341                         last if /$end/;
 342                         $section .= $_;
 343                         $section .= "\n";
 344                 } else {
 345                         #print "matching $start vs $_\n";
 346                         $insection = 1 if (/$start/);
 347                 }
 348         }
 349         return $section;
 350 }
 351
 352 sub get_section
 353 {
 354         my $report = shift;
 355         my $name = shift;
 356         return get_delim_data ($report, "^\Q$name\E", "^\\w.*summary");
 357 }
 358
 359 sub get_heap_shot
 360 {
 361         my $section = shift;
 362         my $num = shift;
 363         return get_delim_data ($report, "Heap shot $num at", "^\$");
 364 }
 365
 366 sub check_report_basics
 367 {
 368         my $report = shift;
 369         check_report_threads ($report, "Finalizer", "Main");
 370         check_report_metadata ($report, 2);
 371         check_report_jit ($report);
 372 }
 373
 374 sub check_report_metadata
 375 {
 376         my $report = shift;
 377         my $num = shift;
 378         my $section = get_section ($report, "Metadata");
 379         push @errors, "Wrong loaded images $num." unless $section =~ /Loaded images:\s$num/s;
 380 }
 381
 382 sub check_report_calls
 383 {
 384         my $report = shift;
 385         my %calls = @_;
 386         my $section = get_section ($report, "Method");
 387         foreach my $method (keys %calls) {
 388                 push @errors, "Wrong calls to $method." unless $section =~ /\d+\s+\d+\s+($calls{$method})\s+\Q$method\E/s;
 389         }
 390 }
 391
 392 sub check_call_traces
 393 {
 394         my $report = shift;
 395         my %calls = @_;
 396         my $section = get_section ($report, "Method");
 397         foreach my $method (keys %calls) {
 398                 my @desc = @{$calls{$method}};
 399                 my $num = shift @desc;
 400                 my $trace = get_delim_data ($section, "\\s+\\d+\\s+\\d+\\s+\\d+\\s+\Q$method\E", "^(\\s*\\d+\\s+\\d)|(^Total calls)");
 401                 if ($trace =~ s/^\s+(\d+)\s+calls from:$//m) {
 402                         my $num_calls = $1;
 403                         push @errors, "Wrong calls to $method." unless $num_calls == $num;
 404                         my @frames = map {s/^\s+(.*)\s*$/$1/; $_} split (/\n/, $trace);
 405                         while (@desc) {
 406                                 my $dm = pop @desc;
 407                                 my $fm = pop @frames;
 408                                 push @errors, "Wrong frame $fm to $method." unless $dm eq $fm;
 409                         }
 410                 } else {
 411                         push @errors, "No num calls for $method.";
 412                 }
 413         }
 414 }
 415
 416 sub check_alloc_traces
 417 {
 418         my $report = shift;
 419         my %types = @_;
 420         my $section = get_section ($report, "Allocation");
 421         foreach my $type (keys %types) {
 422                 my @desc = @{$types{$type}};
 423                 my $num = shift @desc;
 424                 my $trace = get_delim_data ($section, "\\s+\\d+\\s+\\d+\\s+\\d+\\s+\Q$type\E", "^(\\s*\\d+\\s+\\d)|(^Total)");
 425                 if ($trace =~ s/^\s+(\d+)\s+bytes from:$//m) {
 426                         #my $num_calls = $1;
 427                         #push @errors, "Wrong calls to $method." unless $num_calls == $num;
 428                         my @frames = map {s/^\s+(.*)\s*$/$1/; $_} split (/\n/, $trace);
 429                         while (@desc) {
 430                                 my $dm = pop @desc;
 431                                 my $fm = pop @frames;
 432                                 while ($fm =~ /wrapper/) {
 433                                         $fm = pop @frames;
 434                                 }
 435                                 push @errors, "Wrong frame $fm for alloc of $type (expected $dm)." unless $dm eq $fm;
 436                         }
 437                 } else {
 438                         push @errors, "No alloc frames for $type.";
 439                 }
 440         }
 441 }
 442
 443 sub check_heapshot_traces
 444 {
 445         my $report = shift;
 446         my $hshot = shift;
 447         my %types = @_;
 448         my $section = get_section ($report, "Heap");
 449         $section = get_heap_shot ($section, $hshot);
 450         foreach my $type (keys %types) {
 451                 my @desc = @{$types{$type}};
 452                 my $num = shift @desc;
 453                 my $rtype = shift @desc;
 454                 my $trace = get_delim_data ($section, "\\s+\\d+\\s+\\d+\\s+\\d+\\s+\Q$type\E", "^\\s*\\d+\\s+\\d");
 455                 if ($trace =~ s/^\s+(\d+)\s+references from:\s+\Q$rtype\E$//m) {
 456                         my $num_refs = $1;
 457                         push @errors, "Wrong num refs to $type from $rtype." unless $num_refs == $num;
 458                 } else {
 459                         push @errors, "No refs to $type from $rtype.";
 460                 }
 461         }
 462 }
 463
 464 sub check_exception_traces
 465 {
 466         my $report = shift;
 467         my @etraces = @_;
 468         my $section = get_section ($report, "Exception");
 469         foreach my $d (@etraces) {
 470                 my @desc = @{$d};
 471                 my $num = shift @desc;
 472                 my $trace = get_delim_data ($section, "^\\s+$num\\s+throws from:\$", "^\\s+(\\d+|Executed)");
 473                 if (length ($trace)) {
 474                         my @frames = map {s/^\s+(.*)\s*$/$1/; $_} split (/\n/, $trace);
 475                         while (@desc) {
 476                                 my $dm = pop @desc;
 477                                 my $fm = pop @frames;
 478                                 push @errors, "Wrong frame '$fm' in exceptions (should be '$dm')." unless $dm eq $fm;
 479                         }
 480                 } else {
 481                         push @errors, "No exceptions or incorrect number.";
 482                 }
 483         }
 484 }
 485
 486 sub check_report_samples
 487 {
 488         my $report = shift;
 489         my %calls = @_;
 490         my $section = get_section ($report, "Statistical");
 491         foreach my $method (keys %calls) {
 492                 push @errors, "Wrong samples for $method." unless ($section =~ /\d+\s+(\d+\.\d+)\s+\Q$method\E/s && $1 >= $calls{$method});
 493         }
 494 }
 495
 496 sub check_report_allocation
 497 {
 498         my $report = shift;
 499         my %allocs = @_;
 500         my $section = get_section ($report, "Allocation");
 501         foreach my $type (keys %allocs) {
 502                 if ($section =~ /\d+\s+(\d+)\s+\d+\s+\Q$type\E$/m) {
 503                         push @errors, "Wrong allocs for type $type." unless $1 >= $allocs{$type};
 504                 } else {
 505                         push @errors, "No allocs for type $type.";
 506                 }
 507         }
 508 }
 509
 510 sub check_report_heapshot
 511 {
 512         my $report = shift;
 513         my $hshot = shift;
 514         my $typemap = shift;
 515         my %allocs = %{$typemap};
 516         my $section = get_section ($report, "Heap");
 517         $section = get_heap_shot ($section, $hshot);
 518         foreach my $type (keys %allocs) {
 519                 if ($section =~ /\d+\s+(\d+)\s+\d+\s+\Q$type\E(\s+\(bytes.*\))?$/m) {
 520                         push @errors, "Wrong heapshot for type $type at $hshot ($1, $allocs{$type})." unless $1 >= $allocs{$type};
 521                 } else {
 522                         push @errors, "No heapshot for type $type at heapshot $hshot.";
 523                 }
 524         }
 525 }
 526
 527 sub check_report_jit
 528 {
 529         my $report = shift;
 530         my $min_methods = shift || 1;
 531         my $min_code = shift || 16;
 532         my $section = get_section ($report, "JIT");
 533         push @errors, "Not enough compiled method." unless (($section =~ /Compiled methods:\s(\d+)/s) && ($1 >= $min_methods));
 534         push @errors, "Not enough compiled code." unless (($section =~ /Generated code size:\s(\d+)/s) && ($1 >= $min_code));
 535 }
 536
 537 sub check_report_locks
 538 {
 539         my $report = shift;
 540         my $contentions = shift;
 541         my $acquired = shift;
 542         my $section = get_section ($report, "Monitor");
 543         push @errors, "Not enough contentions." unless (($section =~ /Lock contentions:\s(\d+)/s) && ($1 >= $contentions));
 544         push @errors, "Not enough acquired locks." unless (($section =~ /Lock acquired:\s(\d+)/s) && ($1 >= $acquired));
 545 }
 546
 547 sub check_report_exceptions
 548 {
 549         my $report = shift;
 550         my $throws = shift;
 551         my $catches = shift;
 552         my $finallies = shift;
 553         my $section = get_section ($report, "Exception");
 554         push @errors, "Not enough throws." unless (($section =~ /Throws:\s(\d+)/s) && ($1 >= $throws));
 555         push @errors, "Not enough catches." unless (($section =~ /Executed catch clauses:\s(\d+)/s) && ($1 >= $catches));
 556         push @errors, "Not enough finallies." unless (($section =~ /Executed finally clauses:\s(\d+)/s) && ($1 >= $finallies));
 557 }
 558
 559 sub check_report_threads
 560 {
 561         my $report = shift;
 562         my @threads = @_;
 563         my $section = get_section ($report, "Thread");
 564         foreach my $tname (@threads) {
 565                 push @errors, "Missing thread $tname." unless $section =~ /Thread:.*name:\s"\Q$tname\E"/s;
 566         }
 567 }
 568