#!/usr/bin/env perl # Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; version 2 of the License. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA use File::Basename; use File::Copy qw(copy); use File::Spec qw(catdir); use File::Path; use IO::File; use strict; # Constants and variables with default values my $suites; my $suffix = "_checksum"; my $percent_random_test = 10; my $mtr_script; my @mtr_argv; my @mtr_suites; # Check some arguments foreach my $arg ( @ARGV ) { if ($arg =~ m/\-\-suite\=(.+)/i) { $suites = $1; } elsif ($arg =~ m/\-\-percent\=(\d{1,2})/i) { $percent_random_test= $1; } else { push(@mtr_argv, $arg); } } if (! defined( $suites ) ) { die("The script requires --suite argument"); } print "#################################################################\n"; print "# Binlog checksum testing\n"; print "# Run randomly $percent_random_test\% of tests from following suites: $suites\n"; print "#################################################################\n"; # Set extension directory my $ext_dir= dirname(File::Spec->rel2abs($0)); # Set mysql-test directory my $mysql_test_dir= $ext_dir; $mysql_test_dir =~ s/(\/|\\)suite(\/|\\)rpl(\/|\\)extension$//; # Main loop foreach my $src_suite (split(",", $suites)) { $src_suite=~ s/ //g; my $dest_suite= $src_suite . $suffix; push( @mtr_suites, $dest_suite); print "Creating suite $dest_suite\n"; # *** Set platform-independent pathes *** # Set source directory of suite my $src_suite_dir = File::Spec->catdir($mysql_test_dir, "suite", $src_suite); # Set destination directory of suite my $dest_suite_dir = File::Spec->catdir($mysql_test_dir, "suite", $dest_suite); print "Copying files\n\tfrom '$src_suite_dir'\n\tto '$dest_suite_dir'\n"; dircopy($src_suite_dir, $dest_suite_dir); my $test_case_dir= File::Spec->catdir($dest_suite_dir, "t"); # Read disabled.def my %disabled = (); print "Read disabled.def\n"; my $fh = new IO::File File::Spec->catdir($test_case_dir, "disabled.def"), "r"; if ( defined $fh ) { my @lines = <$fh>; undef $fh; foreach my $line ( @lines ) { if ($line =~ m/^([a-zA-Z0-9_]+).+\:.+/i) { $disabled{$1}= 1; } } } # Read test case list my %tests = (); print "Generate test case list\n"; opendir my ($dh), $test_case_dir or die "Could not open dir '$test_case_dir': $!"; for my $entry (readdir $dh) { if ( $entry =~ m/^([a-zA-Z0-9_]+)\.test$/i ) { my $test= $1; if ( ! defined( $disabled{$test}) ) { $tests{$test}= 1; } } } closedir($dh); # my @excluded = (); my $excluded_test= int((((100 - $percent_random_test)/100) * scalar( keys %tests ))); while ( $excluded_test > 0 ) { my @cases = keys %tests; my $test = $cases[int(rand(scalar(@cases)))]; push ( @excluded, $test . "\t\t: Excluded for $dest_suite\n" ); delete $tests{$test}; $excluded_test--; } my $fh = new IO::File File::Spec->catdir($test_case_dir, "disabled.def"), O_WRONLY|O_APPEND; if (defined $fh) { print $fh join ("", sort @excluded); undef $fh; } print "\t" . join("\n\t", sort keys %tests) . "\n"; } # Set path to mtr with arguments my $mtr_script = "perl " . File::Spec->catdir($mysql_test_dir, "mysql-test-run.pl") . " --suite=" . join(",", @mtr_suites) . " " . " --mysqld=--binlog-checksum=CRC32 " . join (" ", @mtr_argv); print "Run $mtr_script\n"; system( $mtr_script ); sub dircopy { my ($from_dir, $to_dir)= @_; mkdir $to_dir if (! -e $to_dir); opendir my($dh), $from_dir or die "Could not open dir '$from_dir': $!"; for my $entry (readdir $dh) { next if $entry =~ /^(\.|\.\.)$/; my $source = File::Spec->catdir($from_dir, $entry); my $destination = File::Spec->catdir($to_dir, $entry); if (-d $source) { mkdir $destination or die "mkdir '$destination' failed: $!" if not -e $destination; dircopy($source, $destination); } else { copy($source, $destination) or die "copy '$source' to '$destination' failed: $!"; } } closedir $dh; return; }