mtr_cases.pm 29.6 KB
Newer Older
unknown's avatar
unknown committed
1
# -*- cperl -*-
unknown's avatar
unknown committed
2
# Copyright (C) 2005-2006 MySQL AB
unknown's avatar
unknown committed
3
#
unknown's avatar
unknown committed
4 5 6
# 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.
unknown's avatar
unknown committed
7
#
unknown's avatar
unknown committed
8 9 10 11
# 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.
unknown's avatar
unknown committed
12
#
unknown's avatar
unknown committed
13 14 15
# 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
unknown's avatar
unknown committed
16 17 18 19 20

# 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.

unknown's avatar
unknown committed
21
package mtr_cases;
unknown's avatar
unknown committed
22 23
use strict;

unknown's avatar
unknown committed
24 25 26
use base qw(Exporter);
our @EXPORT= qw(collect_option collect_test_cases);

27
use mtr_report;
28
use mtr_match;
29

unknown's avatar
unknown committed
30 31 32 33 34 35 36
# Options used for the collect phase
our $start_from;
our $print_testcases;
our $skip_rpl;
our $do_test;
our $skip_test;
our $opt_skip_combination;
37
our $binlog_format;
unknown's avatar
unknown committed
38 39 40 41 42
our $enable_disabled;
our $default_storage_engine;
our $opt_with_ndbcluster_only;
our $defaults_file;
our $defaults_extra_file;
unknown's avatar
unknown committed
43
our $reorder;
unknown's avatar
unknown committed
44 45 46 47 48

sub collect_option {
  my ($opt, $value)= @_;

  # Convert - to _ in option name
unknown's avatar
unknown committed
49
  $opt =~ s/-/_/g;
unknown's avatar
unknown committed
50 51 52
  no strict 'refs';
  ${$opt}= $value;
}
53

unknown's avatar
unknown committed
54
use File::Basename;
55
use File::Spec::Functions qw / splitdir /;
unknown's avatar
unknown committed
56 57
use IO::File();
use My::Config;
unknown's avatar
unknown committed
58
use My::Platform;
59
use My::Find;
unknown's avatar
unknown committed
60

unknown's avatar
unknown committed
61
require "mtr_misc.pl";
unknown's avatar
unknown committed
62

unknown's avatar
unknown committed
63 64 65
# Precompiled regex's for tests to do or skip
my $do_test_reg;
my $skip_test_reg;
66 67 68

sub init_pattern {
  my ($from, $what)= @_;
unknown's avatar
unknown committed
69 70 71 72
  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
73 74
    # beginning of string
    $from= "^$from";
unknown's avatar
unknown committed
75
    mtr_verbose("$what='$from'");
76
  }
unknown's avatar
unknown committed
77 78 79
  # Check that pattern is a valid regex
  eval { "" =~/$from/; 1 } or
    mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@");
80 81 82 83
  return $from;
}


unknown's avatar
unknown committed
84 85
##############################################################################
#
unknown's avatar
unknown committed
86
#  Collect information about test cases to be run
unknown's avatar
unknown committed
87 88 89
#
##############################################################################

90
sub collect_test_cases ($$) {
91
  my $suites= shift; # Semicolon separated list of test suites
92
  my $opt_cases= shift;
unknown's avatar
unknown committed
93 94 95 96
  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");
97 98 99

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

103
  if ( @$opt_cases )
104
  {
unknown's avatar
unknown committed
105
    # A list of tests was specified on the command line
106 107
    # Check that the tests specified was found
    # in at least one suite
108
    foreach my $test_name_spec ( @$opt_cases )
109 110
    {
      my $found= 0;
111
      my ($sname, $tname, $extension)= split_testname($test_name_spec);
112 113
      foreach my $test ( @$cases )
      {
114 115
	# test->{name} is always in suite.name format
	if ( $test->{name} =~ /.*\.$tname/ )
116 117 118 119 120 121 122 123 124 125 126
	{
	  $found= 1;
	}
      }
      if ( not $found )
      {
	mtr_error("Could not find $tname in any suite");
      }
    }
  }

unknown's avatar
unknown committed
127
  if ( $reorder )
128 129 130 131 132 133
  {
    # 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
unknown's avatar
unknown committed
134
    # first, then a sub-criterion, then sub-sub-criterion, etc.
135 136 137 138
    foreach my $tinfo (@$cases)
    {
      my @criteria = ();

unknown's avatar
unknown committed
139 140
      # Look for tests that must be run in a defined order - that is
      # defined by test having the same name except for the ending digit
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179

      # 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
unknown's avatar
unknown committed
180 181
	my $opts= $tinfo->{'master_opt'} ? $tinfo->{'master_opt'} : [];
	push(@criteria, join("!", sort @{$opts}) . "~");
182 183 184 185 186 187 188 189 190

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

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

unknown's avatar
unknown committed
191 192 193 194 195 196 197 198 199 200 201
    # For debugging the sort-order
    # foreach my $tinfo (@$cases)
    # {
    #   print("$sort_criteria{$tinfo->{'name'}} -> \t$tinfo->{'name'}\n");
    # }

  }

  if (defined $print_testcases){
    print_testcases(@$cases);
    exit(1);
202 203 204 205 206 207
  }

  return $cases;

}

208 209 210 211 212 213 214 215 216 217 218 219 220 221 222

# 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

unknown's avatar
unknown committed
223
    if ($parts[1] eq "test")
224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
    {
      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");
}


242
sub collect_one_suite($)
243 244
{
  my $suite= shift;  # Test suite name
245
  my $opt_cases= shift;
unknown's avatar
unknown committed
246
  my @cases; # Array of hash
247 248

  mtr_verbose("Collecting: $suite");
unknown's avatar
unknown committed
249

250 251
  my $suitedir= "$::glob_mysql_test_dir"; # Default
  if ( $suite ne "main" )
unknown's avatar
unknown committed
252
  {
253 254 255
    # Allow suite to be path to "some dir" if $suite has at least
    # one directory part
    if ( -d $suite and splitdir($suite) > 1 ){
256
      $suitedir= $suite;
257 258
      mtr_report(" - from '$suitedir'");

259 260 261 262 263 264 265 266 267 268 269
    }
    else
    {
      $suitedir= my_find_dir($::basedir,
			     ["mysql-test/suite",
			      "mysql-test",
			      # Look in storage engine specific suite dirs
			      "storage/*/mysql-test-suites"
			     ],
			     [$suite]);
    }
270
    mtr_verbose("suitedir: $suitedir");
unknown's avatar
unknown committed
271 272
  }

273 274 275
  my $testdir= "$suitedir/t";
  my $resdir=  "$suitedir/r";

unknown's avatar
unknown committed
276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301
  # 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");

unknown's avatar
unknown committed
302
  # ----------------------------------------------------------------------
303
  # Build a hash of disabled testcases for this suite
unknown's avatar
unknown committed
304 305 306 307 308 309 310 311 312 313 314 315 316 317 318
  # ----------------------------------------------------------------------
  my %disabled;
  if ( open(DISABLED, "$testdir/disabled.def" ) )
  {
    while ( <DISABLED> )
      {
        chomp;
        if ( /^\s*(\S+)\s*:\s*(.*?)\s*$/ )
          {
            $disabled{$1}= $2;
          }
      }
    close DISABLED;
  }

319 320 321 322 323
  # Read suite.opt file
  my $suite_opt_file=  "$testdir/suite.opt";
  my $suite_opts= [];
  if ( -f $suite_opt_file )
  {
unknown's avatar
unknown committed
324
    $suite_opts= opts_from_file($suite_opt_file);
325 326
  }

327
  if ( @$opt_cases )
unknown's avatar
unknown committed
328
  {
329
    # Collect in specified order
330
    foreach my $test_name_spec ( @$opt_cases )
331
    {
332
      my ($sname, $tname, $extension)= split_testname($test_name_spec);
unknown's avatar
unknown committed
333

334 335 336 337
      # The test name parts have now been defined
      #print "  suite_name: $sname\n";
      #print "  tname:      $tname\n";
      #print "  extension:  $extension\n";
unknown's avatar
unknown committed
338

339 340
      # Check cirrect suite if suitename is defined
      next if (defined $sname and $suite ne $sname);
unknown's avatar
unknown committed
341

342
      if ( defined $extension )
unknown's avatar
unknown committed
343
      {
344 345 346
	my $full_name= "$testdir/$tname.$extension";
	# Extension was specified, check if the test exists
        if ( ! -f $full_name)
unknown's avatar
unknown committed
347
        {
348 349 350 351 352 353
	  # 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;
unknown's avatar
unknown committed
354 355 356
        }
      }
      else
unknown's avatar
unknown committed
357
      {
unknown's avatar
unknown committed
358 359 360
	# No extension was specified, use default
	$extension= "test";
	my $full_name= "$testdir/$tname.$extension";
unknown's avatar
unknown committed
361

362
	# Test not found here, could exist in other suite
unknown's avatar
unknown committed
363
	next if ( ! -f $full_name );
unknown's avatar
unknown committed
364
      }
unknown's avatar
unknown committed
365

unknown's avatar
unknown committed
366 367 368 369 370 371 372 373 374
      push(@cases,
	   collect_one_test_case($suitedir,
				 $testdir,
				 $resdir,
				 $suite,
				 $tname,
				 "$tname.$extension",
				 \%disabled,
				 $suite_opts));
unknown's avatar
unknown committed
375 376 377 378
    }
  }
  else
  {
379 380
    opendir(TESTDIR, $testdir) or mtr_error("Can't open dir \"$testdir\": $!");

381 382
    foreach my $elem ( sort readdir(TESTDIR) )
    {
unknown's avatar
unknown committed
383
      my $tname= mtr_match_extension($elem, 'test');
unknown's avatar
unknown committed
384

unknown's avatar
unknown committed
385
      next unless defined $tname;
386

387
      # Skip tests that does not match the --do-test= filter
unknown's avatar
unknown committed
388 389 390 391 392 393 394 395 396 397 398
      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));
unknown's avatar
unknown committed
399 400 401 402
    }
    closedir TESTDIR;
  }

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

406
  # ----------------------------------------------------------------------
407 408
  # Read combinations for this suite and build testcases x combinations
  # if any combinations exists
409
  # ----------------------------------------------------------------------
unknown's avatar
unknown committed
410
  if ( ! $opt_skip_combination )
411 412 413 414 415
  {
    my @combinations;
    my $combination_file= "$suitedir/combinations";
    #print "combination_file: $combination_file\n";
    if (@::opt_combinations)
416
    {
417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437
      # 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);
438 439
      }
    }
440 441 442

    if (@combinations)
    {
443
      print " - adding combinations for $suite\n";
444 445 446 447
      #print_testcases(@cases);

      my @new_cases;
      foreach my $comb (@combinations)
448
      {
449 450 451
	foreach my $test (@cases)
	{

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

454 455 456 457 458 459
	  # 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;
	  }
460

461 462
	  # Copy test options
	  my $new_test= {};
463 464 465 466 467 468 469 470 471 472 473 474
	  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}});

unknown's avatar
unknown committed
475
	  # Add combination name short name
476 477 478 479 480 481
	  $new_test->{combination}= $comb->{name};

	  # Add the new test to new test cases list
	  push(@new_cases, $new_test);
	}
      }
482 483 484 485 486 487 488 489 490 491 492 493

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


494 495 496 497
      #print_testcases(@new_cases);
      @cases= @new_cases;
      #print_testcases(@cases);
    }
498
  }
499 500 501 502 503 504 505
  optimize_cases(\@cases);
  #print_testcases(@cases);

  return @cases;
}


unknown's avatar
unknown committed
506

507 508 509 510 511 512 513 514 515 516
#
# 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 )
  {
517 518 519
    # Skip processing if already marked as skipped
    next if $tinfo->{skip};

unknown's avatar
unknown committed
520 521 522 523 524
    # =======================================================
    # If a special binlog format was selected with
    # --mysqld=--binlog-format=x, skip all test that does not
    # support it
    # =======================================================
525
    #print "binlog_format: $binlog_format\n";
unknown's avatar
unknown committed
526
    if (defined $binlog_format )
527 528
    {
      # =======================================================
unknown's avatar
unknown committed
529
      # Fixed --binlog-format=x specified on command line
530
      # =======================================================
unknown's avatar
unknown committed
531
      if ( defined $tinfo->{'binlog_formats'} )
532
      {
533 534
	#print "binlog_formats: ". join(", ", @{$tinfo->{binlog_formats}})."\n";

unknown's avatar
unknown committed
535 536
	# The test supports different binlog formats
	# check if the selected one is ok
537
	my $supported=
unknown's avatar
unknown committed
538
	  grep { $_ eq $binlog_format } @{$tinfo->{'binlog_formats'}};
539 540 541 542
	if ( !$supported )
	{
	  $tinfo->{'skip'}= 1;
	  $tinfo->{'comment'}=
unknown's avatar
unknown committed
543
	    "Doesn't support --binlog-format='$binlog_format'";
544 545
	}
      }
unknown's avatar
unknown committed
546 547 548
    }
    else
    {
549
      # =======================================================
unknown's avatar
unknown committed
550
      # Use dynamic switching of binlog format
551
      # =======================================================
unknown's avatar
unknown committed
552 553 554 555 556 557

      # 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;
558 559
      }

560 561
      if (defined $test_binlog_format and
	  defined $tinfo->{binlog_formats} )
unknown's avatar
unknown committed
562
      {
563 564 565
	my $supported=
	  grep { $_ eq $test_binlog_format } @{$tinfo->{'binlog_formats'}};
	if ( !$supported )
unknown's avatar
unknown committed
566
	{
567 568 569 570
	  $tinfo->{'skip'}= 1;
	  $tinfo->{'comment'}=
	    "Doesn't support --binlog-format='$test_binlog_format'";
	  next;
unknown's avatar
unknown committed
571 572
	}
      }
573 574
    }
  }
unknown's avatar
unknown committed
575 576 577 578
}


#
unknown's avatar
unknown committed
579 580
# Read options from the given opt file and append them as an array
# to $tinfo->{$opt_name}
unknown's avatar
unknown committed
581
#
unknown's avatar
unknown committed
582 583
sub process_opts_file {
  my ($tinfo, $opt_file, $opt_name)= @_;
unknown's avatar
unknown committed
584

unknown's avatar
unknown committed
585 586
  $tinfo->{$opt_name}= [];
  if ( -f $opt_file )
unknown's avatar
unknown committed
587
  {
unknown's avatar
unknown committed
588
    my $opts= opts_from_file($opt_file);
unknown's avatar
unknown committed
589

unknown's avatar
unknown committed
590
    foreach my $opt ( @$opts )
591 592
    {
      my $value;
unknown's avatar
unknown committed
593

594 595 596
      # 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
unknown's avatar
unknown committed
597

598 599 600 601 602 603
      $value= mtr_match_prefix($opt, "--timezone=");
      if ( defined $value )
      {
	$tinfo->{'timezone'}= $value;
	next;
      }
unknown's avatar
unknown committed
604

605 606 607 608 609 610 611 612
      $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;
      }
unknown's avatar
unknown committed
613

unknown's avatar
unknown committed
614 615 616 617 618 619 620 621
      $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;
      }

622 623 624 625
      # If we set default time zone, remove the one we have
      $value= mtr_match_prefix($opt, "--default-time-zone=");
      if ( defined $value )
      {
626 627 628
	# Set timezone for this test case to something different
	$tinfo->{'timezone'}= "GMT-8";
	# Fallthrough, add the --default-time-zone option
629
      }
unknown's avatar
unknown committed
630

631 632 633 634 635 636 637 638
      # 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;
unknown's avatar
unknown committed
639
      }
unknown's avatar
unknown committed
640

641
      # Ok, this was a real option, add it
unknown's avatar
unknown committed
642
      push(@{$tinfo->{$opt_name}}, $opt);
unknown's avatar
unknown committed
643 644
    }
  }
unknown's avatar
unknown committed
645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661
}

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

sub collect_one_test_case {
  my $suitedir=   shift;
  my $testdir=    shift;
  my $resdir=     shift;
  my $suitename=  shift;
  my $tname=      shift;
  my $filename=   shift;
  my $disabled=   shift;
  my $suite_opts= shift;
unknown's avatar
unknown committed
662

unknown's avatar
unknown committed
663 664 665 666 667 668 669 670 671
  #print "collect_one_test_case\n";
  #print " suitedir: $suitedir\n";
  #print " testdir: $testdir\n";
  #print " resdir: $resdir\n";
  #print " suitename: $suitename\n";
  #print " tname: $tname\n";
  #print " filename: $filename\n";

  # ----------------------------------------------------------------------
672
  # Check --start-from
unknown's avatar
unknown committed
673
  # ----------------------------------------------------------------------
674
  if ( $start_from )
unknown's avatar
unknown committed
675
  {
676 677 678 679 680 681 682 683 684
    # start_from can be specified as [suite.].testname_prefix
    my ($suite, $test, $ext)= split_testname($start_from);

    if ( $suite and $suitename lt $suite){
      return; # Skip silently
    }
    if ( $tname lt $test ){
      return; # Skip silently
    }
unknown's avatar
unknown committed
685
  }
unknown's avatar
unknown committed
686

unknown's avatar
unknown committed
687 688 689 690
  # ----------------------------------------------------------------------
  # Set defaults
  # ----------------------------------------------------------------------
  my $tinfo= {};
691
  $tinfo->{'name'}= $suitename . ".$tname";
unknown's avatar
unknown committed
692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722
  $tinfo->{'path'}= "$testdir/$filename";

  # TODO allow nonexistsing result file
  # in that case .test must issue "exit" otherwise test should fail by default
  $tinfo->{'result_file'}= "$resdir/$tname.result";

  # ----------------------------------------------------------------------
  # Skip some tests but include in list, just mark them as skipped
  # ----------------------------------------------------------------------
  if ( $skip_test_reg and $tname =~ /$skip_test_reg/o )
  {
    $tinfo->{'skip'}= 1;
    return $tinfo;
  }

  # ----------------------------------------------------------------------
  # Check for disabled tests
  # ----------------------------------------------------------------------
  my $marked_as_disabled= 0;
  if ( $disabled->{$tname} )
  {
    # Test was marked as disabled in suites disabled.def file
    $marked_as_disabled= 1;
    $tinfo->{'comment'}= $disabled->{$tname};
  }

  my $disabled_file= "$testdir/$tname.disabled";
  if ( -f $disabled_file )
  {
    $marked_as_disabled= 1;
    $tinfo->{'comment'}= mtr_fromfile($disabled_file);
unknown's avatar
unknown committed
723 724
  }

unknown's avatar
unknown committed
725
  if ( $marked_as_disabled )
unknown's avatar
unknown committed
726
  {
unknown's avatar
unknown committed
727 728 729 730 731 732 733 734 735 736 737 738
    if ( $enable_disabled )
    {
      # User has selected to run all disabled tests
      mtr_report(" - $tinfo->{name} wil be run although it's been disabled\n",
		 "  due to '$tinfo->{comment}'");
    }
    else
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'disable'}= 1;   # Sub type of 'skip'
      return $tinfo;
    }
unknown's avatar
unknown committed
739 740
  }

unknown's avatar
unknown committed
741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756
  # ----------------------------------------------------------------------
  # Append suite extra options to both master and slave
  # ----------------------------------------------------------------------
  push(@{$tinfo->{'master_opt'}}, @$suite_opts);
  push(@{$tinfo->{'slave_opt'}}, @$suite_opts);

  # ----------------------------------------------------------------------
  # Add master opts, extra options only for master
  # ----------------------------------------------------------------------
  process_opts_file($tinfo, "$testdir/$tname-master.opt", 'master_opt');

  # ----------------------------------------------------------------------
  # Add slave opts, list of extra option only for slave
  # ----------------------------------------------------------------------
  process_opts_file($tinfo, "$testdir/$tname-slave.opt", 'slave_opt');

757 758 759 760 761 762 763 764 765
  # ----------------------------------------------------------------------
  # Check for test specific config file
  # ----------------------------------------------------------------------
  my $test_cnf_file= "$testdir/$tname.cnf";
  if ( -f $test_cnf_file ) {
    # Specifies the configuration file to use for this test
    $tinfo->{'template_path'}= $test_cnf_file;
  }

unknown's avatar
unknown committed
766 767 768 769
  # ----------------------------------------------------------------------
  # master sh
  # ----------------------------------------------------------------------
  my $master_sh= "$testdir/$tname-master.sh";
unknown's avatar
unknown committed
770 771
  if ( -f $master_sh )
  {
unknown's avatar
unknown committed
772
    if ( IS_WIN32PERL )
unknown's avatar
unknown committed
773 774
    {
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
775
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
unknown's avatar
unknown committed
776
      return $tinfo;
unknown's avatar
unknown committed
777 778 779 780 781 782 783
    }
    else
    {
      $tinfo->{'master_sh'}= $master_sh;
    }
  }

unknown's avatar
unknown committed
784 785 786 787
  # ----------------------------------------------------------------------
  # slave sh
  # ----------------------------------------------------------------------
  my $slave_sh= "$testdir/$tname-slave.sh";
unknown's avatar
unknown committed
788 789
  if ( -f $slave_sh )
  {
unknown's avatar
unknown committed
790
    if ( IS_WIN32PERL )
unknown's avatar
unknown committed
791 792
    {
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
793
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
unknown's avatar
unknown committed
794
      return $tinfo;
unknown's avatar
unknown committed
795 796 797 798 799 800 801
    }
    else
    {
      $tinfo->{'slave_sh'}= $slave_sh;
    }
  }

unknown's avatar
unknown committed
802 803 804 805 806 807 808 809 810 811
  # ----------------------------------------------------------------------
  # <tname>.slave-mi
  # ----------------------------------------------------------------------
  mtr_error("$tname: slave-mi not supported anymore")
    if ( -f "$testdir/$tname.slave-mi");


  tags_from_test_file($tinfo,"$testdir/${tname}.test");

  if ( defined $default_storage_engine )
unknown's avatar
unknown committed
812
  {
unknown's avatar
unknown committed
813 814 815 816 817 818 819 820
    # Different default engine is used
    # tag test to require that engine
    $tinfo->{'ndb_test'}= 1
      if ( $default_storage_engine =~ /^ndb/i );

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

unknown's avatar
unknown committed
821 822
  }

unknown's avatar
unknown committed
823
  if ( $tinfo->{'big_test'} and ! $::opt_big_test )
unknown's avatar
unknown committed
824
  {
unknown's avatar
unknown committed
825 826 827
    $tinfo->{'skip'}= 1;
    $tinfo->{'comment'}= "Test need 'big-test' option";
    return $tinfo
unknown's avatar
unknown committed
828 829
  }

unknown's avatar
unknown committed
830
  if ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries )
unknown's avatar
unknown committed
831
  {
unknown's avatar
unknown committed
832 833 834
    $tinfo->{'skip'}= 1;
    $tinfo->{'comment'}= "Test need debug binaries";
    return $tinfo
unknown's avatar
unknown committed
835 836
  }

unknown's avatar
unknown committed
837
  if ( $tinfo->{'ndb_test'} )
unknown's avatar
unknown committed
838
  {
unknown's avatar
unknown committed
839
    # This is a NDB test
840
    if ( $::opt_skip_ndbcluster == 2 )
unknown's avatar
unknown committed
841
    {
unknown's avatar
unknown committed
842
      # Ndb is not supported, skip it
unknown's avatar
unknown committed
843
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
844 845
      $tinfo->{'comment'}= "No ndbcluster support";
      return $tinfo;
unknown's avatar
unknown committed
846
    }
unknown's avatar
unknown committed
847
    elsif ( $::opt_skip_ndbcluster )
unknown's avatar
unknown committed
848
    {
unknown's avatar
unknown committed
849
      # All ndb test's should be skipped
unknown's avatar
unknown committed
850
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
851 852
      $tinfo->{'comment'}= "No ndbcluster tests(--skip-ndbcluster)";
      return $tinfo;
unknown's avatar
unknown committed
853 854 855 856
    }
  }
  else
  {
unknown's avatar
unknown committed
857 858
    # This is not a ndb test
    if ( $opt_with_ndbcluster_only )
unknown's avatar
unknown committed
859
    {
unknown's avatar
unknown committed
860
      # Only the ndb test should be run, all other should be skipped
unknown's avatar
unknown committed
861
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
862 863
      $tinfo->{'comment'}= "Only ndbcluster tests";
      return $tinfo;
unknown's avatar
unknown committed
864
    }
unknown's avatar
unknown committed
865
  }
unknown's avatar
unknown committed
866

unknown's avatar
unknown committed
867 868 869 870
  if ( $tinfo->{'innodb_test'} )
  {
      # This is a test that need innodb
    if ( $::mysqld_variables{'innodb'} ne "TRUE" )
unknown's avatar
unknown committed
871
    {
unknown's avatar
unknown committed
872
      # innodb is not supported, skip it
unknown's avatar
unknown committed
873
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
874 875
      $tinfo->{'comment'}= "No innodb support";
      return $tinfo;
unknown's avatar
unknown committed
876
    }
unknown's avatar
unknown committed
877 878 879 880 881 882
  }
  else
  {
    push(@{$tinfo->{'master_opt'}}, "--loose-skip-innodb");
    push(@{$tinfo->{'slave_opt'}}, "--loose-skip-innodb");
  }
unknown's avatar
unknown committed
883

unknown's avatar
unknown committed
884 885 886
  if ( $tinfo->{'need_binlog'} )
  {
    if (grep(/^--skip-log-bin/,  @::opt_extra_mysqld_opt) )
unknown's avatar
unknown committed
887 888
    {
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
889 890
      $tinfo->{'comment'}= "Test need binlog";
      return $tinfo;
unknown's avatar
unknown committed
891
    }
unknown's avatar
unknown committed
892 893 894 895 896 897 898 899
  }
  else
  {
    # Test does not need binlog, add --skip-binlog to
    # the options used when starting
    push(@{$tinfo->{'master_opt'}}, "--loose-skip-log-bin");
    push(@{$tinfo->{'slave_opt'}}, "--loose-skip-log-bin");
  }
unknown's avatar
unknown committed
900

unknown's avatar
unknown committed
901 902 903
  if ( $tinfo->{'rpl_test'} )
  {
    if ( $skip_rpl )
unknown's avatar
unknown committed
904 905
    {
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
906 907
      $tinfo->{'comment'}= "No replication tests(--skip-rpl)";
      return $tinfo;
908
    }
unknown's avatar
unknown committed
909
  }
910

911 912 913 914 915 916 917 918 919 920
  if ( $::opt_embedded_server )
  {
    if ( $tinfo->{'not_embedded'} )
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'comment'}= "Not run for embedded server";
      return $tinfo;
    }
  }

unknown's avatar
unknown committed
921 922 923 924 925 926 927 928 929 930 931
  # ----------------------------------------------------------------------
  # Find config file to use if not already selected in <testname>.opt file
  # ----------------------------------------------------------------------
  if (defined $defaults_file) {
    # Using same config file for all tests
    $tinfo->{template_path}= $defaults_file;
  }
  elsif (! $tinfo->{template_path} )
  {
    my $config= "$suitedir/my.cnf";
    if (! -f $config )
932
    {
933
      # assume default.cnf will be used
unknown's avatar
unknown committed
934
      $config= "include/default_my.cnf";
935 936 937 938 939 940 941 942 943 944 945

      # Suite has no config, autodetect which one to use
      if ( $tinfo->{rpl_test} ){
	$config= "suite/rpl/my.cnf";
	if ( $tinfo->{ndb_test} ){
	  $config= "suite/rpl_ndb/my.cnf";
	}
      }
      elsif ( $tinfo->{ndb_test} ){
	$config= "suite/ndb/my.cnf";
      }
946
    }
unknown's avatar
unknown committed
947 948
    $tinfo->{template_path}= $config;
  }
949

unknown's avatar
unknown committed
950 951 952
  # Set extra config file to use
  if (defined $defaults_extra_file) {
    $tinfo->{extra_template_path}= $defaults_extra_file;
unknown's avatar
unknown committed
953
  }
unknown's avatar
unknown committed
954

955 956 957 958 959 960
  # ----------------------------------------------------------------------
  # Append mysqld extra options to both master and slave
  # ----------------------------------------------------------------------
  push(@{$tinfo->{'master_opt'}}, @::opt_extra_mysqld_opt);
  push(@{$tinfo->{'slave_opt'}}, @::opt_extra_mysqld_opt);

unknown's avatar
unknown committed
961
  return $tinfo;
unknown's avatar
unknown committed
962 963 964
}


unknown's avatar
unknown committed
965 966
# List of tags in the .test files that if found should set
# the specified value in "tinfo"
unknown's avatar
unknown committed
967
my @tags=
unknown's avatar
unknown committed
968
(
unknown's avatar
unknown committed
969 970 971
 ["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"]],
972
 ["include/have_binlog_format_mixed_or_row.inc",
unknown's avatar
unknown committed
973
  "binlog_formats", ["mixed", "row"]],
974
 ["include/have_binlog_format_mixed_or_statement.inc",
unknown's avatar
unknown committed
975
  "binlog_formats", ["mixed", "statement"]],
976
 ["include/have_binlog_format_row_or_statement.inc",
unknown's avatar
unknown committed
977 978 979 980 981
  "binlog_formats", ["row", "statement"]],

 ["include/have_log_bin.inc", "need_binlog", 1],

 ["include/have_innodb.inc", "innodb_test", 1],
unknown's avatar
unknown committed
982 983
 ["include/big_test.inc", "big_test", 1],
 ["include/have_debug.inc", "need_debug", 1],
984
 ["include/have_ndb.inc", "ndb_test", 1],
985
 ["include/have_multi_ndb.inc", "ndb_test", 1],
unknown's avatar
unknown committed
986 987
 ["include/master-slave.inc", "rpl_test", 1],
 ["include/ndb_master-slave.inc", "rpl_test", 1],
988
 ["include/ndb_master-slave.inc", "ndb_test", 1],
unknown's avatar
unknown committed
989
 ["include/federated.inc", "federated_test", 1],
990
 ["include/not_embedded.inc", "not_embedded", 1],
unknown's avatar
unknown committed
991 992
);

unknown's avatar
unknown committed
993 994

sub tags_from_test_file {
unknown's avatar
unknown committed
995 996 997 998 999 1000 1001
  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> )
  {
1002 1003 1004 1005

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

unknown's avatar
unknown committed
1006 1007 1008 1009 1010
    # Match this line against tag in "tags" array
    foreach my $tag (@tags)
    {
      if ( index($line, $tag->[0]) >= 0 )
      {
unknown's avatar
unknown committed
1011 1012
	# Tag matched, assign value to "tinfo"
	$tinfo->{"$tag->[1]"}= $tag->[2];
unknown's avatar
unknown committed
1013 1014 1015 1016
      }
    }

    # If test sources another file, open it as well
1017 1018
    if ( $line =~ /^\-\-([[:space:]]*)source(.*)$/ or
	 $line =~ /^([[:space:]]*)source(.*);$/ )
unknown's avatar
unknown committed
1019 1020 1021 1022 1023
    {
      my $value= $2;
      $value =~ s/^\s+//;  # Remove leading space
      $value =~ s/[[:space:]]+$//;  # Remove ending space

1024 1025 1026 1027
      # Sourced file may exist relative to test or
      # in global location
      foreach my $sourced_file (dirname($file). "/$value",
				"$::glob_mysql_test_dir/$value")
1028
      {
1029 1030 1031 1032 1033 1034 1035 1036
	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)
	  tags_from_test_file($tinfo, $sourced_file);
	  last;
	}
1037
      }
unknown's avatar
unknown committed
1038
    }
unknown's avatar
unknown committed
1039

1040 1041 1042
  }
}

unknown's avatar
unknown committed
1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056
sub unspace {
  my $string= shift;
  my $quote=  shift;
  $string =~ s/[ \t]/\x11/g;
  return "$quote$string$quote";
}



sub envsubst {
  my $string= shift;

  if ( ! defined $ENV{$string} )
  {
unknown's avatar
unknown committed
1057
    mtr_error(".opt file references '$string' which is not set");
unknown's avatar
unknown committed
1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112
  }

  return $ENV{$string};
}


sub opts_from_file ($) {
  my $file=  shift;

  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
  my @args;
  while ( <FILE> )
  {
    chomp;

    #    --set-variable=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;

      # Expand environment variables
      $arg =~ s/\$\{(\w+)\}/envsubst($1)/ge;
      $arg =~ s/\$(\w+)/envsubst($1)/ge;

      # Do not pass empty string since my_getopt is not capable to handle it.
      if (length($arg)) {
	push(@args, $arg);
      }
    }
  }
  close FILE;
  return \@args;
}
1113 1114 1115

sub print_testcases {
  my (@cases)= @_;
unknown's avatar
unknown committed
1116

1117 1118 1119 1120
  print "=" x 60, "\n";
  foreach my $test (@cases){
    print "[", $test->{name}, "]", "\n";
    while ((my ($key, $value)) = each(%$test)) {
unknown's avatar
unknown committed
1121
      print " ", $key, "= ";
1122
      if (ref $value eq "ARRAY") {
unknown's avatar
unknown committed
1123
	print "[", join(", ", @$value), "]";
1124 1125 1126 1127 1128 1129
      } else {
	print $value;
      }
      print "\n";
    }
    print "\n";
unknown's avatar
unknown committed
1130
  }
1131
  print "=" x 60, "\n";
unknown's avatar
unknown committed
1132 1133
}

1134

unknown's avatar
unknown committed
1135
1;