Edit File - File Manager

Edit File: mtr_cases.pl

# -*- cperl -*-
# Copyright (c) 2005, 2006 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
# Use is subject to license terms.
# 
# 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-1301  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.

use File::Basename;
use IO::File();
use strict;

use My::Config;

sub collect_test_cases ($);
sub collect_one_suite ($);
sub collect_one_test_case ($$$$$$$$$);

sub mtr_options_from_test_file($$);

my $do_test;
my $skip_test;
my %incompatible;

sub init_pattern {
  my ($from, $what)= @_;
  if ( $from =~ /^[a-z0-9]$/ ) {
    # Does not contain any regex, make the pattern match
    # beginning of string
    $from= "^$from";
  }
  # Check that pattern is a valid regex
  eval { "" =~/$from/; 1 } or
    mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@");
  return $from;
}

sub collect_incomp_tests {
  open (INCOMP, "lib/v1/incompatible.tests");
  while (<INCOMP>)
  {
    next unless /^\w/;
    s/\s.*\n//;		      # Ignore anything from first white space
    $incompatible{$_}= 1;
  }
}

##############################################################################
#
#  Collect information about test cases we are to run
#
##############################################################################

sub collect_test_cases ($) {
  $do_test= init_pattern($::opt_do_test, "--do-test");
  $skip_test= init_pattern($::opt_skip_test, "--skip-test");

collect_incomp_tests();

my $suites= shift; # Semicolon separated list of test suites
  my $cases = [];    # Array of hash

foreach my $suite (split(",", $suites))
  {
    push(@$cases, collect_one_suite($suite));
  }

if ( @::opt_cases )
  {
    # Check that the tests specified was found
    # in at least one suite
    foreach my $test_name_spec ( @::opt_cases )
    {
      my $found= 0;
      my ($sname, $tname, $extension)= split_testname($test_name_spec);
      foreach my $test ( @$cases )
      {
	# test->{name} is always in suite.name format
	if ( $test->{name} =~ /.*\.$tname/ )
	{
	  $found= 1;
	}
      }
      if ( not $found )
      {
	mtr_error("Could not find $tname in any suite");
      }
    }
  }

if ( $::opt_reorder )
  {
    # Reorder the test cases in an order that will make them faster to run
    my %sort_criteria;

# 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, et c.
    foreach my $tinfo (@$cases)
    {
      my @criteria = ();

# Look for tests that muct be in run in a defined order
      # that is defined by test having the same name except for
      # the ending digit

# Put variables into hash
      my $test_name= $tinfo->{'name'};
      my $depend_on_test_name;
      if ( $test_name =~ /^([\D]+)([0-9]{1})$/ )
      {
	my $base_name= $1;
	my $idx= $2;
	mtr_verbose("$test_name =>  $base_name idx=$idx");
	if ( $idx > 1 )
	{
	  $idx-= 1;
	  $base_name= "$base_name$idx";
	  mtr_verbose("New basename $base_name");
	}

foreach my $tinfo2 (@$cases)
	{
	  if ( $tinfo2->{'name'} eq $base_name )
	  {
	    mtr_verbose("found dependent test $tinfo2->{'name'}");
	    $depend_on_test_name=$base_name;
	  }
	}
      }

if ( defined $depend_on_test_name )
      {
	mtr_verbose("Giving $test_name same critera as $depend_on_test_name");
	$sort_criteria{$test_name} = $sort_criteria{$depend_on_test_name};
      }
      else
      {
	#
	# Append the criteria for sorting, in order of importance.
	#
	push(@criteria, "ndb=" . ($tinfo->{'ndb_test'} ? "1" : "0"));
	# Group test with equal options together.
	# Ending with "~" makes empty sort later than filled
	push(@criteria, join("!", sort @{$tinfo->{'master_opt'}}) . "~");

$sort_criteria{$test_name} = join(" ", @criteria);
      }
    }

@$cases = sort {
      $sort_criteria{$a->{'name'}} . $a->{'name'} cmp
	$sort_criteria{$b->{'name'}} . $b->{'name'}; } @$cases;

if ( $::opt_script_debug )
    {
      # For debugging the sort-order
      foreach my $tinfo (@$cases)
      {
	print("$sort_criteria{$tinfo->{'name'}} -> \t$tinfo->{'name'}\n");
      }
    }
  }

return $cases;

}

# Valid extensions and their corresonding component id
my %exts = ( 'test' => 'mysqld',
	     'imtest' => 'im'
	   );

# Returns (suitename, testname, extension)
sub split_testname {
  my ($test_name)= @_;

# Get rid of directory part and split name on .'s
  my @parts= split(/\./, basename($test_name));

if (@parts == 1){
    # Only testname given, ex: alias
    return (undef , $parts[0], undef);
  } elsif (@parts == 2) {
    # Either testname.test or suite.testname given
    # Ex. main.alias or alias.test

if (defined $exts{$parts[1]})
    {
      return (undef , $parts[0], $parts[1]);
    }
    else
    {
      return ($parts[0], $parts[1], undef);
    }

} elsif (@parts == 3) {
    # Fully specified suitename.testname.test
    # ex main.alias.test
    return ( $parts[0], $parts[1], $parts[2]);
  }

mtr_error("Illegal format of test name: $test_name");
}

sub collect_one_suite($)
{
  my $suite= shift;  # Test suite name
  my @cases;  # Array of hash

mtr_verbose("Collecting: $suite");

my $suitedir= "$::glob_mysql_test_dir"; # Default
  if ( $suite ne "main" )
  {
    $suitedir= mtr_path_exists("$suitedir/suite/$suite",
			       "$suitedir/$suite");
    mtr_verbose("suitedir: $suitedir");
  }

my $testdir= "$suitedir/t";
  my $resdir=  "$suitedir/r";

# ----------------------------------------------------------------------
  # Build a hash of disabled testcases for this suite
  # ----------------------------------------------------------------------
  my %disabled;
  if ( open(DISABLED, "$testdir/disabled.def" ) )
  {
    while ( <DISABLED> )
      {
        chomp;
        if ( /^\s*(\S+)\s*:\s*(.*?)\s*$/ )
          {
            $disabled{$1}= $2;
          }
      }
    close DISABLED;
  }

# Read suite.opt file
  my $suite_opt_file=  "$testdir/suite.opt";
  my $suite_opts= [];
  if ( -f $suite_opt_file )
  {
    $suite_opts= mtr_get_opts_from_file($suite_opt_file);
  }

if ( @::opt_cases )
  {
    # Collect in specified order
    foreach my $test_name_spec ( @::opt_cases )
    {
      my ($sname, $tname, $extension)= split_testname($test_name_spec);

# The test name parts have now been defined
      #print "  suite_name: $sname\n";
      #print "  tname:      $tname\n";
      #print "  extension:  $extension\n";

# Check cirrect suite if suitename is defined
      next if (defined $sname and $suite ne $sname);

my $component_id;
      if ( defined $extension )
      {
	my $full_name= "$testdir/$tname.$extension";
	# Extension was specified, check if the test exists
        if ( ! -f $full_name)
        {
	  # This is only an error if suite was specified, otherwise it
	  # could exist in another suite
          mtr_error("Test '$full_name' was not found in suite '$sname'")
	    if $sname;

next;
        }
	$component_id= $exts{$extension};
      }
      else
      {
	# No extension was specified
	my ($ext, $component);
	while (($ext, $component)= each %exts) {
	  my $full_name= "$testdir/$tname.$ext";

if ( ! -f $full_name ) {
	    next;
	  }
	  $component_id= $component;
	  $extension= $ext;
	}
	# Test not found here, could exist in other suite
	next unless $component_id;
      }

collect_one_test_case($testdir,$resdir,$suite,$tname,
                            "$tname.$extension",\@cases,\%disabled,
			    $component_id,$suite_opts);
    }
  }
  else
  {
    opendir(TESTDIR, $testdir) or mtr_error("Can't open dir \"$testdir\": $!");

foreach my $elem ( sort readdir(TESTDIR) )
    {
      my $component_id= undef;
      my $tname= undef;

if ($tname= mtr_match_extension($elem, 'test'))
      {
        $component_id = 'mysqld';
      }
      elsif ($tname= mtr_match_extension($elem, 'imtest'))
      {
        $component_id = 'im';
      }
      else
      {
        next;
      }

# Skip tests that does not match the --do-test= filter
      next if ($do_test and not $tname =~ /$do_test/o);

collect_one_test_case($testdir,$resdir,$suite,$tname,
                            $elem,\@cases,\%disabled,$component_id,
			    $suite_opts);
    }
    closedir TESTDIR;
  }

#  Return empty list if no testcases found
  return if (@cases == 0);

# ----------------------------------------------------------------------
  # Read combinations for this suite and build testcases x combinations
  # if any combinations exists
  # ----------------------------------------------------------------------
  if ( ! $::opt_skip_combination )
  {
    my @combinations;
    my $combination_file= "$suitedir/combinations";
    #print "combination_file: $combination_file\n";
    if (@::opt_combinations)
    {
      # take the combination from command-line
      mtr_verbose("Take the combination from command line");
      foreach my $combination (@::opt_combinations) {
	my $comb= {};
	$comb->{name}= $combination;
	push(@{$comb->{comb_opt}}, $combination);
	push(@combinations, $comb);
      }
    }
    elsif (-f $combination_file )
    {
      # Read combinations file in my.cnf format
      mtr_verbose("Read combinations file");
      my $config= My::Config->new($combination_file);

foreach my $group ($config->groups()) {
	my $comb= {};
	$comb->{name}= $group->name();
        foreach my $option ( $group->options() ) {
	  push(@{$comb->{comb_opt}}, "--".$option->name()."=".$option->value());
	}
	push(@combinations, $comb);
      }
    }

if (@combinations)
    {
      print " - adding combinations\n";
      #print_testcases(@cases);

my @new_cases;
      foreach my $comb (@combinations)
      {
	foreach my $test (@cases)
	{
	  #print $test->{name}, " ", $comb, "\n";
	  my $new_test= {};

while (my ($key, $value) = each(%$test)) {
	    if (ref $value eq "ARRAY") {
	      push(@{$new_test->{$key}}, @$value);
	    } else {
	      $new_test->{$key}= $value;
	    }
	  }

# Append the combination options to master_opt and slave_opt
	  push(@{$new_test->{master_opt}}, @{$comb->{comb_opt}});
	  push(@{$new_test->{slave_opt}}, @{$comb->{comb_opt}});

# Add combination name shrt name
	  $new_test->{combination}= $comb->{name};

# Add the new test to new test cases list
	  push(@new_cases, $new_test);
	}
      }
      #print_testcases(@new_cases);
      @cases= @new_cases;
      #print_testcases(@cases);
    }
  }

optimize_cases(\@cases);
  #print_testcases(@cases);

return @cases;
}

#
# Loop through all test cases
# - optimize which test to run by skipping unnecessary ones
# - update settings if necessary
#
sub optimize_cases {
  my ($cases)= @_;

foreach my $tinfo ( @$cases )
  {
    # Skip processing if already marked as skipped
    next if $tinfo->{skip};

# =======================================================
    # If a special binlog format was selected with
    # --mysqld=--binlog-format=x, skip all test that does not
    # support it
    # =======================================================
    #print "used_binlog_format: $::used_binlog_format\n";
    if (defined $::used_binlog_format )
    {
      # =======================================================
      # Fixed --binlog-format=x specified on command line
      # =======================================================
      if ( defined $tinfo->{'binlog_formats'} )
      {
	#print "binlog_formats: ". join(", ", @{$tinfo->{binlog_formats}})."\n";

# The test supports different binlog formats
	# check if the selected one is ok
	my $supported=
	  grep { $_ eq $::used_binlog_format } @{$tinfo->{'binlog_formats'}};
	if ( !$supported )
	{
	  $tinfo->{'skip'}= 1;
	  $tinfo->{'comment'}=
	    "Doesn't support --binlog-format='$::used_binlog_format'";
	}
      }
    }
    else
    {
      # =======================================================
      # Use dynamic switching of binlog format
      # =======================================================

# Get binlog-format used by this test from master_opt
      my $test_binlog_format;
      foreach my $opt ( @{$tinfo->{master_opt}} ) {
	$test_binlog_format=
	  mtr_match_prefix($opt, "--binlog-format=") || $test_binlog_format;
      }

if (defined $test_binlog_format and
	  defined $tinfo->{binlog_formats} )
      {
	my $supported=
	  grep { $_ eq $test_binlog_format } @{$tinfo->{'binlog_formats'}};
	if ( !$supported )
	{
	  $tinfo->{'skip'}= 1;
	  $tinfo->{'comment'}=
	    "Doesn't support --binlog-format='$test_binlog_format'";
	  next;
	}
      }
    }

}
}

##############################################################################
#
#  Collect information about a single test case
#
##############################################################################

sub collect_one_test_case($$$$$$$$$) {
  my $testdir= shift;
  my $resdir=  shift;
  my $suite=   shift;
  my $tname=   shift;
  my $elem=    shift;
  my $cases=   shift;
  my $disabled=shift;
  my $component_id= shift;
  my $suite_opts= shift;

my $path= "$testdir/$elem";

# ----------------------------------------------------------------------
  # Skip some tests silently
  # ----------------------------------------------------------------------

if ( $::opt_start_from and $tname lt $::opt_start_from )
  {
    return;
  }

my $tinfo= {};
  $tinfo->{'name'}= basename($suite) . ".$tname";
  $tinfo->{'result_file'}= "$resdir/$tname.result";
  $tinfo->{'component_id'} = $component_id;
  push(@$cases, $tinfo);

# Remove "combinations" part of test name
  my $test_base_name= $tinfo->{'name'};
  $test_base_name=~ s/\s.*\n//;

if (exists ($incompatible{$test_base_name}))
  {
    $tinfo->{'skip'}= 1;
    $tinfo->{'comment'}= "Test cannot run in mtr v1";
    return;
  }
  
  # ----------------------------------------------------------------------
  # Skip some tests but include in list, just mark them to skip
  # ----------------------------------------------------------------------

if ( $skip_test and $tname =~ /$skip_test/o )
  {
    $tinfo->{'skip'}= 1;
    return;
  }

# ----------------------------------------------------------------------
  # Collect information about test case
  # ----------------------------------------------------------------------

$tinfo->{'path'}= $path;
  $tinfo->{'timezone'}= "GMT-3"; # for UNIX_TIMESTAMP tests to work

$tinfo->{'slave_num'}= 0; # Default, no slave
  $tinfo->{'master_num'}= 1; # Default, 1 master
  if ( defined mtr_match_prefix($tname,"rpl") )
  {
    if ( $::opt_skip_rpl )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "No replication tests(--skip-rpl)";
      return;
    }

$tinfo->{'slave_num'}= 1; # Default for rpl* tests, use one slave

}

if ( defined mtr_match_prefix($tname,"federated") )
  {
    # Default, federated uses the first slave as it's federated database
    $tinfo->{'slave_num'}= 1;
  }

my $master_opt_file= "$testdir/$tname-master.opt";
  my $slave_opt_file=  "$testdir/$tname-slave.opt";
  my $slave_mi_file=   "$testdir/$tname.slave-mi";
  my $master_sh=       "$testdir/$tname-master.sh";
  my $slave_sh=        "$testdir/$tname-slave.sh";
  my $disabled_file=   "$testdir/$tname.disabled";
  my $im_opt_file=     "$testdir/$tname-im.opt";

$tinfo->{'master_opt'}= [];
  $tinfo->{'slave_opt'}=  [];
  $tinfo->{'slave_mi'}=   [];

# Add suite opts
  foreach my $opt ( @$suite_opts )
  {
    mtr_verbose($opt);
    push(@{$tinfo->{'master_opt'}}, $opt);
    push(@{$tinfo->{'slave_opt'}}, $opt);
  }

# Add master opts
  if ( -f $master_opt_file )
  {

my $master_opt= mtr_get_opts_from_file($master_opt_file);

foreach my $opt ( @$master_opt )
    {
      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;
      }

$value= mtr_match_prefix($opt, "--slave-num=");
      if ( defined $value )
      {
	$tinfo->{'slave_num'}= $value;
	next;
      }

$value= mtr_match_prefix($opt, "--result-file=");
      if ( defined $value )
      {
	# Specifies the file mysqltest should compare
	# output against
	$tinfo->{'result_file'}= "r/$value.result";
	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
      }

# The --restart option forces a restart even if no special
      # option is set. If the options are the same as next testcase
      # there is no need to restart after the testcase
      # has completed
      if ( $opt eq "--force-restart" )
      {
	$tinfo->{'force_restart'}= 1;
	next;
      }

# Ok, this was a real option, add it
      push(@{$tinfo->{'master_opt'}}, $opt);
    }
  }

# Add slave opts
  if ( -f $slave_opt_file )
  {
    my $slave_opt= mtr_get_opts_from_file($slave_opt_file);

foreach my $opt ( @$slave_opt )
    {
      # If we set default time zone, remove the one we have
      my $value= mtr_match_prefix($opt, "--default-time-zone=");
      $tinfo->{'slave_opt'}= [] if defined $value;
    }
    push(@{$tinfo->{'slave_opt'}}, @$slave_opt);
  }

if ( -f $slave_mi_file )
  {
    $tinfo->{'slave_mi'}= mtr_get_opts_from_file($slave_mi_file);
  }

if ( -f $master_sh )
  {
    if ( $::glob_win32_perl )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
      return;
    }
    else
    {
      $tinfo->{'master_sh'}= $master_sh;
    }
  }

if ( -f $slave_sh )
  {
    if ( $::glob_win32_perl )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
      return;
    }
    else
    {
      $tinfo->{'slave_sh'}= $slave_sh;
    }
  }

if ( -f $im_opt_file )
  {
    $tinfo->{'im_opts'} = mtr_get_opts_from_file($im_opt_file);
  }
  else
  {
    $tinfo->{'im_opts'} = [];
  }

# FIXME why this late?
  my $marked_as_disabled= 0;
  if ( $disabled->{$tname} )
  {
    $marked_as_disabled= 1;
    $tinfo->{'comment'}= $disabled->{$tname};
  }

if ( -f $disabled_file )
  {
    $marked_as_disabled= 1;
    $tinfo->{'comment'}= mtr_fromfile($disabled_file);
  }

# If test was marked as disabled, either opt_enable_disabled is off and then
  # we skip this test, or it is on and then we run this test but warn

if ( $marked_as_disabled )
  {
    if ( $::opt_enable_disabled )
    {
      $tinfo->{'dont_skip_though_disabled'}= 1;
    }
    else
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'disable'}= 1;   # Sub type of 'skip'
      return;
    }
  }

if ( $component_id eq 'im' )
  {
    if ( $::glob_use_embedded_server )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "No IM with embedded server";
      return;
    }
    elsif ( $::opt_ps_protocol )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "No IM with --ps-protocol";
      return;
    }
    elsif ( $::opt_skip_im )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "No IM tests(--skip-im)";
      return;
    }
  }
  else
  {
    mtr_options_from_test_file($tinfo,"$testdir/${tname}.test");

if ( defined $::used_default_engine )
    {
      # Different default engine is used
      # tag test to require that engine
      $tinfo->{'ndb_test'}= 1
	if ( $::used_default_engine =~ /^ndb/i );

$tinfo->{'innodb_test'}= 1
	if ( $::used_default_engine =~ /^innodb/i );
    }

#enable federated for this test
    if ($tinfo->{'federated_test'})
    {
      push(@{$tinfo->{'master_opt'}}, "--loose-federated");
      push(@{$tinfo->{'slave_opt'}}, "--loose-federated");
    }

if ( $tinfo->{'big_test'} and ! $::opt_big_test )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "Test need 'big-test' option";
      return;
    }

if ( $tinfo->{'ndb_extra'} and ! $::opt_ndb_extra_test )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "Test need 'ndb_extra' option";
      return;
    }

if ( $tinfo->{'require_manager'} )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "Test need the _old_ manager(to be removed)";
      return;
    }

if ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "Test need debug binaries";
      return;
    }

if ( $tinfo->{'ndb_test'} )
    {
      # This is a NDB test
      if ( ! $::glob_ndbcluster_supported )
      {
	# Ndb is not supported, skip it
	$tinfo->{'skip'}= 1;
	$tinfo->{'comment'}= "No ndbcluster support";
	return;
      }
      elsif ( $::opt_skip_ndbcluster )
      {
	# All ndb test's should be skipped
	$tinfo->{'skip'}= 1;
	$tinfo->{'comment'}= "No ndbcluster tests(--skip-ndbcluster)";
	return;
      }
      # Ndb tests run with two mysqld masters
      $tinfo->{'master_num'}= 2;
    }
    else
    {
      # This is not a ndb test
      if ( $::opt_with_ndbcluster_only )
      {
	# Only the ndb test should be run, all other should be skipped
	$tinfo->{'skip'}= 1;
	$tinfo->{'comment'}= "Only ndbcluster tests(--with-ndbcluster-only)";
	return;
      }
    }

if ( $tinfo->{'innodb_test'} )
    {
      # This is a test that need innodb
      if ( $::mysqld_variables{'innodb'} eq "OFF" )
      {
	# innodb is not supported, skip it
	$tinfo->{'skip'}= 1;
	$tinfo->{'comment'}= "No innodb support";
	return;
      }
    }

if ( $tinfo->{'need_binlog'} )
    {
      if (grep(/^--skip-log-bin/,  @::opt_extra_mysqld_opt) )
      {
	$tinfo->{'skip'}= 1;
	$tinfo->{'comment'}= "Test need binlog";
	return;
      }
    }
    else
    {
      if ( $::mysql_version_id >= 50100 )
      {
	# Test does not need binlog, add --skip-binlog to
	# the options used when starting it
	push(@{$tinfo->{'master_opt'}}, "--skip-log-bin");
      }
    }

}
}

# List of tags in the .test files that if found should set
# the specified value in "tinfo"
our @tags=
(

["include/have_binlog_format_row.inc", "binlog_formats", ["row"]],
 ["include/have_binlog_format_statement.inc", "binlog_formats", ["statement"]],
 ["include/have_binlog_format_mixed.inc", "binlog_formats", ["mixed"]],
 ["include/have_binlog_format_mixed_or_row.inc",
  "binlog_formats", ["mixed", "row"]],
 ["include/have_binlog_format_mixed_or_statement.inc",
  "binlog_formats", ["mixed", "statement"]],
 ["include/have_binlog_format_row_or_statement.inc",
  "binlog_formats", ["row", "statement"]],

["include/have_innodb.inc", "innodb_test", 1],
 ["include/have_log_bin.inc", "need_binlog", 1],
 ["include/big_test.inc", "big_test", 1],
 ["include/have_debug.inc", "need_debug", 1],
 ["include/have_ndb.inc", "ndb_test", 1],
 ["include/have_multi_ndb.inc", "ndb_test", 1],
 ["include/have_ndb_extra.inc", "ndb_extra", 1],
 ["include/ndb_master-slave.inc", "ndb_test", 1],
 ["require_manager", "require_manager", 1],
 ["include/federated.inc", "federated_test", 1],
 ["include/have_federated_db.inc", "federated_test", 1],
);

sub mtr_options_from_test_file($$) {
  my $tinfo= shift;
  my $file= shift;
  #mtr_verbose("$file");
  my $F= IO::File->new($file) or mtr_error("can't open file \"$file\": $!");

while ( my $line= <$F> )
  {

# Skip line if it start's with #
    next if ( $line =~ /^#/ );

# Match this line against tag in "tags" array
    foreach my $tag (@tags)
    {
      if ( index($line, $tag->[0]) >= 0 )
      {
    	  # Tag matched, assign value to "tinfo"
        $tinfo->{"$tag->[1]"}= $tag->[2];
      }
    }

# If test sources another file, open it as well
    if ( $line =~ /^\-\-([[:space:]]*)source(.*)$/ or
	 $line =~ /^([[:space:]]*)source(.*);$/ )
    {
      my $value= $2;
      $value =~ s/^\s+//;  # Remove leading space
      $value =~ s/[[:space:]]+$//;  # Remove ending space

my $sourced_file= "$::glob_mysql_test_dir/$value";
      if ( -f $sourced_file )
      {
	# Only source the file if it exists, we may get
	# false positives in the regexes above if someone
	# writes "source nnnn;" in a test case(such as mysqltest.test)
	mtr_options_from_test_file($tinfo, $sourced_file);
      }
    }
  }
}

sub print_testcases {
  my (@cases)= @_;

print "=" x 60, "\n";
  foreach my $test (@cases){
    print "[", $test->{name}, "]", "\n";
    while ((my ($key, $value)) = each(%$test)) {
      print " ", $key, "=";
      if (ref $value eq "ARRAY") {
	print join(", ", @$value);
      } else {
	print $value;
      }
      print "\n";
    }
    print "\n";
  }
  print "=" x 60, "\n";
}

Back to File Manager