mono/tests/stress-runner.pl

   1 #!/usr/bin/perl -w
   2
   3 # mono stress test tool
   4 # This stress test runner is designed to detect possible
   5 # leaks, runtime slowdowns and crashes when a task is performed
   6 # repeatedly.
   7 # A stress program should be written to repeat for a number of times
   8 # a specific task: it is run a first time to collect info about memory
   9 # and cpu usage: this run should last a couple of seconds or so.
  10 # Then, the same program is run with a number of iterations that is at least
  11 # 2 orders of magnitude bigger than the first run (3 orders should be used,
  12 # eventually, to detect smaller leaks).
  13 # Of course the right time for the test and the ratio depends on the test
  14 # itself, so it's configurable per-test.
  15 # The test driver will then check that the second run has used roughly the
  16 # same amount of memory as the first and a proportionally bigger cpu time.
  17 # Note: with a conservative GC there may be more false positives than
  18 # with a precise one, because heap size may grow depending on timing etc.
  19 # so failing results need to be checked carefully. In some cases a solution
  20 # is to increase the number of runs in the dry run.
  21
  22 use POSIX ":sys_wait_h";
  23 use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
  24
  25 # in milliseconds between checks of resource usage
  26 my $interval = 50;
  27 # multiplier to allow some wiggle room
  28 my $wiggle_ratio = 1.05;
  29 # if the test computer is too fast or if we want to stress test more,
  30 # we multiply the test ratio by this number. Use the --times=x option.
  31 my $extra_strong = 1;
  32
  33 # descriptions of the tests to run
  34 # for each test:
  35 #       program is the program to run
  36 #       args an array ref of argumenst to pass to program
  37 #       arg-knob is the index of the argument in args that changes the number of iterations
  38 #       ratio is the multiplier applied to the arg-knob argument
  39 my %tests = (
  40         'domain-stress' => {
  41                 'program' => 'domain-stress.exe',
  42                 # threads, domains, allocs, loops
  43                 'args' => [2, 10, 1000, 1],
  44                 'arg-knob' => 3, # loops
  45                 'ratio' => 30,
  46         },
  47         'gchandle-stress' => {
  48                 'program' => 'gchandle-stress.exe',
  49                 # allocs, loops
  50                 'args' => [80000, 2],
  51                 'arg-knob' => 1, # loops
  52                 'ratio' => 20,
  53         },
  54         'monitor-stress' => {
  55                 'program' => 'monitor-stress.exe',
  56                 # loops
  57                 'args' => [10],
  58                 'arg-knob' => 0, # loops
  59                 'ratio' => 20,
  60         },
  61         'gc-stress' => {
  62                 'program' => 'gc-stress.exe',
  63                 # loops
  64                 'args' => [25],
  65                 'arg-knob' => 0, # loops
  66                 'ratio' => 20,
  67         },
  68         'gc-graystack-stress' => {
  69                 'program' => 'gc-graystack-stress.exe',
  70                 # width, depth, collections
  71                 'args' => [125, 10000, 100],
  72                 'arg-knob' => 2, # loops
  73                 'ratio' => 10,
  74         },
  75         'gc-copy-stress' => {
  76                 'program' => 'gc-copy-stress.exe',
  77                 # loops, count, persist_factor
  78                 'args' => [250, 500000, 10],
  79                 'arg-knob' => 1, # count
  80                 'ratio' => 4,
  81         },
  82         'thread-stress' => {
  83                 'program' => 'thread-stress.exe',
  84                 # loops
  85                 'args' => [20],
  86                 'arg-knob' => 0, # loops
  87                 'ratio' => 20,
  88         },
  89         'abort-stress-1' => {
  90                 'program' => 'abort-stress-1.exe',
  91                 # loops,
  92                 'args' => [20],
  93                 'arg-knob' => 0, # loops
  94                 'ratio' => 20,
  95         },
  96         # FIXME: This tests exits, so it has no loops, instead it should be run more times
  97         'exit-stress' => {
  98                 'program' => 'exit-stress.exe',
  99                 # loops,
 100                 'args' => [10],
 101                 'arg-knob' => 0, # loops
 102                 'ratio' => 20,
 103         }
 104         # FIXME: This test deadlocks, bug 72740.
 105         # We need hang detection
 106         #'abort-stress-2' => {
 107         #       'program' => 'abort-stress-2.exe',
 108         #       # loops,
 109         #       'args' => [20],
 110         #       'arg-knob' => 0, # loops
 111         #       'ratio' => 20,
 112         #}
 113 );
 114
 115 # poor man option handling
 116 while (@ARGV) {
 117         my $arg = shift @ARGV;
 118         if ($arg =~ /^--times=(\d+)$/) {
 119                 $extra_strong = $1;
 120                 next;
 121         }
 122         if ($arg =~ /^--interval=(\d+)$/) {
 123                 $interval = $1;
 124                 next;
 125         }
 126         unshift @ARGV, $arg;
 127         last;
 128 }
 129 my $test_rx = shift (@ARGV) || '.';
 130 # the mono runtime to use and the arguments to pass to it
 131 my @mono_args = @ARGV;
 132 my @results = ();
 133 my %vmmap = qw(VmSize 0 VmLck 1 VmRSS 2 VmData 3 VmStk 4 VmExe 5 VmLib 6 VmHWM 7 VmPTE 8 VmPeak 9);
 134 my @vmnames = sort {$vmmap{$a} <=> $vmmap{$b}} keys %vmmap;
 135 # VmRSS depends on the operating system's decisions
 136 my %vmignore = qw(VmRSS 1);
 137 my $errorcount = 0;
 138 my $numtests = 0;
 139
 140 @mono_args = 'mono' unless @mono_args;
 141
 142 apply_options ();
 143
 144 foreach my $test (sort keys %tests) {
 145         next unless ($tests{$test}->{'program'} =~ /$test_rx/);
 146         $numtests++;
 147         run_test ($test, 'dry');
 148         run_test ($test, 'stress');
 149 }
 150
 151 # print all the reports at the end
 152 foreach my $test (sort keys %tests) {
 153         next unless ($tests{$test}->{'program'} =~ /$test_rx/);
 154         print_test_report ($test);
 155 }
 156
 157 print "No tests matched '$test_rx'.\n" unless $numtests;
 158
 159 if ($errorcount) {
 160         print "Total issues: $errorcount\n";
 161         exit (1);
 162 } else {
 163         exit (0);
 164 }
 165
 166 sub run_test {
 167         my ($name, $mode) = @_;
 168         my $test = $tests {$name};
 169         my @targs = (@mono_args, $test->{program});
 170         my @results = ();
 171         my @rargs = @{$test->{"args"}};
 172
 173         if ($mode ne "dry") {
 174                 # FIXME: set also a timeout
 175                 $rargs [$test->{"arg-knob"}] *= $test->{"ratio"};
 176         }
 177         push @targs, @rargs;
 178         print "Running test '$name' in $mode mode\n";
 179         my $start_time = [gettimeofday];
 180         my $pid = fork ();
 181         if ($pid == 0) {
 182                 exec @targs;
 183                 die "Cannot exec: $! (@targs)\n";
 184         } else {
 185                 my $kid;
 186                 do {
 187                         $kid = waitpid (-1, WNOHANG);
 188                         my $sample = collect_memusage ($pid);
 189                         push @results, $sample if (defined ($sample) && @{$sample});
 190                         # sleep for a few ms
 191                         usleep ($interval * 1000) unless $kid > 0;
 192                 } until $kid > 0;
 193         }
 194         my $end_time = [gettimeofday];
 195         $test->{"$mode-cputime"} = tv_interval ($start_time, $end_time);
 196         $test->{"$mode-memusage"} = [summarize_result (@results)];
 197 }
 198
 199 sub print_test_report {
 200         my ($name) = shift;
 201         my $test = $tests {$name};
 202         my ($cpu_dry, $cpu_test) = ($test->{'dry-cputime'}, $test->{'stress-cputime'});
 203         my @dry_mem = @{$test->{'dry-memusage'}};
 204         my @test_mem = @{$test->{'stress-memusage'}};
 205         my $ratio = $test->{'ratio'};
 206         print "Report for test: $name\n";
 207         print "Cpu usage: dry: $cpu_dry, stress: $cpu_test\n";
 208         print "Memory usage (KB):\n";
 209         print "\t       ",join ("\t", @vmnames), "\n";
 210         print "\t   dry: ", join ("\t", @dry_mem), "\n";
 211         print "\tstress: ", join ("\t", @test_mem), "\n";
 212         if ($cpu_test > ($cpu_dry * $ratio) * $wiggle_ratio) {
 213                 print "Cpu usage not proportional to ratio $ratio.\n";
 214                 $errorcount++;
 215         }
 216         my $i;
 217         for ($i = 0; $i < @dry_mem; ++$i) {
 218                 next if exists $vmignore {$vmnames [$i]};
 219                 if ($test_mem [$i] > $dry_mem [$i] * $wiggle_ratio) {
 220                         print "Memory usage $vmnames[$i] not constant.\n";
 221                         $errorcount++;
 222                 }
 223         }
 224 }
 225
 226 sub collect_memusage {
 227         my ($pid) = @_;
 228         open (PROC, "</proc/$pid/status") || return undef; # might be dead already
 229         my @sample = ();
 230         while (<PROC>) {
 231                 next unless /^(Vm.*?):\s+(\d+)\s+kB/;
 232                 $sample [$vmmap {$1}] = $2;
 233         }
 234         close (PROC);
 235         return \@sample;
 236 }
 237
 238 sub summarize_result {
 239         my (@data) = @_;
 240         my (@result) = (0) x 7;
 241         my $i;
 242         foreach my $sample (@data) {
 243                 for ($i = 0; $i < 7; ++$i) {
 244                         if ($sample->[$i] > $result [$i]) {
 245                                 $result [$i] = $sample->[$i];
 246                         }
 247                 }
 248         }
 249         return @result;
 250 }
 251
 252 sub apply_options {
 253         foreach my $test (values %tests) {
 254                 $test->{args}->[$test->{'arg-knob'}] *= $extra_strong;
 255         }
 256 }
 257