← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/randgen/combinations.pl

  • Committer: Mark Atwood
  • Date: 2011-10-08 04:50:51 UTC
  • mfrom: (2430.1.1 rf)
  • Revision ID: me@mark.atwood.name-20111008045051-6ha1qiy7k2a9c3jv
Tags: 2011.10.27
merge lp:~olafvdspek/drizzle/refactor2

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/randgen/combinations.pl
1
 
# Copyright (c) 2008, 2011 Oracle and/or its affiliates. All rights reserved.
2
 
# Use is subject to license terms.
3
 
#
4
 
# This program is free software; you can redistribute it and/or modify
5
 
# it under the terms of the GNU General Public License as published by
6
 
# the Free Software Foundation; version 2 of the License.
7
 
#
8
 
# This program is distributed in the hope that it will be useful, but
9
 
# WITHOUT ANY WARRANTY; without even the implied warranty of
10
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11
 
# General Public License for more details.
12
 
#
13
 
# You should have received a copy of the GNU General Public License
14
 
# along with this program; if not, write to the Free Software
15
 
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
16
 
# USA
17
 
 
18
 
use strict;
19
 
use lib 'lib';
20
 
use lib "$ENV{RQG_HOME}/lib";
21
 
use List::Util 'shuffle';
22
 
use GenTest;
23
 
use GenTest::Random;
24
 
use GenTest::Constants;
25
 
use Getopt::Long;
26
 
use Data::Dumper;
27
 
 
28
 
my ($config_file, $basedir, $vardir, $trials, $duration, $grammar, $gendata, 
29
 
    $seed, $testname, $xml_output, $report_xml_tt, $report_xml_tt_type,
30
 
    $report_xml_tt_dest, $force, $no_mask, $exhaustive, $debug);
31
 
 
32
 
my $combinations;
33
 
my %results;
34
 
my @commands;
35
 
my $max_result = 0;
36
 
 
37
 
my $opt_result = GetOptions(
38
 
        'config=s' => \$config_file,
39
 
        'basedir=s' => \$basedir,
40
 
        'vardir=s' => \$vardir,
41
 
        'trials=i' => \$trials,
42
 
        'duration=i' => \$duration,
43
 
        'seed=s' => \$seed,
44
 
        'force' => \$force,
45
 
        'no-mask' => \$no_mask,
46
 
        'grammar=s' => \$grammar,
47
 
        'gendata=s' => \$gendata,
48
 
        'testname=s' => \$testname,
49
 
        'xml-output=s' => \$xml_output,
50
 
        'report-xml-tt' => \$report_xml_tt,
51
 
        'report-xml-tt-type=s' => \$report_xml_tt_type,
52
 
        'report-xml-tt-dest=s' => \$report_xml_tt_dest,
53
 
    'run-all-combinations-once' => \$exhaustive,
54
 
    'debug' => \$debug
55
 
);
56
 
 
57
 
 
58
 
my $prng = GenTest::Random->new(
59
 
        seed => $seed eq 'time' ? time() : $seed
60
 
);
61
 
 
62
 
open(CONF, $config_file) or die "unable to open config file '$config_file': $!";
63
 
read(CONF, my $config_text, -s $config_file);
64
 
eval ($config_text);
65
 
die "Unable to load $config_file: $@" if $@;
66
 
 
67
 
mkdir($vardir);
68
 
system("bzr version-info $basedir");
69
 
system("bzr log --limit=1");
70
 
 
71
 
my $comb_count = $#$combinations + 1;
72
 
 
73
 
my $total = 1;
74
 
if ($exhaustive) {
75
 
    foreach my $comb_id (0..($comb_count-1)) {
76
 
        $total *= $#{$combinations->[$comb_id]}+1;
77
 
    }
78
 
    if (defined $trials) {
79
 
        say("You have specified --run-all-combinations-once, but limited with --trials=$trials");
80
 
    }
81
 
    doExhaustive(0);
82
 
} else {
83
 
    doRandom();
84
 
}
85
 
 
86
 
 
87
 
say("[$$] Summary of various interesting strings from the logs:");
88
 
say(Dumper \%results);
89
 
foreach my $string ('text=', 'bugcheck', 'Error: assertion', 'mysqld got signal', 'Received signal', 'exception') {
90
 
        system("grep -i '$string' $vardir/trial*log");
91
 
} 
92
 
 
93
 
say("[$$] $0 will exit with exit status $max_result");
94
 
exit($max_result);
95
 
 
96
 
## ----------------------------------------------------
97
 
 
98
 
my $trial_counter = 0;
99
 
 
100
 
sub doExhaustive {
101
 
    my ($level,@idx) = @_;
102
 
    if ($level < $comb_count) {
103
 
        my @alts;
104
 
        foreach my $i (0..$#{$combinations->[$level]}) {
105
 
            push @alts, $i;
106
 
        }
107
 
        ## Shuffle array
108
 
        for (my $i= $#alts;$i>=0;$i--) {
109
 
            my $j = $prng->uint16(0, $i);
110
 
            my $t = $alts[$i];
111
 
            $alts[$i] = $alts[$j];
112
 
            $alts[$j] = $t;
113
 
        }
114
 
 
115
 
        foreach my $alt (@alts) {
116
 
            push @idx, $alt;
117
 
            if ($trials > 0) {
118
 
                doExhaustive($level+1,@idx) if $trial_counter < $trials;
119
 
            } else {
120
 
                doExhaustive($level+1,@idx);
121
 
            }
122
 
            pop @idx;
123
 
        }
124
 
    } else {
125
 
        $trial_counter++;
126
 
        my @comb;
127
 
        foreach my $i (0 .. $#idx) {
128
 
            push @comb, $combinations->[$i]->[$idx[$i]];
129
 
        }
130
 
        my $comb_str = join(' ', @comb);        
131
 
        say("Executing Combination ".$trial_counter."/".$total);
132
 
        doCombination($trial_counter,$comb_str);
133
 
    }
134
 
}
135
 
 
136
 
## ----------------------------------------------------
137
 
 
138
 
sub doRandom {
139
 
    foreach my $trial_id (1..$trials) {
140
 
        my @comb;
141
 
        foreach my $comb_id (0..($comb_count-1)) {
142
 
            $comb[$comb_id] = $combinations->[$comb_id]->[$prng->uint16(0, $#{$combinations->[$comb_id]})];
143
 
        }
144
 
        my $comb_str = join(' ', @comb);        
145
 
        doCombination($trial_id,$comb_str);
146
 
    }
147
 
}
148
 
 
149
 
## ----------------------------------------------------
150
 
sub doCombination {
151
 
    my ($trial_id,$comb_str) = @_;
152
 
 
153
 
        my $mask = $prng->uint16(0, 65535);
154
 
 
155
 
        my $command = "
156
 
                perl ".(defined $ENV{RQG_HOME} ? $ENV{RQG_HOME}."/" : "" )."runall.pl $comb_str
157
 
                --queries=100000000
158
 
        ";
159
 
 
160
 
        $command .= " --mask=$mask" if not defined $no_mask;
161
 
        $command .= " --duration=$duration" if $duration ne '';
162
 
        $command .= " --basedir=$basedir " if $basedir ne '';
163
 
        $command .= " --gendata=$gendata " if $gendata ne '';
164
 
        $command .= " --grammar=$grammar " if $grammar ne '';
165
 
        $command .= " --seed=$seed " if $seed ne '';
166
 
        $command .= " --testname=$testname " if $testname ne '';
167
 
        $command .= " --xml-output=$xml_output " if $xml_output ne '';
168
 
        $command .= " --report-xml-tt" if defined $report_xml_tt;
169
 
        $command .= " --report-xml-tt-type=$report_xml_tt_type " if $report_xml_tt_type ne '';
170
 
        $command .= " --report-xml-tt-dest=$report_xml_tt_dest " if $report_xml_tt_dest ne '';
171
 
 
172
 
        $command .= " --vardir=$vardir/current " if $command !~ m{--mem}sio && $vardir ne '';
173
 
        $command =~ s{[\t\r\n]}{ }sgio;
174
 
        $command .= " 2>&1 | tee $vardir/trial".$trial_id.'.log';
175
 
 
176
 
        $commands[$trial_id] = $command;
177
 
 
178
 
        $command =~ s{"}{\\"}sgio;
179
 
        $command = 'bash -c "set -o pipefail; '.$command.'"';
180
 
 
181
 
        say("[$$] $command");
182
 
    my $result = 0;
183
 
    $result = system($command) if not $debug;
184
 
 
185
 
        $result = $result >> 8;
186
 
        say("[$$] runall.pl exited with exit status $result");
187
 
        exit($result) if (($result == STATUS_ENVIRONMENT_FAILURE) || ($result == 255)) && (not defined $force);
188
 
 
189
 
        if ($result > 0) {
190
 
                $max_result = $result >> 8 if ($result >> 8) > $max_result;
191
 
                say("[$$] Copying vardir to $vardir/vardir".$trial_id);
192
 
                if ($command =~ m{--mem}) {
193
 
                        system("cp -r /dev/shm/var $vardir/vardir".$trial_id);
194
 
                } else {
195
 
                        system("cp -r $vardir/current $vardir/vardir".$trial_id);
196
 
                }
197
 
                open(OUT, ">$vardir/vardir".$trial_id."/command");
198
 
                print OUT $command;
199
 
                close(OUT);
200
 
        }
201
 
        $results{$result >> 8}++;
202
 
}