5 # run the log profiler test suite
7 my $builddir = shift || die "Usage: ptestrunner.pl mono_build_dir\n";
12 my $profbuilddir = $builddir . "/mono/profiler";
13 my $minibuilddir = $builddir . "/mono/mini";
15 # Setup the execution environment
16 # for the profiler module
17 append_path ("LD_LIBRARY_PATH", $profbuilddir . "/.libs");
18 append_path ("DYLD_LIBRARY_PATH", $profbuilddir . "/.libs");
19 append_path ("DYLD_LIBRARY_PATH", $minibuilddir . "/.libs");
21 append_path ("PATH", $profbuilddir);
24 $report = run_test ("test-alloc.exe");
25 check_report_basics ($report);
26 check_report_calls ($report, "T:Main (string[])" => 1);
27 check_report_allocation ($report, "System.Object" => 1000000);
29 # test additional named threads and method calls
30 $report = run_test ("test-busy.exe");
31 check_report_basics ($report);
32 check_report_calls ($report, "T:Main (string[])" => 1);
33 check_report_threads ($report, "BusyHelper");
34 check_report_calls ($report, "T:test ()" => 10, "T:test3 ()" => 10, "T:test2 ()" => 1);
36 # test with the sampling profiler
37 $report = run_test ("test-busy.exe", "report,sample");
38 check_report_basics ($report);
39 check_report_threads ($report, "BusyHelper");
40 # at least 40% of the samples should hit each of the two busy methods
41 # This seems to fail on osx, where the main thread gets the majority of SIGPROF signals
42 #check_report_samples ($report, "T:test ()" => 40, "T:test3 ()" => 40);
45 $report = run_test ("test-monitor.exe");
46 check_report_basics ($report);
47 check_report_calls ($report, "T:Main (string[])" => 1);
48 # we hope for at least some contention, this is not entirely reliable
49 check_report_locks ($report, 1, 1);
52 $report = run_test ("test-excleave.exe");
53 check_report_basics ($report);
54 check_report_calls ($report, "T:Main (string[])" => 1, "T:throw_ex ()" => 1000);
55 check_report_exceptions ($report, 1000, 1000, 1000);
58 $report = run_test_sgen ("test-heapshot.exe", "report,heapshot");
59 if ($report ne "missing binary") {
60 check_report_basics ($report);
61 check_report_heapshot ($report, 0, {"T" => 5000});
62 check_report_heapshot ($report, 1, {"T" => 5023});
65 # test heapshot traces
66 $report = run_test_sgen ("test-heapshot.exe", "heapshot,output=-traces.mlpd", "--traces traces.mlpd");
67 if ($report ne "missing binary") {
68 check_report_basics ($report);
69 check_report_heapshot ($report, 0, {"T" => 5000});
70 check_report_heapshot ($report, 1, {"T" => 5023});
71 check_heapshot_traces ($report, 0,
74 check_heapshot_traces ($report, 1,
80 $report = run_test ("test-traces.exe", "output=-traces.mlpd", "--traces traces.mlpd");
81 check_report_basics ($report);
82 check_call_traces ($report,
83 "T:level3 (int)" => [2020, "T:Main (string[])"],
84 "T:level2 (int)" => [2020, "T:Main (string[])", "T:level3 (int)"],
85 "T:level1 (int)" => [2020, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)"],
86 "T:level0 (int)" => [2020, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)"]
88 check_exception_traces ($report,
89 [1010, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)", "T:level0 (int)"]
91 check_alloc_traces ($report,
92 T => [1010, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)", "T:level0 (int)"]
95 # test traces without enter/leave events
96 $report = run_test ("test-traces.exe", "nocalls,output=-traces.mlpd", "--traces traces.mlpd");
97 check_report_basics ($report);
98 # this has been broken recently
99 check_exception_traces ($report,
100 [1010, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)", "T:level0 (int)"]
102 check_alloc_traces ($report,
103 T => [1010, "T:Main (string[])", "T:level3 (int)", "T:level2 (int)", "T:level1 (int)", "T:level0 (int)"]
107 exit ($total_errors? 1: 0);
113 if (exists $ENV{$var}) {
114 $ENV{$var} = $value . ":" . $ENV{$var};
122 return run_test_bin ("$minibuilddir/mono", @_);
127 return run_test_bin ("$minibuilddir/mono-sgen", @_);
133 my $test_name = shift;
134 my $option = shift || "report";
135 my $roptions = shift;
139 print "Checking $test_name with $option ...";
141 print "missing $bin, skipped.\n";
142 return "missing binary";
144 my $report = `$bin --profile=log:$option $test_name`;
146 if (defined $roptions) {
147 return `$profbuilddir/mprof-report $roptions`;
154 foreach my $e (@errors) {
158 print "Total errors: $total_errors\n" if $total_errors;
169 foreach (split (/\n/, $report)) {
171 #print "matching end $end vs $_\n";
176 #print "matching $start vs $_\n";
177 $insection = 1 if (/$start/);
187 return get_delim_data ($report, "^\Q$name\E", "^\\w.*summary");
194 return get_delim_data ($report, "Heap shot $num at", "^\$");
197 sub check_report_basics
200 check_report_threads ($report, "Finalizer", "Main");
201 check_report_metadata ($report, 2);
202 check_report_jit ($report);
205 sub check_report_metadata
209 my $section = get_section ($report, "Metadata");
210 push @errors, "Wrong loaded images $num." unless $section =~ /Loaded images:\s$num/s;
213 sub check_report_calls
217 my $section = get_section ($report, "Method");
218 foreach my $method (keys %calls) {
219 push @errors, "Wrong calls to $method." unless $section =~ /\d+\s+\d+\s+($calls{$method})\s+\Q$method\E/s;
223 sub check_call_traces
227 my $section = get_section ($report, "Method");
228 foreach my $method (keys %calls) {
229 my @desc = @{$calls{$method}};
230 my $num = shift @desc;
231 my $trace = get_delim_data ($section, "\\s+\\d+\\s+\\d+\\s+\\d+\\s+\Q$method\E", "^(\\s*\\d+\\s+\\d)|(^Total calls)");
232 if ($trace =~ s/^\s+(\d+)\s+calls from:$//m) {
234 push @errors, "Wrong calls to $method." unless $num_calls == $num;
235 my @frames = map {s/^\s+(.*)\s*$/$1/; $_} split (/\n/, $trace);
238 my $fm = pop @frames;
239 push @errors, "Wrong frame $fm to $method." unless $dm eq $fm;
242 push @errors, "No num calls for $method.";
247 sub check_alloc_traces
251 my $section = get_section ($report, "Allocation");
252 foreach my $type (keys %types) {
253 my @desc = @{$types{$type}};
254 my $num = shift @desc;
255 my $trace = get_delim_data ($section, "\\s+\\d+\\s+\\d+\\s+\\d+\\s+\Q$type\E", "^(\\s*\\d+\\s+\\d)|(^Total)");
256 if ($trace =~ s/^\s+(\d+)\s+bytes from:$//m) {
258 #push @errors, "Wrong calls to $method." unless $num_calls == $num;
259 my @frames = map {s/^\s+(.*)\s*$/$1/; $_} split (/\n/, $trace);
262 my $fm = pop @frames;
263 $fm = pop @frames if $fm =~ /wrapper/;
264 push @errors, "Wrong frame $fm for alloc of $type." unless $dm eq $fm;
267 push @errors, "No alloc frames for $type.";
272 sub check_heapshot_traces
277 my $section = get_section ($report, "Heap");
278 $section = get_heap_shot ($section, $hshot);
279 foreach my $type (keys %types) {
280 my @desc = @{$types{$type}};
281 my $num = shift @desc;
282 my $rtype = shift @desc;
283 my $trace = get_delim_data ($section, "\\s+\\d+\\s+\\d+\\s+\\d+\\s+\Q$type\E", "^\\s*\\d+\\s+\\d");
284 if ($trace =~ s/^\s+(\d+)\s+references from:\s+\Q$rtype\E$//m) {
286 push @errors, "Wrong num refs to $type from $rtype." unless $num_refs == $num;
288 push @errors, "No refs to $type from $rtype.";
293 sub check_exception_traces
297 my $section = get_section ($report, "Exception");
298 foreach my $d (@etraces) {
300 my $num = shift @desc;
301 my $trace = get_delim_data ($section, "^\\s+$num\\s+throws from:\$", "^\\s+(\\d+|Executed)");
302 if (length ($trace)) {
303 my @frames = map {s/^\s+(.*)\s*$/$1/; $_} split (/\n/, $trace);
306 my $fm = pop @frames;
307 push @errors, "Wrong frame '$fm' in exceptions (should be '$dm')." unless $dm eq $fm;
310 push @errors, "No exceptions or incorrect number.";
315 sub check_report_samples
319 my $section = get_section ($report, "Statistical");
320 foreach my $method (keys %calls) {
321 push @errors, "Wrong samples for $method." unless ($section =~ /\d+\s+(\d+\.\d+)\s+\Q$method\E/s && $1 >= $calls{$method});
325 sub check_report_allocation
329 my $section = get_section ($report, "Allocation");
330 foreach my $type (keys %allocs) {
331 if ($section =~ /\d+\s+(\d+)\s+\d+\s+\Q$type\E$/m) {
332 push @errors, "Wrong allocs for type $type." unless $1 >= $allocs{$type};
334 push @errors, "No allocs for type $type.";
339 sub check_report_heapshot
344 my %allocs = %{$typemap};
345 my $section = get_section ($report, "Heap");
346 $section = get_heap_shot ($section, $hshot);
347 foreach my $type (keys %allocs) {
348 if ($section =~ /\d+\s+(\d+)\s+\d+\s+\Q$type\E(\s+\(bytes.*\))?$/m) {
349 push @errors, "Wrong heapshot for type $type at $hshot ($1, $allocs{$type})." unless $1 >= $allocs{$type};
351 push @errors, "No heapshot for type $type at heapshot $hshot.";
359 my $min_methods = shift || 1;
360 my $min_code = shift || 16;
361 my $section = get_section ($report, "JIT");
362 push @errors, "Not enough compiled method." unless (($section =~ /Compiled methods:\s(\d+)/s) && ($1 >= $min_methods));
363 push @errors, "Not enough compiled code." unless (($section =~ /Generated code size:\s(\d+)/s) && ($1 >= $min_code));
366 sub check_report_locks
369 my $contentions = shift;
370 my $acquired = shift;
371 my $section = get_section ($report, "Monitor");
372 push @errors, "Not enough contentions." unless (($section =~ /Lock contentions:\s(\d+)/s) && ($1 >= $contentions));
373 push @errors, "Not enough acquired locks." unless (($section =~ /Lock acquired:\s(\d+)/s) && ($1 >= $acquired));
376 sub check_report_exceptions
381 my $finallies = shift;
382 my $section = get_section ($report, "Exception");
383 push @errors, "Not enough throws." unless (($section =~ /Throws:\s(\d+)/s) && ($1 >= $throws));
384 push @errors, "Not enough catches." unless (($section =~ /Executed catch clauses:\s(\d+)/s) && ($1 >= $catches));
385 push @errors, "Not enough finallies." unless (($section =~ /Executed finally clauses:\s(\d+)/s) && ($1 >= $finallies));
388 sub check_report_threads
392 my $section = get_section ($report, "Thread");
393 foreach my $tname (@threads) {
394 push @errors, "Missing thread $tname." unless $section =~ /Thread:.*name:\s"\Q$tname\E"/s;