1
# Copyright (c) 2008, 2011 Oracle and/or its affiliates. All rights reserved.
2
# Use is subject to license terms.
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.
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.
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
20
use lib "$ENV{RQG_HOME}/lib";
22
#use List::Util 'shuffle';
26
use GenTest::Constants;
34
require Log::Log4perl;
35
Log::Log4perl->import();
36
$logger = Log::Log4perl->get_logger('randgen.gentest');
40
croak("Sorry. $0 is not ported to Windows (yet)");
46
$SIG{INT} = sub { $ctrl_c = 1 };
47
$SIG{TERM} = sub { exit(0) };
48
$SIG{CHLD} = "IGNORE" if osWindows();
50
my ($config_file, $basedir, $vardir, $trials, $duration, $grammar, $gendata,
51
$seed, $testname, $xml_output, $report_xml_tt, $report_xml_tt_type,
52
$report_xml_tt_dest, $force, $no_mask, $exhaustive, $start_combination, $debug, $noLog,
53
$threads, $new, $servers, $noshuffle, $workdir);
62
my $mtrbt = defined $ENV{MTR_BUILD_THREAD}?$ENV{MTR_BUILD_THREAD}:300;
64
my $opt_result = GetOptions(
65
'config=s' => \$config_file,
66
'basedir=s' => \$basedirs[0],
67
'basedir1=s' => \$basedirs[0],
68
'basedir2=s' => \$basedirs[1],
69
'workdir=s' => \$workdir,
70
'vardir=s' => \$workdir,
71
'trials=i' => \$trials,
72
'duration=i' => \$duration,
75
'no-mask' => \$no_mask,
76
'grammar=s' => \$grammar,
77
'gendata=s' => \$gendata,
78
'testname=s' => \$testname,
79
'xml-output=s' => \$xml_output,
80
'report-xml-tt' => \$report_xml_tt,
81
'report-xml-tt-type=s' => \$report_xml_tt_type,
82
'report-xml-tt-dest=s' => \$report_xml_tt_dest,
83
'run-all-combinations-once' => \$exhaustive,
84
'start-combination=i' => \$start_combination,
87
'parallel=i' => \$threads,
89
'servers=i' => \$servers,
90
'no-shuffle' => \$noshuffle
93
my $prng = GenTest::Random->new(
94
seed => $seed eq 'time' ? time() : $seed
97
open(CONF, $config_file) or croak "unable to open config file '$config_file': $!";
98
read(CONF, my $config_text, -s $config_file);
100
croak "Unable to load $config_file: $@" if $@;
102
if (!defined $servers) {
104
$servers = 2 if $basedirs[1] ne '';
107
croak "--servers may only be 1 or 2" if !($servers == 1 or $servers == 2);
109
my $logToStd = !$noLog;
111
my $bzrinfo = GenTest::BzrInfo->new(
114
my $revno = $bzrinfo->bzrRevno();
115
my $revid = $bzrinfo->bzrRevisionId();
117
if ((defined $revno) && (defined $revid)) {
118
say(cwd()." Revno: $revno");
119
say(cwd()." Revision-Id: $revid");
121
say(cwd().' does not look like a bzr branch, cannot get revision info.');
124
if (not defined $threads) {
127
if ((not defined $trials) and (not defined $exhaustive)) {
128
croak("When using --parallel, also add either or both of these options: --run-all-combinations-once (exhaustive run) and/or --trials=x (random run).\n(Both options combined gives a non-random exhaustive run, yet limited by the number of trials.)");
133
say("Using workdir=".$workdir);
135
my $comb_count = $#$combinations + 1;
140
foreach my $comb_id (0..($comb_count-1)) {
141
$total *= $#{$combinations->[$comb_id]}+1;
143
if (defined $trials) {
144
if ($trials < $total) {
145
say("You specified --run-all-combinations-once, which gives $total combinations, but then limited the same with --trials=$trials");
155
for my $i (1..$threads) {
167
## Children does not continue this loop
173
say("Started thread [$i] pid=$pid");
177
if ($thread_id > 0) {
179
##say("[$thread_id] Summary of various interesting strings from the logs:");
180
##say("[$thread_id] ". Dumper \%results);
181
#foreach my $string ('text=', 'bugcheck', 'Error: assertion', 'mysqld got signal', 'Received signal', 'exception') {
182
# system("grep -i '$string' $workdir/trial*log");
185
say("[$thread_id] will exit with exit status ".status2text($max_result).
190
my $total_status = 0;
193
last if $child == -1;
194
my $exit_status = $? > 0 ? ($? >> 8) : 0;
195
#say("Thread $pids{$child} (pid=$child) exited with $exit_status");
196
$total_status = $exit_status if $exit_status > $total_status;
198
say("$0 will exit with exit status ".status2text($total_status).
205
## ----------------------------------------------------
207
my $trial_counter = 0;
210
my ($level,@idx) = @_;
211
if ($level < $comb_count) {
213
foreach my $i (0..$#{$combinations->[$level]}) {
216
$prng->shuffleArray(\@alts) if !$noshuffle;
218
foreach my $alt (@alts) {
220
doExhaustive($level+1,@idx) if $trial_counter < $trials;
226
foreach my $i (0 .. $#idx) {
227
push @comb, $combinations->[$i]->[$idx[$i]];
229
my $comb_str = join(' ', @comb);
230
next if $trial_counter < $start_combination;
231
doCombination($trial_counter,$comb_str,"combination");
235
## ----------------------------------------------------
238
foreach my $trial_id (1..$trials) {
240
foreach my $comb_id (0..($comb_count-1)) {
241
my $n = $prng->uint16(0, $#{$combinations->[$comb_id]});
242
$comb[$comb_id] = $combinations->[$comb_id]->[$n];
244
my $comb_str = join(' ', @comb);
245
doCombination($trial_id,$comb_str,"random trial");
249
## ----------------------------------------------------
251
my ($trial_id,$comb_str,$comment) = @_;
253
return if (($trial_id -1) % $threads +1) != $thread_id;
254
say("[$thread_id] Running $comment ".$trial_id."/".$trials);
255
my $mask = $prng->uint16(0, 65535);
257
my $runall = $new?"runall-new.pl":"runall.pl";
260
perl ".($Carp::Verbose?"-MCarp=verbose ":"").
261
(defined $ENV{RQG_HOME} ? $ENV{RQG_HOME}."/" : "" ).
262
"$runall --queries=100000000 $comb_str ";
264
$command .= " --mtr-build-thread=".($mtrbt+($thread_id-1)*2);
265
$command .= " --mask=$mask" if not defined $no_mask;
266
$command .= " --duration=$duration" if $duration ne '';
267
foreach my $s (1..$servers) {
268
$command .= " --basedir".$s."=".$basedirs[$s-1]." " if $basedirs[$s-1] ne '';
270
$command .= " --gendata=$gendata " if $gendata ne '';
271
$command .= " --grammar=$grammar " if $grammar ne '';
272
$command .= " --seed=$seed " if $seed ne '';
273
$command .= " --testname=$testname " if $testname ne '';
274
$command .= " --xml-output=$xml_output " if $xml_output ne '';
275
$command .= " --report-xml-tt" if defined $report_xml_tt;
276
$command .= " --report-xml-tt-type=$report_xml_tt_type " if $report_xml_tt_type ne '';
277
$command .= " --report-xml-tt-dest=$report_xml_tt_dest " if $report_xml_tt_dest ne '';
279
foreach my $s (1..$servers) {
280
$command .= " --vardir".$s."=$workdir/current".$s."_$thread_id " if $command !~ m{--mem}sio && $workdir ne '';
282
$command =~ s{[\t\r\n]}{ }sgio;
284
$command .= " 2>&1 | tee $workdir/trial".$trial_id.'.log';
286
$command .= " > $workdir/trial".$trial_id.'.log'. " 2>&1";
289
$commands[$trial_id] = $command;
291
$command =~ s{"}{\\"}sgio;
292
$command = 'bash -c "set -o pipefail; '.$command.'"';
295
say("[$thread_id] $command");
298
$result = system($command) if not $debug;
300
$result = $result >> 8;
301
say("[$thread_id] $runall exited with exit status ".status2text($result).
302
"($result), see $workdir/trial".$trial_id.'.log');
303
exit($result) if (($result == STATUS_ENVIRONMENT_FAILURE) || ($result == 255)) && (not defined $force);
306
foreach my $s (1..$servers) {
307
$max_result = $result if $result > $max_result;
308
my $from = $workdir."/current".$s."_".$thread_id;
309
my $to = $workdir."/vardir".$s."_".$trial_id;
310
say("[$thread_id] Copying $from to $to") if $logToStd;
311
if ($command =~ m{--mem}) {
312
system("cp -r /dev/shm/var $to");
314
system("cp -r $from $to");
316
open(OUT, ">$to/command");
321
$results{$result >> 8}++;