<commit_before># -*- cperl -*-
# Copyright (C) 2005-2006 MySQL 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-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.

package mtr_cases;
use strict;

use base qw(Exporter);
our @EXPORT= qw(collect_option collect_test_cases);

use mtr_report;
use mtr_match;

# Options used for the collect phase
our $start_from;
our $print_testcases;
our $skip_rpl;
our $do_test;
our $skip_test;
our $skip_combinations;
our $binlog_format;
our $enable_disabled;
our $default_storage_engine;
our $opt_with_ndbcluster_only;
our $defaults_file;
our $quick_collect;

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;

require "mtr_misc.pl";

# Precompiled regex's for tests to do or skip
my $do_test_reg;
my $skip_test_reg;

# If "Quick collect", set to 1 once a test to run has been found.
my $some_test_found;

my $default_suite_object = do 'My/Suite.pm';

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_verbose("$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 $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");

  # If not reordering, we also shouldn't group by suites, unless
  # no test cases were named.
  # This also effects some logic in the loop following this.
  if ($opt_reorder or !@$opt_cases)
  {
    foreach my $suite (split(",", $suites))
    {
      push(@$cases, collect_one_suite($suite, $opt_cases));
      last if $some_test_found;
    }
  }

  if ( @$opt_cases )
  {
    # A list of tests was specified on the command line
    # 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 )
      {
	last unless $opt_reorder;
	# test->{name} is always in suite.name format
	if ( $test->{name} =~ /.*\.$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_one_suite($sname, [ $tname ]);
	if (@this_case)
        {
	  push (@$cases, @this_case);
	}
	else
	{
	  mtr_error("Could not find '$tname' in '$sname' suite");
        }
      }
    }
  }

  if ( $opt_reorder && !$quick_collect)
  {
    # 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, etc.
    foreach my $tinfo (@$cases)
    {
      my @criteria = ();

      #
      # Append the criteria for sorting, in order of importance.
      #
      push(@criteria, "ndb=" . ($tinfo->{'ndb_test'} ? "A" : "B"));
      # Group test with equal options together.
      # Ending with "~" makes empty sort later than filled
      my $opts= $tinfo->{'master_opt'} ? $tinfo->{'master_opt'} : [];
      push(@criteria, join("!", sort @{$opts}) . "~");

      $sort_criteria{$tinfo->fullname()} = join(" ", @criteria);
    }

    @$cases = sort {
      $sort_criteria{$a->fullname()} . $a->fullname() cmp
	$sort_criteria{$b->fullname()} . $b->fullname() } @$cases;

    # For debugging the sort-order
    # foreach my $tinfo (@$cases)
    # {
    #   print $sort_criteria{$tinfo->fullname()}," -> \t",$tinfo->fullname(),"\n";
    # }

  }

  if (defined $print_testcases){
    print_testcases(@$cases);
    exit(1);
  }

  return $cases;

}


# 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 ($parts[1] eq "test")
    {
      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 $opt_cases= shift;
  my @cases; # Array of hash

  mtr_verbose("Collecting: $suite");

  my $suitedir= "$::glob_mysql_test_dir"; # Default
  if ( $suite ne "main" )
  {
    # Allow suite to be path to "some dir" if $suite has at least
    # one directory part
    if ( -d $suite and splitdir($suite) > 1 ){
      $suitedir= $suite;
      mtr_report(" - from '$suitedir'");

    }
    else
    {
      $suitedir= my_find_dir($::basedir,
			     ["mysql-test/suite",
			      "mysql-test",
			      "share/mysql-test/suite",
			      "share/mysql-test",
			      "share/mysql/mysql-test/suite",
			      "share/mysql/mysql-test",
			      # Look in storage engine specific suite dirs
			      "storage/*/mysql-test-suites"
			     ],
			     [$suite]);
    }
    mtr_verbose("suitedir: $suitedir");
  }

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

  # Check if t/ exists
  if (-d $testdir){
    # t/ exists

    if ( -d $resdir )
    {
      # r/exists
    }
    else
    {
      # No r/, use t/ as result dir
      $resdir= $testdir;
    }

  }
  else {
    # No t/ dir => there can' be any r/ dir
    mtr_error("Can't have r/ dir without t/") if -d $resdir;

    # No t/ or r/ => use suitedir
    $resdir= $testdir= $suitedir;
  }

  mtr_verbose("testdir: $testdir");
  mtr_verbose("resdir: $resdir");

  #
  # Load the Suite object
  #
  unless ($::suites{$suite}) {
    if (-f "$suitedir/suite.pm") {
      $::suites{$suite} = do "$suitedir/suite.pm";
    } else {
      $::suites{$suite} = $default_suite_object;
    }
  }

  # ----------------------------------------------------------------------
  # 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_opts= [ opts_from_file("$testdir/suite.opt") ];
  $suite_opts = [ opts_from_file("$suitedir/suite.opt") ] unless @$suite_opts;

  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);

      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;
        }
      }
      else
      {
	# No extension was specified, use default
	$extension= "test";
	my $full_name= "$testdir/$tname.$extension";

	# Test not found here, could exist in other suite
	next if ( ! -f $full_name );
      }

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

    foreach my $elem ( sort readdir(TESTDIR) )
    {
      my $tname= mtr_match_extension($elem, 'test');

      next unless defined $tname;

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

      push(@cases,
	   collect_one_test_case($suitedir,
				 $testdir,
				 $resdir,
				 $suite,
				 $tname,
				 $elem,
				 \%disabled,
				 $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 ( ! $skip_combinations && ! $quick_collect )
  {
    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 %env_filter = map { $_ => 1 } split /:/, $ENV{"\U${suite}_COMBINATIONS"};
      my $config= My::Config->new($combination_file);
      foreach my $group ($config->groups()) {
	my $comb= {};
	$comb->{name}= $group->name();
        next if %env_filter and not $env_filter{$comb->{name}};
        foreach my $option ( $group->options() ) {
	  push(@{$comb->{comb_opt}}, $option->option());
	}
	push(@combinations, $comb) if $comb->{comb_opt};
      }
    }

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

      my @new_cases;
      foreach my $comb (@combinations)
      {
	foreach my $test (@cases)
	{

	  next if ( $test->{'skip'} );

	  # Skip this combination if the values it provides
	  # already are set in master_opt or slave_opt
	  if (My::Options::is_set($test->{master_opt}, $comb->{comb_opt}) &&
	      My::Options::is_set($test->{slave_opt}, $comb->{comb_opt}) ){
	    next;
	  }

	  # Copy test options
	  my $new_test= My::Test->new();
	  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 short name
	  $new_test->{combination}= $comb->{name};

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

      # Add the plain test if it was not already added
      # as part of a combination
      my %added;
      foreach my $new_test (@new_cases){
	$added{$new_test->{name}}= 1;
      }
      foreach my $test (@cases){
	push(@new_cases, $test) unless $added{$test->{name}};
      }


      #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)= @_;

  my @new_cases= ();

  foreach my $tinfo ( @$cases )
  {
    push @new_cases, $tinfo;

    # 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 "binlog_format: $binlog_format\n";
    if (not defined $binlog_format )
    {
      # =======================================================
      # 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'";
          # This test was added as a replication combination, but it is not
          # actually ever possible to run it, as it is not made for this
          # combination.
          # So delete it from the list, rather than confuse the user with a
          # message that this test is skipped (it is not really, just run
          # with other combinations).
          pop(@new_cases);
	  next;
	}
      }
    }

    # =======================================================
    # Check that engine selected by
    # --default-storage-engine=<engine> is supported
    # =======================================================
    my %builtin_engines = ('myisam' => 1, 'memory' => 1);

    foreach my $opt ( @{$tinfo->{master_opt}} ) {
      my $default_engine=
	mtr_match_prefix($opt, "--default-storage-engine=");

      if (defined $default_engine){

	#print " $tinfo->{name}\n";
	#print " - The test asked to use '$default_engine'\n";

	#my $engine_value= $::mysqld_variables{$default_engine};
	#print " - The mysqld_variables says '$engine_value'\n";

	if ( ! exists $::mysqld_variables{$default_engine} and
	     ! exists $builtin_engines{$default_engine} )
	{
	  $tinfo->{'skip'}= 1;
	  $tinfo->{'comment'}=
	    "'$default_engine' not supported";
	}

	$tinfo->{'ndb_test'}= 1
	  if ( $default_engine =~ /^ndb/i );
      }
    }

    if ($quick_collect && ! $tinfo->{'skip'})
    {
      $some_test_found= 1;
      return;
    }
  }
  @$cases= @new_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} = [];

  my @plugins;
  my %seen;

  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;
    }

    $value= mtr_match_prefix($opt, "--plugin-load=");
    if (defined $value)
    {
      push @plugins, $value unless $seen{$value};
      $seen{$value}=1;
      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;
    }

    $value= mtr_match_prefix($opt, "--config-file-template=");
    if ( defined $value)
    {
      # Specifies the configuration file to use for this test
      $tinfo->{'template_path'}= dirname($tinfo->{path})."/$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
    }

    # 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->{$opt_name}}, $opt);
  }

  if (@plugins) {
    my $sep = (IS_WIN32PERL) ? ';' : ':';
    push @{$tinfo->{$opt_name}}, "--plugin-load=" .  join($sep, @plugins);
  }
}<commit_msg>make the check for windows to work in cygnin perl too<commit_after># -*- cperl -*-
# Copyright (C) 2005-2006 MySQL 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-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.

package mtr_cases;
use strict;

use base qw(Exporter);
our @EXPORT= qw(collect_option collect_test_cases);

use mtr_report;
use mtr_match;

# Options used for the collect phase
our $start_from;
our $print_testcases;
our $skip_rpl;
our $do_test;
our $skip_test;
our $skip_combinations;
our $binlog_format;
our $enable_disabled;
our $default_storage_engine;
our $opt_with_ndbcluster_only;
our $defaults_file;
our $quick_collect;

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;

require "mtr_misc.pl";

# Precompiled regex's for tests to do or skip
my $do_test_reg;
my $skip_test_reg;

# If "Quick collect", set to 1 once a test to run has been found.
my $some_test_found;

my $default_suite_object = do 'My/Suite.pm';

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_verbose("$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 $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");

  # If not reordering, we also shouldn't group by suites, unless
  # no test cases were named.
  # This also effects some logic in the loop following this.
  if ($opt_reorder or !@$opt_cases)
  {
    foreach my $suite (split(",", $suites))
    {
      push(@$cases, collect_one_suite($suite, $opt_cases));
      last if $some_test_found;
    }
  }

  if ( @$opt_cases )
  {
    # A list of tests was specified on the command line
    # 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 )
      {
	last unless $opt_reorder;
	# test->{name} is always in suite.name format
	if ( $test->{name} =~ /.*\.$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_one_suite($sname, [ $tname ]);
	if (@this_case)
        {
	  push (@$cases, @this_case);
	}
	else
	{
	  mtr_error("Could not find '$tname' in '$sname' suite");
        }
      }
    }
  }

  if ( $opt_reorder && !$quick_collect)
  {
    # 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, etc.
    foreach my $tinfo (@$cases)
    {
      my @criteria = ();

      #
      # Append the criteria for sorting, in order of importance.
      #
      push(@criteria, "ndb=" . ($tinfo->{'ndb_test'} ? "A" : "B"));
      # Group test with equal options together.
      # Ending with "~" makes empty sort later than filled
      my $opts= $tinfo->{'master_opt'} ? $tinfo->{'master_opt'} : [];
      push(@criteria, join("!", sort @{$opts}) . "~");

      $sort_criteria{$tinfo->fullname()} = join(" ", @criteria);
    }

    @$cases = sort {
      $sort_criteria{$a->fullname()} . $a->fullname() cmp
	$sort_criteria{$b->fullname()} . $b->fullname() } @$cases;

    # For debugging the sort-order
    # foreach my $tinfo (@$cases)
    # {
    #   print $sort_criteria{$tinfo->fullname()}," -> \t",$tinfo->fullname(),"\n";
    # }

  }

  if (defined $print_testcases){
    print_testcases(@$cases);
    exit(1);
  }

  return $cases;

}


# 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 ($parts[1] eq "test")
    {
      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 $opt_cases= shift;
  my @cases; # Array of hash

  mtr_verbose("Collecting: $suite");

  my $suitedir= "$::glob_mysql_test_dir"; # Default
  if ( $suite ne "main" )
  {
    # Allow suite to be path to "some dir" if $suite has at least
    # one directory part
    if ( -d $suite and splitdir($suite) > 1 ){
      $suitedir= $suite;
      mtr_report(" - from '$suitedir'");

    }
    else
    {
      $suitedir= my_find_dir($::basedir,
			     ["mysql-test/suite",
			      "mysql-test",
			      "share/mysql-test/suite",
			      "share/mysql-test",
			      "share/mysql/mysql-test/suite",
			      "share/mysql/mysql-test",
			      # Look in storage engine specific suite dirs
			      "storage/*/mysql-test-suites"
			     ],
			     [$suite]);
    }
    mtr_verbose("suitedir: $suitedir");
  }

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

  # Check if t/ exists
  if (-d $testdir){
    # t/ exists

    if ( -d $resdir )
    {
      # r/exists
    }
    else
    {
      # No r/, use t/ as result dir
      $resdir= $testdir;
    }

  }
  else {
    # No t/ dir => there can' be any r/ dir
    mtr_error("Can't have r/ dir without t/") if -d $resdir;

    # No t/ or r/ => use suitedir
    $resdir= $testdir= $suitedir;
  }

  mtr_verbose("testdir: $testdir");
  mtr_verbose("resdir: $resdir");

  #
  # Load the Suite object
  #
  unless ($::suites{$suite}) {
    if (-f "$suitedir/suite.pm") {
      $::suites{$suite} = do "$suitedir/suite.pm";
    } else {
      $::suites{$suite} = $default_suite_object;
    }
  }

  # ----------------------------------------------------------------------
  # 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_opts= [ opts_from_file("$testdir/suite.opt") ];
  $suite_opts = [ opts_from_file("$suitedir/suite.opt") ] unless @$suite_opts;

  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);

      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;
        }
      }
      else
      {
	# No extension was specified, use default
	$extension= "test";
	my $full_name= "$testdir/$tname.$extension";

	# Test not found here, could exist in other suite
	next if ( ! -f $full_name );
      }

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

    foreach my $elem ( sort readdir(TESTDIR) )
    {
      my $tname= mtr_match_extension($elem, 'test');

      next unless defined $tname;

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

      push(@cases,
	   collect_one_test_case($suitedir,
				 $testdir,
				 $resdir,
				 $suite,
				 $tname,
				 $elem,
				 \%disabled,
				 $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 ( ! $skip_combinations && ! $quick_collect )
  {
    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 %env_filter = map { $_ => 1 } split /:/, $ENV{"\U${suite}_COMBINATIONS"};
      my $config= My::Config->new($combination_file);
      foreach my $group ($config->groups()) {
	my $comb= {};
	$comb->{name}= $group->name();
        next if %env_filter and not $env_filter{$comb->{name}};
        foreach my $option ( $group->options() ) {
	  push(@{$comb->{comb_opt}}, $option->option());
	}
	push(@combinations, $comb) if $comb->{comb_opt};
      }
    }

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

      my @new_cases;
      foreach my $comb (@combinations)
      {
	foreach my $test (@cases)
	{

	  next if ( $test->{'skip'} );

	  # Skip this combination if the values it provides
	  # already are set in master_opt or slave_opt
	  if (My::Options::is_set($test->{master_opt}, $comb->{comb_opt}) &&
	      My::Options::is_set($test->{slave_opt}, $comb->{comb_opt}) ){
	    next;
	  }

	  # Copy test options
	  my $new_test= My::Test->new();
	  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 short name
	  $new_test->{combination}= $comb->{name};

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

      # Add the plain test if it was not already added
      # as part of a combination
      my %added;
      foreach my $new_test (@new_cases){
	$added{$new_test->{name}}= 1;
      }
      foreach my $test (@cases){
	push(@new_cases, $test) unless $added{$test->{name}};
      }


      #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)= @_;

  my @new_cases= ();

  foreach my $tinfo ( @$cases )
  {
    push @new_cases, $tinfo;

    # 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 "binlog_format: $binlog_format\n";
    if (not defined $binlog_format )
    {
      # =======================================================
      # 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'";
          # This test was added as a replication combination, but it is not
          # actually ever possible to run it, as it is not made for this
          # combination.
          # So delete it from the list, rather than confuse the user with a
          # message that this test is skipped (it is not really, just run
          # with other combinations).
          pop(@new_cases);
	  next;
	}
      }
    }

    # =======================================================
    # Check that engine selected by
    # --default-storage-engine=<engine> is supported
    # =======================================================
    my %builtin_engines = ('myisam' => 1, 'memory' => 1);

    foreach my $opt ( @{$tinfo->{master_opt}} ) {
      my $default_engine=
	mtr_match_prefix($opt, "--default-storage-engine=");

      if (defined $default_engine){

	#print " $tinfo->{name}\n";
	#print " - The test asked to use '$default_engine'\n";

	#my $engine_value= $::mysqld_variables{$default_engine};
	#print " - The mysqld_variables says '$engine_value'\n";

	if ( ! exists $::mysqld_variables{$default_engine} and
	     ! exists $builtin_engines{$default_engine} )
	{
	  $tinfo->{'skip'}= 1;
	  $tinfo->{'comment'}=
	    "'$default_engine' not supported";
	}

	$tinfo->{'ndb_test'}= 1
	  if ( $default_engine =~ /^ndb/i );
      }
    }

    if ($quick_collect && ! $tinfo->{'skip'})
    {
      $some_test_found= 1;
      return;
    }
  }
  @$cases= @new_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} = [];

  my @plugins;
  my %seen;

  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;
    }

    $value= mtr_match_prefix($opt, "--plugin-load=");
    if (defined $value)
    {
      push @plugins, $value unless $seen{$value};
      $seen{$value}=1;
      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;
    }

    $value= mtr_match_prefix($opt, "--config-file-template=");
    if ( defined $value)
    {
      # Specifies the configuration file to use for this test
      $tinfo->{'template_path'}= dirname($tinfo->{path})."/$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
    }

    # 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->{$opt_name}}, $opt);
  }

  if (@plugins) {
    my $sep = (IS_WINDOWS) ? ';' : ':';
    push @{$tinfo->{$opt_name}}, "--plugin-load=" .  join($sep, @plugins);
  }
}
{'fraction_non_alphanumeric': 0.18140144073346431, 'fraction_numerical': 0.003001528050643964, 'mean_word_length': 2.6933387080520004, 'pattern_counts': {'":': 2, '<': 7, '<?xml version=': 0, '>': 145, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5080349', 'n_tokens_mistral': 12575, 'n_tokens_neox': 11918, 'n_words': 3496}