~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/randgen/combinations.pl

Merged Stewart's kick-ass randgen branch - randgen is in the tree

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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
}