1#!/usr/bin/perl
2
3# Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved.
4#
5# This program is free software; you can redistribute it and/or modify
6# it under the terms of the GNU General Public License, version 2.0,
7# as published by the Free Software Foundation.
8#
9# This program is also distributed with certain software (including
10# but not limited to OpenSSL) that is licensed under separate terms,
11# as designated in a particular file or component or in included license
12# documentation.  The authors of MySQL hereby grant you an additional
13# permission to link the program and your derivative works with the
14# separately licensed software that they have included with MySQL.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19# GNU General Public License, version 2.0, for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program; if not, write to the Free Software
23# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
24
25use File::Basename;
26use File::Copy qw(copy);
27use File::Spec qw(catdir);
28use File::Path;
29use IO::File;
30use strict;
31
32# Constants and variables with default values
33my $suites;
34my $suffix = "_checksum";
35my $percent_random_test = 10;
36my $mtr_script;
37my @mtr_argv;
38my @mtr_suites;
39
40# Check some arguments
41foreach my $arg ( @ARGV )
42{
43    if ($arg =~ m/\-\-suite\=(.+)/i)
44    {
45        $suites = $1;
46    }
47    elsif ($arg =~ m/\-\-percent\=(\d{1,2})/i)
48    {
49	$percent_random_test= $1;
50    }
51    else
52    {
53	push(@mtr_argv, $arg);
54    }
55
56}
57if (! defined( $suites ) )
58{
59    die("The script requires --suite argument");
60}
61
62print "#################################################################\n";
63print "# Binlog checksum testing\n";
64print "# Run randomly $percent_random_test\% of tests from following suites: $suites\n";
65print "#################################################################\n";
66
67# Set extension directory
68my $ext_dir= dirname(File::Spec->rel2abs($0));
69# Set mysql-test directory
70my $mysql_test_dir= $ext_dir;
71$mysql_test_dir =~ s/(\/|\\)suite(\/|\\)rpl(\/|\\)extension$//;
72
73# Main loop
74foreach my $src_suite (split(",", $suites))
75{
76    $src_suite=~ s/ //g;
77    my $dest_suite= $src_suite . $suffix;
78    push( @mtr_suites, $dest_suite);
79    print "Creating suite $dest_suite\n";
80    # *** Set platform-independent pathes ***
81    # Set source directory of suite
82    my $src_suite_dir = File::Spec->catdir($mysql_test_dir, "suite", $src_suite);
83    # Set destination directory of suite
84    my $dest_suite_dir = File::Spec->catdir($mysql_test_dir, "suite", $dest_suite);
85    print "Copying files\n\tfrom '$src_suite_dir'\n\tto '$dest_suite_dir'\n";
86    dircopy($src_suite_dir, $dest_suite_dir);
87    my $test_case_dir= File::Spec->catdir($dest_suite_dir, "t");
88    # Read disabled.def
89    my %disabled = ();
90    print "Read disabled.def\n";
91    my $fh = new IO::File File::Spec->catdir($test_case_dir, "disabled.def"), "r";
92    if ( defined $fh )
93    {
94	my @lines = <$fh>;
95	undef $fh;
96	foreach my $line ( @lines )
97	{
98	    if ($line =~ m/^([a-zA-Z0-9_]+).+\:.+/i)
99	    {
100		$disabled{$1}= 1;
101	    }
102	}
103    }
104    # Read test case list
105    my %tests = ();
106    print "Generate test case list\n";
107    opendir my ($dh), $test_case_dir or die "Could not open dir '$test_case_dir': $!";
108    for my $entry (readdir $dh)
109    {
110	if ( $entry =~ m/^([a-zA-Z0-9_]+)\.test$/i )
111	{
112	    my $test= $1;
113	    if ( ! defined( $disabled{$test}) )
114	    {
115		$tests{$test}= 1;
116	    }
117	}
118    }
119    closedir($dh);
120    #
121    my @excluded = ();
122    my $excluded_test= int((((100 - $percent_random_test)/100) * scalar( keys %tests )));
123    while  ( $excluded_test > 0 )
124    {
125	my @cases = keys %tests;
126	my $test = $cases[int(rand(scalar(@cases)))];
127	push ( @excluded, $test . "\t\t: Excluded for $dest_suite\n" );
128	delete $tests{$test};
129	$excluded_test--;
130    }
131    my $fh = new IO::File File::Spec->catdir($test_case_dir, "disabled.def"), O_WRONLY|O_APPEND;
132    if (defined $fh) {
133	print $fh join ("", sort @excluded);
134	undef $fh;
135    }
136    print "\t" . join("\n\t", sort keys %tests) . "\n";
137
138}
139
140# Set path to mtr with arguments
141my $mtr_script = "perl " . File::Spec->catdir($mysql_test_dir, "mysql-test-run.pl") .
142    " --suite=" . join(",", @mtr_suites) . " " .
143    " --mysqld=--binlog-checksum=CRC32 " .
144    join (" ", @mtr_argv);
145
146print "Run $mtr_script\n";
147system( $mtr_script );
148
149sub dircopy
150{
151    my ($from_dir, $to_dir)= @_;
152    mkdir $to_dir if (! -e $to_dir);
153    opendir my($dh), $from_dir or die "Could not open dir '$from_dir': $!";
154    for my $entry (readdir $dh)
155    {
156	next if $entry =~ /^(\.|\.\.)$/;
157        my $source = File::Spec->catdir($from_dir, $entry);
158        my $destination = File::Spec->catdir($to_dir, $entry);
159        if (-d $source)
160        {
161    	    mkdir $destination or die "mkdir '$destination' failed: $!" if not -e $destination;
162            dircopy($source, $destination);
163        }
164        else
165        {
166    	    copy($source, $destination) or die "copy '$source' to '$destination' failed: $!";
167        }
168    }
169    closedir $dh;
170    return;
171}
172