diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-04 18:00:34 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-05-04 18:00:34 +0000 |
commit | 3f619478f796eddbba6e39502fe941b285dd97b1 (patch) | |
tree | e2c7b5777f728320e5b5542b6213fd3591ba51e2 /mysql-test/lib/mtr_cases.pm | |
parent | Initial commit. (diff) | |
download | mariadb-3f619478f796eddbba6e39502fe941b285dd97b1.tar.xz mariadb-3f619478f796eddbba6e39502fe941b285dd97b1.zip |
Adding upstream version 1:10.11.6.upstream/1%10.11.6upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'mysql-test/lib/mtr_cases.pm')
-rw-r--r-- | mysql-test/lib/mtr_cases.pm | 1191 |
1 files changed, 1191 insertions, 0 deletions
diff --git a/mysql-test/lib/mtr_cases.pm b/mysql-test/lib/mtr_cases.pm new file mode 100644 index 00000000..41d943e3 --- /dev/null +++ b/mysql-test/lib/mtr_cases.pm @@ -0,0 +1,1191 @@ +# -*- cperl -*- +# Copyright (c) 2005, 2011, Oracle and/or its affiliates. +# Copyright (c) 2010, 2011 Monty Program Ab +# +# 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 + +# This is a library file used by the Perl version of mysql-test-run, +# and is part of the translation of the Bourne shell script with the +# same name. + +package mtr_cases; +use strict; + +use base qw(Exporter); +our @EXPORT= qw(collect_option collect_test_cases collect_default_suites); + +use Carp; + +use mtr_report; +use mtr_match; + +# Options used for the collect phase +our $skip_rpl; +our $do_test; +our $skip_test; +our $binlog_format; +our $enable_disabled; + +sub collect_option { + my ($opt, $value)= @_; + + # Evaluate $opt as string to use "Getopt::Long::Callback legacy API" + my $opt_name = "$opt"; + + # Convert - to _ in option name + $opt_name =~ s/-/_/g; + no strict 'refs'; + ${$opt_name}= $value; +} + +use File::Basename; +use File::Spec::Functions qw /splitdir/; +use IO::File(); +use My::Config; +use My::Platform; +use My::Test; +use My::Find; +use My::Suite; + +# locate plugin suites, depending on whether it's a build tree or installed +my @plugin_suitedirs; +my $plugin_suitedir_regex; +my $overlay_regex; + +if (-d '../sql') { + @plugin_suitedirs= ('storage/*/mysql-test', 'plugin/*/mysql-test', 'storage/*/*/mysql-test', ); + $overlay_regex= '\b(?:storage|plugin|storage[/][^/]*)/(\w+)/mysql-test\b'; +} else { + @plugin_suitedirs= ('mysql-test/plugin/*'); + $overlay_regex= '\bmysql-test/plugin/(\w+)\b'; +} +$plugin_suitedir_regex= $overlay_regex; +$plugin_suitedir_regex=~ s/\Q(\w+)\E/\\w+/; + +# Precompiled regex's for tests to do or skip +my $do_test_reg; +my $skip_test_reg; + +my %suites; + +sub init_pattern { + my ($from, $what)= @_; + return undef unless defined $from; + if ( $from =~ /^[a-z0-9\.]*$/ ) { + # Does not contain any regex (except . that we allow as + # separator betwen suite and testname), make the pattern match + # beginning of string + $from= "^$from"; + mtr_verbose2("$what='$from'"); + } + # Check that pattern is a valid regex + eval { "" =~/$from/; 1 } or + mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@"); + return $from; +} + + +############################################################################## +# +# Collect information about test cases to be run +# +############################################################################## + +sub collect_test_cases ($$$$) { + my $opt_reorder= shift; # True if we're reordering tests + my $suites= shift; # Semicolon separated list of test suites + my $opt_cases= shift; + my $opt_skip_test_list= shift; + my $cases= []; # Array of hash(one hash for each testcase) + + $do_test_reg= init_pattern($do_test, "--do-test"); + $skip_test_reg= init_pattern($skip_test, "--skip-test"); + + parse_disabled($_) for @$opt_skip_test_list; + + # If not reordering, we also shouldn't group by suites, unless + # no test cases were named. + # This also affects some logic in the loop following this. + if ($opt_reorder or !@$opt_cases) + { + foreach my $suite (split(",", $suites)) + { + push(@$cases, collect_suite_name($suite, $opt_cases)); + } + } + + if ( @$opt_cases ) + { + # A list of tests was specified on the command line + # Check that the tests specified were found + # in at least one suite + foreach my $test_name_spec ( @$opt_cases ) + { + my $found= 0; + my ($sname, $tname)= split_testname($test_name_spec); + foreach my $test ( @$cases ) + { + last unless $opt_reorder; + # test->{name} is always in suite.name format + if ( $test->{name} =~ /^$sname.*\.$tname$/ ) + { + $found= 1; + last; + } + } + if ( not $found ) + { + $sname= "main" if !$opt_reorder and !$sname; + mtr_error("Could not find '$tname' in '$suites' suite(s)") unless $sname; + # If suite was part of name, find it there, may come with combinations + my @this_case = collect_suite_name($sname, [ $test_name_spec ]); + if (@this_case) + { + push (@$cases, @this_case); + } + elsif ($::opt_skip_not_found) + { + push @$cases, My::Test->new + ( + name => "$sname.$tname", + shortname => $tname, + skip => 1, + comment => 'not found', + ); + } + else + { + mtr_error("Could not find '$tname' in '$sname' suite"); + } + } + } + } + + if ( $opt_reorder ) + { + # Make a mapping of test name to a string that represents how that test + # should be sorted among the other tests. Put the most important criterion + # first, then a sub-criterion, then sub-sub-criterion, etc. + foreach my $tinfo (@$cases) + { + my @criteria = (); + + # + # Collect the criteria for sorting, in order of importance. + # Note that criteria are also used in mysql-test-run.pl to + # schedule tests to workers, and it preferres tests that have + # *identical* criteria. That is, test name is *not* part of + # the criteria, but it's part of the sorting function below. + # + push(@criteria, $tinfo->{template_path}); + for (qw(master_opt slave_opt)) { + # Group test with equal options together. + # Ending with "~" makes empty sort later than filled + my $opts= $tinfo->{$_} ? $tinfo->{$_} : []; + push(@criteria, join("!", sort @{$opts}) . "~"); + } + $tinfo->{criteria}= join(" ", @criteria); + } + + @$cases = sort { # ORDER BY + $b->{skip} <=> $a->{skip} || # skipped DESC, + $a->{criteria} cmp $b->{criteria} || # criteria ASC, + $b->{long_test} <=> $a->{long_test} || # long_test DESC, + $a->{name} cmp $b->{name} # name ASC + } @$cases; + } + + return $cases; +} + + +# Returns (suitename, testname, combinations....) +sub split_testname { + my ($test_name)= @_; + + # If .test file name is used, get rid of directory part + $test_name= basename($test_name) if $test_name =~ /\.test$/; + + # Then, get the combinations: + my ($test_name, @combs) = split /,/, $test_name; + + # Now split name on .'s + my @parts= split(/\./, $test_name); + + if (@parts == 1){ + # Only testname given, ex: alias + return (undef , $parts[0], @combs); + } elsif (@parts == 2) { + # Either testname.test or suite.testname given + # Ex. main.alias or alias.test + + if ($parts[1] eq "test") + { + return (undef , $parts[0], @combs); + } + else + { + return ($parts[0], $parts[1], @combs); + } + } + + mtr_error("Illegal format of test name: $test_name"); +} + +our %file_to_tags; +our %file_to_master_opts; +our %file_to_slave_opts; +our %file_combinations; +our %skip_combinations; +our %file_in_overlay; + +sub load_suite_object { + my ($suitename, $suitedir) = @_; + my $suite; + unless (defined $suites{$suitename}) { + if (-f "$suitedir/suite.pm") { + $suite= do "$suitedir/suite.pm"; + mtr_error("Cannot load $suitedir/suite.pm: $@") if $@; + unless (ref $suite) { + my $comment = $suite; + $suite = My::Suite->new(); + $suite->{skip} = $comment; + } + } else { + $suite = My::Suite->new(); + } + + $suites{$suitename} = $suite; + + # add suite skiplist to a global hash, so that we can check it + # with only one lookup + my %suite_skiplist = $suite->skip_combinations(); + while (my ($file, $skiplist) = each %suite_skiplist) { + $file =~ s/\.\w+$/\.combinations/; + if (ref $skiplist) { + $skip_combinations{"$suitedir/$file => $_"} = 1 for (@$skiplist); + } else { + $skip_combinations{"$suitedir/$file"} = $skiplist; + } + } + } + return $suites{$suitename}; +} + + +# returns a pair of (suite, suitedir) +sub suite_for_file($) { + my ($file) = @_; + return ($2, $1) if $file =~ m@^(.*/$plugin_suitedir_regex/(\w+))/@o; + return ($2, $1) if $file =~ m@^(.*/mysql-test/suite/(\w+))/@; + return ('main', $1) if $file =~ m@^(.*/mysql-test)/@; + mtr_error("Cannot determine suite for $file"); +} + +sub combinations_from_file($$) +{ + my ($in_overlay, $filename) = @_; + my @combs; + if ($skip_combinations{$filename}) { + @combs = ({ skip => $skip_combinations{$filename} }); + } else { + return () if @::opt_combinations or not -f $filename; + return () if ::using_extern(); + # Read combinations file in my.cnf format + mtr_verbose2("Read combinations file $filename"); + my $config= My::Config->new($filename); + foreach my $group ($config->option_groups()) { + my $comb= { name => $group->name(), comb_opt => [] }; + next if $skip_combinations{"$filename => $comb->{name}"}; + foreach my $option ( $group->options() ) { + push(@{$comb->{comb_opt}}, $option->option()); + } + $comb->{in_overlay} = 1 if $in_overlay; + push @combs, $comb; + } + @combs = ({ skip => 'Requires: ' . basename($filename, '.combinations') }) unless @combs; + } + @combs; +} + +our %disabled; +our %disabled_wildcards; +sub parse_disabled { + my ($filename, $suitename) = @_; + + if (open(DISABLED, $filename)) { + while (<DISABLED>) { + chomp; + next if /^\s*#/ or /^\s*$/; + mtr_error("Syntax error in $filename line $.") + unless /^\s*(?:([-0-9A-Za-z_\/]+)\.)?([-0-9A-Za-z_#\*]+)\s*:\s*(.*?)\s*$/; + mtr_error("Wrong suite name in $filename line $.: suitename = $suitename but the file says $1") + if defined $1 and defined $suitename and $1 ne $suitename; + my ($sname, $casename, $text)= (($1 || $suitename || ''), $2, $3); + + if ($casename =~ /\*/) { + # Wildcard + $disabled_wildcards{$sname . ".$casename"}= $text; + } + else { + $disabled{$sname . ".$casename"}= $text; + } + } + close DISABLED; + } +} + +# +# load suite.pm files from plugin suites +# collect the list of default plugin suites. +# XXX currently it does not support nested suites +# +sub collect_default_suites(@) +{ + use File::Find; + my @dirs; + find(sub { + push @dirs, [$File::Find::topdir, $File::Find::name] + if -d and -f "$File::Find::name/suite.pm"; + }, my_find_dir(dirname($::glob_mysql_test_dir), \@plugin_suitedirs)); + + for (@dirs) { + my ($plugin_root, $dir) = @$_; + my $sname= substr $dir, 1 + length $plugin_root; + # ignore overlays here, otherwise we'd need accurate + # duplicate detection with overlay support for the default suite list + next if $sname eq 'main' or -d "$::glob_mysql_test_dir/suite/$sname"; + my $s = load_suite_object($sname, $dir); + push @_, $sname if $s->is_default(); + } + return @_; +} + + +# +# processes one user-specified suite name. +# it could contain wildcards, e.g engines/* +# +sub collect_suite_name($$) +{ + my $suitename= shift; # Test suite name + my $opt_cases= shift; + my $over; + my %suites; + + ($suitename, $over) = split '-', $suitename; + + if ( $suitename ne "main" ) + { + # Allow suite to be path to "some dir" if $suitename has at least + # one directory part + if ( -d $suitename and splitdir($suitename) > 1 ) { + $suites{$suitename} = [ $suitename ]; + mtr_report(" - from '$suitename'"); + } + else + { + my @dirs = my_find_dir(dirname($::glob_mysql_test_dir), + ["mysql-test/suite", @plugin_suitedirs ], + $suitename); + # + # if $suitename contained wildcards, we'll have many suites and + # their overlays here. Let's group them appropriately. + # + for (@dirs) { + m@^.*/(?:mysql-test/suite|$plugin_suitedir_regex)/(.*)$@o or confess $_; + push @{$suites{$1}}, $_; + } + } + } else { + $suites{$suitename} = [ $::glob_mysql_test_dir . "/main", + my_find_dir(dirname($::glob_mysql_test_dir), + [ @plugin_suitedirs ], + 'main', NOT_REQUIRED) ]; + } + + my @cases; + while (my ($name, $dirs) = each %suites) { + # + # XXX at the moment, for simplicity, we will not fully support one + # plugin overlaying a suite of another plugin. Only suites in the main + # mysql-test directory can be safely overlayed. To be fixed, when + # needed. To fix it we'll need a smarter overlay detection (that is, + # detection of what is an overlay and what is the "original" suite) + # than simply "prefer directories with more files". + # + if ($dirs->[0] !~ m@/mysql-test/suite/$name$@) { + # prefer directories with more files + @$dirs = sort { scalar(<$a/*>) <=> scalar(<$b/*>) } @$dirs; + } + push @cases, collect_one_suite($opt_cases, $name, $over, @$dirs); + } + return @cases; +} + +sub collect_one_suite { + my ($opt_cases, $suitename, $over, $suitedir, @overlays) = @_; + + mtr_verbose2("Collecting: $suitename"); + mtr_verbose2("suitedir: $suitedir"); + mtr_verbose2("overlays: @overlays") if @overlays; + + # we always need to process the parent suite, even if we won't use any + # test from it. + my @cases= process_suite($suitename, undef, $suitedir, + $over ? [ '*BOGUS*' ] : $opt_cases); + + # when working with overlays we cannot use global caches like + # %file_to_tags. Because the same file may have different tags + # with and without overlays. For example, when a.test includes + # b.inc, which includes c.inc, and an overlay replaces c.inc. + # In this case b.inc may have different tags in the overlay, + # despite the fact that b.inc itself is not replaced. + for (@overlays) { + local %file_to_tags = (); + local %file_to_master_opts = (); + local %file_to_slave_opts = (); + local %file_combinations = (); + local %file_in_overlay = (); + + confess $_ unless m@/$overlay_regex/@o; + next unless defined $over and ($over eq '' or $over eq $1); + push @cases, + # don't add cases that take *all* data from the parent suite + grep { $_->{in_overlay} } process_suite($suitename, $1, $_, $opt_cases); + } + return @cases; +} + +sub process_suite { + my ($basename, $overname, $suitedir, $opt_cases) = @_; + my $suitename; + my $parent; + + if ($overname) { + $parent = $suites{$basename}; + confess unless $parent; + $suitename = $basename . '-' . $overname; + } else { + $suitename = $basename; + } + + my $suite = load_suite_object($suitename, (($suitename eq "main") ? + $::glob_mysql_test_dir : + $suitedir)); + + # + # Read suite config files, unless it was done aleady + # + unless (defined $suite->{name}) { + $suite->{name} = $suitename; + $suite->{dir} = $suitedir; + + # First, we need to find where the test files and result files are. + # test files are usually in a t/ dir inside suite dir. Or directly in the + # suite dir. result files are in a r/ dir or in the suite dir. + # Overlay uses t/ and r/ if and only if its parent does. + if ($parent) { + $suite->{parent} = $parent; + my $tdir = $parent->{tdir}; + my $rdir = $parent->{rdir}; + substr($tdir, 0, length $parent->{dir}) = $suitedir; + substr($rdir, 0, length $parent->{dir}) = $suitedir; + $suite->{tdir} = $tdir if -d $tdir; + $suite->{rdir} = $rdir if -d $rdir; + } else { + my $tdir= "$suitedir/t"; + my $rdir= "$suitedir/r"; + $suite->{tdir} = -d $tdir ? $tdir : $suitedir; + $suite->{rdir} = -d $rdir ? $rdir : $suite->{tdir}; + } + + mtr_verbose2("testdir: " . $suite->{tdir}); + mtr_verbose2( "resdir: " . $suite->{rdir}); + + # disabled.def + parse_disabled($suite->{dir} .'/disabled.def', $suitename); + parse_disabled($suite->{dir} .'/t/disabled.def', $suitename); + + # combinations + if (@::opt_combinations) + { + # take the combination from command-line + mtr_verbose2("Take the combination from command line"); + foreach my $combination (@::opt_combinations) { + my $comb= {}; + $comb->{name}= $combination; + push(@{$comb->{comb_opt}}, $combination); + push @{$suite->{combinations}}, $comb; + } + } + else + { + my @combs; + my $from = "$suitedir/combinations"; + @combs = combinations_from_file($parent, $from) unless $suite->{skip}; + $suite->{combinations} = [ @combs ]; + # in overlays it's a union of parent's and overlay's files. + unshift @{$suite->{combinations}}, + grep { not $skip_combinations{"$from => $_->{name}"} } + @{$parent->{combinations}} if $parent; + } + + # suite.opt + # in overlays it's a union of parent's and overlay's files. + $suite->{opts} = [ opts_from_file("$suitedir/suite.opt") ]; + $suite->{in_overlay} = 1 if $parent and @{$suite->{opts}}; + unshift @{$suite->{opts}}, @{$parent->{opts}} if $parent; + + $suite->{cases} = [ $suite->list_cases($suite->{tdir}) ]; + } + + my %all_cases; + %all_cases = map { $_ => $parent->{tdir} } @{$parent->{cases}} if $parent; + $all_cases{$_} = $suite->{tdir} for @{$suite->{cases}}; + + my @cases; + if (@$opt_cases) { + # Collect in specified order + foreach my $test_name_spec ( @$opt_cases ) + { + my ($sname, $tname, @combs)= split_testname($test_name_spec); + + # Check correct suite if suitename is defined + next if defined $sname and $sname ne $suitename + and $sname ne "$basename-"; + + next unless $all_cases{$tname}; + push @cases, collect_one_test_case($suite, $all_cases{$tname}, $tname, @combs); + } + } else { + for (sort keys %all_cases) + { + # Skip tests that do not match the --do-test= filter + next if $do_test_reg and not /$do_test_reg/o; + push @cases, collect_one_test_case($suite, $all_cases{$_}, $_); + } + } + + @cases; +} + +# +# Read options from the given opt file and append them as an array +# to $tinfo->{$opt_name} +# +sub process_opts { + my ($tinfo, $opt_name)= @_; + + my @opts= @{$tinfo->{$opt_name}}; + $tinfo->{$opt_name} = []; + + foreach my $opt (@opts) + { + my $value; + + # The opt file is used both to send special options to the mysqld + # as well as pass special test case specific options to this + # script + + $value= mtr_match_prefix($opt, "--timezone="); + if ( defined $value ) + { + $tinfo->{'timezone'}= $value; + next; + } + + # If we set default time zone, remove the one we have + $value= mtr_match_prefix($opt, "--default-time-zone="); + if ( defined $value ) + { + # Set timezone for this test case to something different + $tinfo->{'timezone'}= "GMT-8"; + # Fallthrough, add the --default-time-zone option + } + + # Ok, this was a real option, add it + push(@{$tinfo->{$opt_name}}, $opt); + } +} + +sub make_combinations($$@) +{ + my ($test, $test_combs, @combinations) = @_; + + return ($test) unless @combinations; + if ($combinations[0]->{skip}) { + $test->{skip} = 1; + $test->{comment} = $combinations[0]->{skip} unless $test->{comment}; + confess unless @combinations == 1; + return ($test); + } + + foreach my $comb (@combinations) + { + # Skip all other combinations if the values they change + # are already fixed in master_opt or slave_opt + # (empty combinations are not considered a subset of anything) + if (@{$comb->{comb_opt}} && + My::Options::is_subset($test->{master_opt}, $comb->{comb_opt}) && + My::Options::is_subset($test->{slave_opt}, $comb->{comb_opt}) ){ + + $test_combs->{$comb->{name}} = 2; + + # Add combination name short name + push @{$test->{combinations}}, $comb->{name}; + + return ($test); + } + + # Skip all other combinations, if this combination is forced + if ($test_combs->{$comb->{name}}) { + @combinations = ($comb); # run the loop below only for this combination + $test_combs->{$comb->{name}} = 2; + last; + } + } + + return ($test) if $test->{'skip'}; + + my @cases; + foreach my $comb (@combinations) + { + # Copy test options + my $new_test= $test->copy(); + + # Prepend the combination options to master_opt and slave_opt + # (on the command line combinations go *before* .opt files) + unshift @{$new_test->{master_opt}}, @{$comb->{comb_opt}}; + unshift @{$new_test->{slave_opt}}, @{$comb->{comb_opt}}; + + # Add combination name short name + push @{$new_test->{combinations}}, $comb->{name}; + + $new_test->{in_overlay} = 1 if $comb->{in_overlay}; + + # Add the new test to new test cases list + push(@cases, $new_test); + } + return @cases; +} + + +sub find_file_in_dirs +{ + my ($tinfo, $slot, $filename) = @_; + my $parent = $tinfo->{suite}->{parent}; + my $f = $tinfo->{suite}->{$slot} . '/' . $filename; + + if (-f $f) { + $tinfo->{in_overlay} = 1 if $parent; + return $f; + } + + return undef unless $parent; + + $f = $parent->{$slot} . '/' . $filename; + return -f $f ? $f : undef; +} + +############################################################################## +# +# Collect information about a single test case +# +############################################################################## + +sub collect_one_test_case { + my $suite = shift; + my $tpath = shift; + my $tname = shift; + my %test_combs = map { $_ => 1 } @_; + my $suitename = $suite->{name}; + my $name = "$suitename.$tname"; + my $filename = "$tpath/${tname}.test"; + + # ---------------------------------------------------------------------- + # Set defaults + # ---------------------------------------------------------------------- + my $tinfo= My::Test->new + ( + name => $name, + shortname => $tname, + path => $filename, + suite => $suite, + in_overlay => $suite->{in_overlay}, + master_opt => [ @{$suite->{opts}} ], + slave_opt => [ @{$suite->{opts}} ], + ); + + # ---------------------------------------------------------------------- + # Skip some tests but include in list, just mark them as skipped + # ---------------------------------------------------------------------- + if ( $skip_test_reg and ($tname =~ /$skip_test_reg/o or + $name =~ /$skip_test_reg/o)) + { + $tinfo->{'skip'}= 1; + return $tinfo; + } + + # ---------------------------------------------------------------------- + # Check for disabled tests + # ---------------------------------------------------------------------- + my $disable = $disabled{".$tname"} || $disabled{$name}; + if (not $disable) { + foreach my $w (keys %disabled_wildcards) { + if ($name =~ /^$w/) { + $disable= $disabled_wildcards{$w}; + last; + } + } + } + if (not defined $disable and $suite->{parent}) { + $disable = $disabled{$suite->{parent}->{name} . ".$tname"}; + } + if (defined $disable) + { + $tinfo->{comment}= $disable; + if ( $enable_disabled ) + { + # User has selected to run all disabled tests + mtr_report(" - $tinfo->{name} will be run although it's been disabled\n", + " due to '$disable'"); + } + else + { + $tinfo->{'skip'}= 1; + $tinfo->{'disable'}= 1; # Sub type of 'skip' + + # we can stop test file processing early if the test if disabled, but + # only if we're not in the overlay. for overlays we want to know exactly + # whether the test is ignored (in_overlay=0) or disabled. + return $tinfo unless $suite->{parent}; + } + } + + if ($suite->{skip}) { + $tinfo->{skip}= 1; + $tinfo->{comment}= $suite->{skip} unless $tinfo->{comment}; + return $tinfo unless $suite->{parent}; + } + + # ---------------------------------------------------------------------- + # Check for test specific config file + # ---------------------------------------------------------------------- + my $test_cnf_file= find_file_in_dirs($tinfo, tdir => "$tname.cnf"); + if ($test_cnf_file ) { + # Specifies the configuration file to use for this test + $tinfo->{'template_path'}= $test_cnf_file; + } + + # ---------------------------------------------------------------------- + # master sh + # ---------------------------------------------------------------------- + my $master_sh= find_file_in_dirs($tinfo, tdir => "$tname-master.sh"); + if ($master_sh) + { + if ( IS_WIN32PERL ) + { + $tinfo->{'skip'}= 1; + $tinfo->{'comment'}= "No tests with sh scripts on Windows"; + return $tinfo; + } + else + { + $tinfo->{'master_sh'}= $master_sh; + } + } + + # ---------------------------------------------------------------------- + # slave sh + # ---------------------------------------------------------------------- + my $slave_sh= find_file_in_dirs($tinfo, tdir => "$tname-slave.sh"); + if ($slave_sh) + { + if ( IS_WIN32PERL ) + { + $tinfo->{'skip'}= 1; + $tinfo->{'comment'}= "No tests with sh scripts on Windows"; + return $tinfo; + } + else + { + $tinfo->{'slave_sh'}= $slave_sh; + } + } + + my ($master_opts, $slave_opts)= tags_from_test_file($tinfo); + $tinfo->{in_overlay} = 1 if $file_in_overlay{$filename}; + + if ( $tinfo->{'big_test'} and ! $::opt_big_test ) + { + $tinfo->{'skip'}= 1; + $tinfo->{'comment'}= "Test needs --big-test"; + return $tinfo + } + + if ( $tinfo->{'big_test'} ) + { + # All 'big_test' takes a long time to run + $tinfo->{'long_test'}= 1; + } + + if ( ! $tinfo->{'big_test'} and $::opt_big_test > 1 ) + { + $tinfo->{'skip'}= 1; + $tinfo->{'comment'}= "Small test"; + return $tinfo + } + + if ( $tinfo->{'rpl_test'} ) + { + if ( $skip_rpl ) + { + $tinfo->{'skip'}= 1; + $tinfo->{'comment'}= "No replication tests"; + return $tinfo; + } + } + + # ---------------------------------------------------------------------- + # Find config file to use if not already selected in <testname>.opt file + # ---------------------------------------------------------------------- + if (not $tinfo->{template_path} ) + { + my $config= find_file_in_dirs($tinfo, dir => 'my.cnf'); + if (not $config) + { + # Suite has no config, autodetect which one to use + if ($tinfo->{rpl_test}) { + $config= "suite/rpl/my.cnf"; + } else { + $config= "include/default_my.cnf"; + } + } + $tinfo->{template_path}= $config; + } + + # ---------------------------------------------------------------------- + # Append mysqld extra options to master and slave, as appropriate + # ---------------------------------------------------------------------- + push @{$tinfo->{'master_opt'}}, @$master_opts, @::opt_extra_mysqld_opt; + push @{$tinfo->{'slave_opt'}}, @$slave_opts, @::opt_extra_mysqld_opt; + + process_opts($tinfo, 'master_opt'); + process_opts($tinfo, 'slave_opt'); + + my @cases = ($tinfo); + for my $comb ($suite->{combinations}, @{$file_combinations{$filename}}) + { + @cases = map make_combinations($_, \%test_combs, @{$comb}), @cases; + } + my @no_combs = grep { $test_combs{$_} == 1 } keys %test_combs; + if (@no_combs) { + mtr_error("Could not run $name with '".( + join(',', sort @no_combs))."' combination(s)"); + } + + for $tinfo (@cases) { + # + # Now we find a result file for every test file. It's a bit complicated. + # For a test foobar.test in the combination pair {aa,bb}, and in the + # overlay "rty" to the suite "qwe", in other words, for the + # that that mtr prints as + # ... + # qwe-rty.foobar 'aa,bb' [ pass ] + # ... + # the result can be expected in + # * either .rdiff or .result file + # * either in the overlay or in the original suite + # * with or without combinations in the file name. + # which means any of the following 15 file names can be used: + # + # 1 rty/r/foo,aa,bb.result + # 2 rty/r/foo,aa,bb.rdiff + # 3 qwe/r/foo,aa,bb.result + # 4 qwe/r/foo,aa,bb.rdiff + # 5 rty/r/foo,aa.result + # 6 rty/r/foo,aa.rdiff + # 7 qwe/r/foo,aa.result + # 8 qwe/r/foo,aa.rdiff + # 9 rty/r/foo,bb.result + # 10 rty/r/foo,bb.rdiff + # 11 qwe/r/foo,bb.result + # 12 qwe/r/foo,bb.rdiff + # 13 rty/r/foo.result + # 14 rty/r/foo.rdiff + # 15 qwe/r/foo.result + # + # They are listed, precisely, in the order of preference. + # mtr will walk that list from top to bottom and the first file that + # is found will be used. + # + # If this found file is a .rdiff, mtr continues walking down the list + # until the first .result file is found. + # A .rdiff is applied to that .result. + # + my $re =''; + + if ($tinfo->{combinations}) { + $re = '(?:' . join('|', @{$tinfo->{combinations}}) . ')'; + } + my $resdirglob = $suite->{rdir}; + $resdirglob.= ',' . $suite->{parent}->{rdir} if $suite->{parent}; + + my %files; + for (<{$resdirglob}/$tname*.{rdiff,result}>) { + my ($path, $combs, $ext) = + m@^(.*)/$tname((?:,$re)*)\.(rdiff|result)$@ or next; + my @combs = sort split /,/, $combs; + $files{$_} = join '~', ( # sort files by + 99 - scalar(@combs), # number of combinations DESC + join(',', sort @combs), # combination names ASC + $path eq $suite->{rdir} ? 1 : 2, # overlay first + $ext eq 'result' ? 1 : 2 # result before rdiff + ); + } + my @results = sort { $files{$a} cmp $files{$b} } keys %files; + + if (@results) { + my $result_file = shift @results; + $tinfo->{result_file} = $result_file; + + if ($result_file =~ /\.rdiff$/) { + shift @results while $results[0] =~ /\.rdiff$/; + mtr_error ("$result_file has no corresponding .result file") + unless @results; + $tinfo->{base_result} = $results[0]; + + if (not $::exe_patch) { + $tinfo->{skip} = 1; + $tinfo->{comment} = "requires patch executable"; + } + } + } else { + # No .result file exist + # Remember the path where it should be + # saved in case of --record + $tinfo->{record_file}= $suite->{rdir} . "/$tname.result"; + } + } + + return @cases; +} + + +my $tags_map= {'big_test' => ['big_test', 1], + 'master-slave' => ['rpl_test', 1], + 'long_test' => ['long_test', 1], +}; +my $tags_regex_string= join('|', keys %$tags_map); +my $tags_regex= qr:include/($tags_regex_string)\.inc:o; + +# Get various tags from a file, recursively scanning also included files. +# And get options from .opt file, also recursively for included files. +# Return a list of [TAG_TO_SET, VALUE_TO_SET_TO] of found tags. +# Also returns lists of options for master and slave found in .opt files. +# Each include file is scanned only once, and subsequent calls just look up the +# cached result. +# We need to be a bit careful about speed here; previous version of this code +# took forever to scan the full test suite. +sub get_tags_from_file($$) { + my ($file, $suite)= @_; + + return @{$file_to_tags{$file}} if exists $file_to_tags{$file}; + + my $F= IO::File->new($file) + or mtr_error("can't open file \"$file\": $!"); + + my $tags= []; + my $master_opts= []; + my $slave_opts= []; + my @combinations; + + my $over = defined $suite->{parent}; + my $sdir = $suite->{dir}; + my $pdir = $suite->{parent}->{dir} if $over; + my $in_overlay = 0; + my $suffix = $file; + my @prefix = (''); + + # to be able to look up all auxillary files in the overlay + # we split the file path in a prefix and a suffix + if ($file =~ m@^$sdir/(.*)$@) { + $suffix = $1; + @prefix = ("$sdir/"); + push @prefix, "$pdir/" if $over; + $in_overlay = $over; + } elsif ($over and $file =~ m@^$pdir/(.*)$@) { + $suffix = $1; + @prefix = map { "$_/" } $sdir, $pdir; + } else { + $over = 0; # file neither in $sdir nor in $pdir + } + + while (my $line= <$F>) + { + # Ignore comments. + next if $line =~ /^\#/; + + # Add any tag we find. + if ($line =~ /$tags_regex/o) + { + my $to_set= $tags_map->{$1}; + for (my $i= 0; $i < @$to_set; $i+= 2) + { + push @$tags, [$to_set->[$i], $to_set->[$i+1]]; + } + } + + # Check for a sourced include file. + if ($line =~ /^[[:space:]]*(--)?[[:space:]]*source[[:space:]]+([^;[:space:]]+)/) + { + my $include= $2; + # The rules below must match open_file() function of mysqltest.cc + # Note that for the purpose of tag collection we ignore + # non-existing files, and let mysqltest handle the error + # (e.g. mysqltest.test needs this) + for ((map { dirname("$_$suffix") } @prefix), + $sdir, $pdir, $::glob_mysql_test_dir) + { + next unless defined $_; + my $sourced_file = "$_/$include"; + next if $sourced_file eq $file; + if (-e $sourced_file) + { + push @$tags, get_tags_from_file($sourced_file, $suite); + push @$master_opts, @{$file_to_master_opts{$sourced_file}}; + push @$slave_opts, @{$file_to_slave_opts{$sourced_file}}; + push @combinations, @{$file_combinations{$sourced_file}}; + $file_in_overlay{$file} ||= $file_in_overlay{$sourced_file}; + last; + } + } + } + } + + # Add options from main file _after_ those of any includes; this allows a + # test file to override options set by includes (eg. rpl.rpl_ddl uses this + # to enable innodb, then disable innodb in the slave. + $suffix =~ s/\.\w+$//; + + for (qw(.opt -master.opt -slave.opt)) { + my @res; + push @res, opts_from_file("$prefix[1]$suffix$_") if $over; + if (-f "$prefix[0]$suffix$_") { + $in_overlay = $over; + push @res, opts_from_file("$prefix[0]$suffix$_"); + } + push @$master_opts, @res unless /slave/; + push @$slave_opts, @res unless /master/; + } + + # for combinations we need to make sure that its suite object is loaded, + # even if this file does not belong to a current suite! + my $comb_file = "$suffix.combinations"; + $suite = load_suite_object(suite_for_file($comb_file)) if $prefix[0] eq ''; + my @comb; + unless ($suite->{skip}) { + my $from = "$prefix[0]$comb_file"; + @comb = combinations_from_file($over, $from); + push @comb, + grep { not $skip_combinations{"$from => $_->{name}"} } + combinations_from_file(undef, "$prefix[1]$comb_file") if $over; + } + push @combinations, [ @comb ]; + + # Save results so we can reuse without parsing if seen again. + $file_to_tags{$file}= $tags; + $file_to_master_opts{$file}= $master_opts; + $file_to_slave_opts{$file}= $slave_opts; + $file_combinations{$file}= [ ::uniq(@combinations) ]; + $file_in_overlay{$file} = 1 if $in_overlay; + + return @{$tags}; +} + +sub tags_from_test_file { + my ($tinfo)= @_; + my $file = $tinfo->{path}; + + # a suite may generate tests that don't map to real *.test files + # see unit suite for an example. + return ([], []) unless -f $file; + + for (get_tags_from_file($file, $tinfo->{suite})) + { + $tinfo->{$_->[0]}= $_->[1]; + } + return ($file_to_master_opts{$file}, $file_to_slave_opts{$file}); +} + +sub unspace { + my $string= shift; + my $quote= shift; + $string =~ s/[ \t]/\x11/g; + return "$quote$string$quote"; +} + + +sub opts_from_file ($) { + my $file= shift; + local $_; + + return () unless -f $file; + + open(FILE, '<', $file) or mtr_error("can't open file \"$file\": $!"); + my @args; + while ( <FILE> ) + { + chomp; + + # --init_connect=set @a='a\\0c' + s/^\s+//; # Remove leading space + s/\s+$//; # Remove ending space + + # This is strange, but we need to fill whitespace inside + # quotes with something, to remove later. We do this to + # be able to split on space. Else, we have trouble with + # options like + # + # --someopt="--insideopt1 --insideopt2" + # + # But still with this, we are not 100% sure it is right, + # we need a shell to do it right. + + s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge; + s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge; + s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge; + s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge; + + foreach my $arg (split(/[ \t]+/)) + { + $arg =~ tr/\x11\x0a\x0b/ \'\"/; # Put back real chars + # The outermost quotes has to go + $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/ + or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/; + $arg =~ s/\\\\/\\/g; + + # Do not pass empty string since my_getopt is not capable to handle it. + if (length($arg)) { + push(@args, $arg); + } + } + } + close FILE; + return @args; +} + +1; + |