mtr_cases.pm 32.8 KB
Newer Older
unknown's avatar
unknown committed
1
# -*- cperl -*-
2 3
# Copyright (c) 2005, 2011, Oracle and/or its affiliates.
# Copyright (c) 2010, 2011 Monty Program Ab
Kent Boortz's avatar
Merge  
Kent Boortz committed
4
# 
unknown's avatar
unknown committed
5 6 7
# 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
8
#
unknown's avatar
unknown committed
9 10 11 12
# 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
13
#
unknown's avatar
unknown committed
14 15 16
# 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
17 18 19 20 21

# 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
22
package mtr_cases;
unknown's avatar
unknown committed
23 24
use strict;

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

28
use mtr_report;
29
use mtr_match;
30

unknown's avatar
unknown committed
31 32 33 34
# Options used for the collect phase
our $skip_rpl;
our $do_test;
our $skip_test;
35
our $binlog_format;
unknown's avatar
unknown committed
36 37 38 39 40 41 42
our $enable_disabled;
our $default_storage_engine;
our $opt_with_ndbcluster_only;

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

43 44 45
  # Evaluate $opt as string to use "Getopt::Long::Callback legacy API"
  my $opt_name = "$opt";

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

unknown's avatar
unknown committed
52
use File::Basename;
53
use File::Spec::Functions qw /splitdir/;
unknown's avatar
unknown committed
54 55
use IO::File();
use My::Config;
unknown's avatar
unknown committed
56
use My::Platform;
57
use My::Test;
58
use My::Find;
59
use My::Suite;
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
my %suites;
68

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


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

92
sub collect_test_cases ($$$$) {
93
  my $opt_reorder= shift; # True if we're reordering tests
94
  my $suites= shift; # Semicolon separated list of test suites
95
  my $opt_cases= shift;
96
  my $opt_skip_test_list= shift;
unknown's avatar
unknown committed
97 98 99 100
  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");
101

102 103
  parse_disabled($_) for @$opt_skip_test_list;

104 105 106 107
  # 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)
108
  {
109 110
    foreach my $suite (split(",", $suites))
    {
111
      push(@$cases, collect_one_suite($suite, $opt_cases));
112
    }
113 114
  }

115
  if ( @$opt_cases )
116
  {
unknown's avatar
unknown committed
117
    # A list of tests was specified on the command line
118 119
    # Check that the tests specified was found
    # in at least one suite
120
    foreach my $test_name_spec ( @$opt_cases )
121 122
    {
      my $found= 0;
123
      my ($sname, $tname)= split_testname($test_name_spec);
124 125
      foreach my $test ( @$cases )
      {
126
	last unless $opt_reorder;
127
	# test->{name} is always in suite.name format
128
	if ( $test->{name} =~ /^$sname.*\.$tname$/ )
129 130
	{
	  $found= 1;
131
	  last;
132 133 134 135
	}
      }
      if ( not $found )
      {
136
	$sname= "main" if !$opt_reorder and !$sname;
137
	mtr_error("Could not find '$tname' in '$suites' suite(s)") unless $sname;
138
	# If suite was part of name, find it there, may come with combinations
139
	my @this_case = collect_one_suite($sname, [ $test_name_spec ]);
140
	if (@this_case)
141
        {
142
	  push (@$cases, @this_case);
143 144 145 146 147
	}
	else
	{
	  mtr_error("Could not find '$tname' in '$sname' suite");
        }
148 149 150 151
      }
    }
  }

152
  if ( $opt_reorder )
153 154 155
  {
    # 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
156
    # first, then a sub-criterion, then sub-sub-criterion, etc.
157 158 159 160
    foreach my $tinfo (@$cases)
    {
      my @criteria = ();

161
      #
162 163 164 165 166
      # Collect the criteria for sorting, in order of importance.
      # Note that criteria are also used in mysql-test-run.pl to
      # schedule tests to workers, and it preferres tests that have
      # *identical* criteria. That is, test name is *not* part of
      # the criteria, but it's part of the sorting function below.
167
      #
168
      push(@criteria, $tinfo->{template_path});
Sergei Golubchik's avatar
Sergei Golubchik committed
169 170 171 172 173
      for (qw(master_opt slave_opt)) {
        # Group test with equal options together.
        # Ending with "~" makes empty sort later than filled
        my $opts= $tinfo->{$_} ? $tinfo->{$_} : [];
        push(@criteria, join("!", sort @{$opts}) . "~");
174 175
      }
      $tinfo->{criteria}= join(" ", @criteria);
176 177
    }

178 179 180 181 182 183
    @$cases = sort {                            # ORDER BY
      $b->{skip} <=> $a->{skip}           ||    #   skipped DESC,
      $a->{criteria} cmp $b->{criteria}   ||    #   criteria ASC,
      $b->{long_test} <=> $a->{long_test} ||    #   long_test DESC,
      $a->{name} cmp $b->{name}                 #   name ASC
    } @$cases;
184 185 186 187 188
  }

  return $cases;
}

189

190
# Returns (suitename, testname)
191 192 193
sub split_testname {
  my ($test_name)= @_;

194 195 196 197 198
  # If .test file name is used, get rid of directory part
  $test_name= basename($test_name) if $test_name =~ /\.test$/;

  # Now split name on .'s
  my @parts= split(/\./, $test_name);
199 200 201

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

unknown's avatar
unknown committed
207
    if ($parts[1] eq "test")
208
    {
209
      return (undef , $parts[0]);
210 211 212
    }
    else
    {
213
      return ($parts[0], $parts[1]);
214 215 216 217 218 219
    }
  }

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

220 221 222 223 224 225
our %file_to_tags;
our %file_to_master_opts;
our %file_to_slave_opts;
our %file_combinations;
our %skip_combinations;
our %file_in_overlay;
226 227

sub load_suite_object {
228 229 230
  my ($suitename, $suitedir) = @_;
  my $suite;
  unless (defined $suites{$suitename}) {
231
    if (-f "$suitedir/suite.pm") {
232 233 234
      $suite= do "$suitedir/suite.pm";
      unless (ref $suite) {
        my $comment = $suite;
235
        $suite = My::Suite->new();
236 237
        $suite->{skip} = $comment;
      }
238
    } else {
239
      $suite = My::Suite->new();
240
    }
241 242 243 244 245 246

    $suites{$suitename} = $suite;

    # add suite skiplist to a global hash, so that we can check it
    # with only one lookup
    my %suite_skiplist = $suite->skip_combinations();
247
    while (my ($file, $skiplist) = each %suite_skiplist) {
248 249 250 251 252 253
      $file =~ s/\.\w+$/\.combinations/;
      if (ref $skiplist) {
        $skip_combinations{"$suitedir/$file => $_"} = 1 for (@$skiplist);
      } else {
        $skip_combinations{"$suitedir/$file"} = $skiplist;
      }
254 255
    }
  }
256
  return $suites{$suitename};
257 258
}

259

260
# returns a pair of (suite, suitedir)
261
sub load_suite_for_file($) {
262
  my ($file) = @_;
263
  return load_suite_object($2, $1)
264
    if $file =~ m@^(.*/(?:storage|plugin)/\w+/mysql-test/(\w+))/@;
265 266
  return load_suite_object($2, $1) if $file =~ m@^(.*/mysql-test/suite/(\w+))/@;
  return load_suite_object('main', $1) if $file =~ m@^(.*/mysql-test)/@;
267 268 269
  mtr_error("Cannot determine suite for $file");
}

270
sub combinations_from_file($$)
Sergei Golubchik's avatar
Sergei Golubchik committed
271
{
272
  my ($in_overlay, $filename) = @_;
Sergei Golubchik's avatar
Sergei Golubchik committed
273
  my @combs;
274 275 276 277 278 279 280 281 282 283 284 285 286 287 288
  if ($skip_combinations{$filename}) {
    @combs = ({ skip => $skip_combinations{$filename} });
  } else {
    return () if @::opt_combinations or not -f $filename;
    # Read combinations file in my.cnf format
    mtr_verbose("Read combinations file");
    my $config= My::Config->new($filename);
    foreach my $group ($config->option_groups()) {
      my $comb= { name => $group->name(), comb_opt => [] };
      next if $skip_combinations{"$filename => $comb->{name}"};
      foreach my $option ( $group->options() ) {
        push(@{$comb->{comb_opt}}, $option->option());
      }
      $comb->{in_overlay} = 1 if $in_overlay;
      push @combs, $comb;
Sergei Golubchik's avatar
Sergei Golubchik committed
289
    }
290
    @combs = ({ skip => 'Requires: ' . basename($filename, '.combinations') }) unless @combs;
Sergei Golubchik's avatar
Sergei Golubchik committed
291 292 293 294
  }
  @combs;
}

295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312
our %disabled;
sub parse_disabled {
  my ($filename, $suitename) = @_;

  if (open(DISABLED, $filename)) {
    while (<DISABLED>) {
      chomp;
      next if /^\s*#/ or /^\s*$/;
      mtr_error("Syntax error in $filename line $.")
        unless /^\s*(?:([-0-9A-Za-z_]+)\.)?([-0-9A-Za-z_]+)\s*:\s*(.*?)\s*$/;
      mtr_error("Wrong suite name in $filename line $.")
        if defined $1 and defined $suitename and $1 ne $suitename;
      $disabled{($1 || $suitename || '') . ".$2"} = $3;
    }
    close DISABLED;
  }
}

unknown's avatar
unknown committed
313
sub collect_one_suite
314
{
315
  my $suitename= shift;  # Test suite name
316
  my $opt_cases= shift;
317 318 319
  my $over;

  ($suitename, $over) = split '-', $suitename;
320

321
  mtr_verbose("Collecting: $suitename");
unknown's avatar
unknown committed
322

323 324
  my $suitedir= $::glob_mysql_test_dir; # Default
  my @overlays = ();
325
  if ( $suitename ne "main" )
unknown's avatar
unknown committed
326
  {
327
    # Allow suite to be path to "some dir" if $suitename has at least
328
    # one directory part
329 330
    if ( -d $suitename and splitdir($suitename) > 1 ){
      $suitedir= $suitename;
331 332
      mtr_report(" - from '$suitedir'");

333 334 335
    }
    else
    {
336 337 338 339 340 341 342 343 344 345 346 347 348
      @overlays = my_find_dir($::basedir,
                              ["mysql-test/suite",
                               "storage/*/mysql-test",
                               "plugin/*/mysql-test"],
                              [$suitename]);
      #
      # XXX at the moment, for simplicity, we will not fully support one plugin
      # overlaying a suite of another plugin. Only suites in the main
      # mysql-test directory can be safely overlayed. To be fixed, when needed.
      # To fix it we'll need a smarter overlay detection (that is, detection of
      # what is an overlay and what is the "original" suite) than simply
      # "prefer directories with more files".
      #
unknown's avatar
unknown committed
349

350 351 352 353 354
      if ($overlays[0] !~ m@/mysql-test/suite/$suitename$@) {
        # prefer directories with more files
        @overlays = sort { scalar(<$a/*>) <=> scalar(<$b/*>) } @overlays;
      }
      $suitedir = shift @overlays;
unknown's avatar
unknown committed
355
    }
356 357 358 359 360
  } else {
    @overlays = my_find_dir($::basedir,
                            ["storage/*/mysql-test",
                             "plugin/*/mysql-test"],
                            ['main'], NOT_REQUIRED);
unknown's avatar
unknown committed
361
  }
362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387
  mtr_verbose("suitedir: $suitedir");
  mtr_verbose("overlays: @overlays") if @overlays;

  # we always need to process the parent suite, even if we won't use any
  # test from it.
  my @cases= process_suite($suitename, undef, $suitedir,
                           $over ? [ '*BOGUS*' ] : $opt_cases);

  # when working with overlays we cannot use global caches like
  # %file_to_tags. Because the same file may have different tags
  # with and without overlays. For example, when a.test includes
  # b.inc, which includes c.inc, and an overlay replaces c.inc.
  # In this case b.inc may have different tags in the overlay,
  # despite the fact that b.inc itself is not replaced.
  for (@overlays) {
    local %file_to_tags = ();
    local %file_to_master_opts = ();
    local %file_to_slave_opts = ();
    local %file_combinations = ();
    local %file_in_overlay = ();

    die unless m@/(?:storage|plugin)/(\w+)/mysql-test/\w+$@;
    next unless defined $over and ($over eq '' or $over eq $1);
    push @cases, 
    # don't add cases that take *all* data from the parent suite
      grep { $_->{in_overlay} } process_suite($suitename, $1, $_, $opt_cases);
unknown's avatar
unknown committed
388
  }
389 390
  return @cases;
}
unknown's avatar
unknown committed
391

392 393 394 395 396 397 398 399 400 401 402 403
sub process_suite {
  my ($basename, $overname, $suitedir, $opt_cases) = @_;
  my $suitename;
  my $parent;

  if ($overname) {
    $parent = $suites{$basename};
    die unless $parent;
    $suitename = $basename . '-' . $overname;
  } else {
    $suitename = $basename;
  }
unknown's avatar
unknown committed
404

405
  my $suite = load_suite_object($suitename, $suitedir);
406

407 408 409
  #
  # Read suite config files, unless it was done aleady
  #
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434
  unless (defined $suite->{name}) {
    $suite->{name} = $suitename;
    $suite->{dir}  = $suitedir;

    # First, we need to find where the test files and result files are.
    # test files are usually in a t/ dir inside suite dir. Or directly in the
    # suite dir. result files are in a r/ dir or in the suite dir.
    # Overlay uses t/ and r/ if and only if its parent does.
    if ($parent) {
      $suite->{parent} = $parent;
      my $tdir = $parent->{tdir};
      my $rdir = $parent->{rdir};
      substr($tdir, 0, length $parent->{dir}) = $suitedir;
      substr($rdir, 0, length $parent->{dir}) = $suitedir;
      $suite->{tdir} = $tdir if -d $tdir;
      $suite->{rdir} = $rdir if -d $rdir;
    } else {
      my $tdir= "$suitedir/t";
      my $rdir= "$suitedir/r";
      $suite->{tdir} = -d $tdir ? $tdir : $suitedir;
      $suite->{rdir} = -d $rdir ? $rdir : $suite->{tdir};
    }

    mtr_verbose("testdir: " . $suite->{tdir});
    mtr_verbose( "resdir: " . $suite->{rdir});
unknown's avatar
unknown committed
435

436
    # disabled.def
437
    parse_disabled($suite->{dir} .'/disabled.def', $suitename);
438 439

    # combinations
Sergei Golubchik's avatar
Sergei Golubchik committed
440 441 442 443 444 445 446 447
    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);
448
        push @{$suite->{combinations}}, $comb;
Sergei Golubchik's avatar
Sergei Golubchik committed
449 450 451 452
      }
    }
    else
    {
453 454 455
      my @combs;
      @combs = combinations_from_file($parent, "$suitedir/combinations")
        unless $suite->{skip};
456
      $suite->{combinations} = [ @combs ];
457 458
      #  in overlays it's a union of parent's and overlay's files.
      unshift @{$suite->{combinations}}, @{$parent->{combinations}} if $parent;
Sergei Golubchik's avatar
Sergei Golubchik committed
459
    }
460

461
    # suite.opt
462
    #  in overlays it's a union of parent's and overlay's files.
463
    $suite->{opts} = [ opts_from_file("$suitedir/suite.opt") ];
464 465 466 467
    $suite->{in_overlay} = 1 if $parent and @{$suite->{opts}};
    unshift @{$suite->{opts}}, @{$parent->{opts}} if $parent;

    $suite->{cases} = [ $suite->list_cases($suite->{tdir}) ];
468
  }
469

470 471 472
  my %all_cases;
  %all_cases = map { $_ => $parent->{tdir} } @{$parent->{cases}} if $parent;
  $all_cases{$_} = $suite->{tdir} for @{$suite->{cases}};
473

474 475
  my @cases;
  if (@$opt_cases) {
476
    # Collect in specified order
477
    foreach my $test_name_spec ( @$opt_cases )
478
    {
479
      my ($sname, $tname)= split_testname($test_name_spec);
unknown's avatar
unknown committed
480

481
      # Check correct suite if suitename is defined
482 483
      next if defined $sname and $sname ne $suitename
                             and $sname ne "$basename-";
unknown's avatar
unknown committed
484

485 486
      next unless $all_cases{$tname};
      push @cases, collect_one_test_case($suite, $all_cases{$tname}, $tname);
unknown's avatar
unknown committed
487
    }
488 489 490 491 492 493
  } else {
    for (sort keys %all_cases)
    {
      # Skip tests that do not match the --do-test= filter
      next if $do_test_reg and not /$do_test_reg/o;
      push @cases, collect_one_test_case($suite, $all_cases{$_}, $_);
494
    }
495
  }
unknown's avatar
unknown committed
496

497 498
  @cases;
}
unknown's avatar
unknown committed
499 500

#
unknown's avatar
unknown committed
501 502
# Read options from the given opt file and append them as an array
# to $tinfo->{$opt_name}
unknown's avatar
unknown committed
503
#
Sergei Golubchik's avatar
Sergei Golubchik committed
504 505 506 507 508 509 510
sub process_opts {
  my ($tinfo, $opt_name)= @_;

  my @opts= @{$tinfo->{$opt_name}};
  $tinfo->{$opt_name} = [];

  foreach my $opt (@opts)
unknown's avatar
unknown committed
511
  {
Sergei Golubchik's avatar
Sergei Golubchik committed
512
    my $value;
unknown's avatar
unknown committed
513

Sergei Golubchik's avatar
Sergei Golubchik committed
514 515 516 517 518 519
    # 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 )
520
    {
Sergei Golubchik's avatar
Sergei Golubchik committed
521 522 523
      $tinfo->{'timezone'}= $value;
      next;
    }
unknown's avatar
unknown committed
524

Sergei Golubchik's avatar
Sergei Golubchik committed
525 526 527 528 529 530 531 532
    # 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
    }
unknown's avatar
unknown committed
533

Sergei Golubchik's avatar
Sergei Golubchik committed
534 535 536
    # Ok, this was a real option, add it
    push(@{$tinfo->{$opt_name}}, $opt);
  }
unknown's avatar
unknown committed
537 538
}

Sergei Golubchik's avatar
Sergei Golubchik committed
539 540 541 542 543
sub make_combinations($@)
{
  my ($test, @combinations) = @_;

  return ($test) if $test->{'skip'} or not @combinations;
544 545 546 547 548 549
  if ($combinations[0]->{skip}) {
    $test->{skip} = 1;
    $test->{comment} = $combinations[0]->{skip} unless $test->{comment};
    die unless @combinations == 1;
    return ($test);
  }
Sergei Golubchik's avatar
Sergei Golubchik committed
550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568

  foreach my $comb (@combinations)
  {
    # Skip all other combinations if the values they change
    # are already fixed 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}) ){

      # Add combination name short name
      push @{$test->{combinations}}, $comb->{name};

      return ($test);
    }
  }

  my @cases;
  foreach my $comb (@combinations)
  {
    # Copy test options
Sergei Golubchik's avatar
Sergei Golubchik committed
569
    my $new_test= $test->copy();
Sergei Golubchik's avatar
Sergei Golubchik committed
570
    
Sergei Golubchik's avatar
Sergei Golubchik committed
571 572 573 574
    # Prepend the combination options to master_opt and slave_opt
    # (on the command line combinations go *before* .opt files)
    unshift @{$new_test->{master_opt}}, @{$comb->{comb_opt}};
    unshift @{$new_test->{slave_opt}}, @{$comb->{comb_opt}};
Sergei Golubchik's avatar
Sergei Golubchik committed
575 576 577 578

    # Add combination name short name
    push @{$new_test->{combinations}}, $comb->{name};

579 580
    $new_test->{in_overlay} = 1 if $comb->{in_overlay};

Sergei Golubchik's avatar
Sergei Golubchik committed
581 582 583 584 585 586
    # Add the new test to new test cases list
    push(@cases, $new_test);
  }
  return @cases;
}

Michael Widenius's avatar
Michael Widenius committed
587

588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604
sub find_file_in_dirs
{
  my ($tinfo, $slot, $filename) = @_;
  my $parent = $tinfo->{suite}->{parent};
  my $f = $tinfo->{suite}->{$slot} . '/' . $filename;

  if (-f $f) {
    $tinfo->{in_overlay} = 1 if $parent;
    return $f;
  }

  return undef unless $parent;

  $f = $parent->{$slot} . '/' . $filename;
  return -f $f ? $f : undef;
}

unknown's avatar
unknown committed
605 606 607 608 609 610 611
##############################################################################
#
#  Collect information about a single test case
#
##############################################################################

sub collect_one_test_case {
612 613 614
  my $suite     =  shift;
  my $tpath     =  shift;
  my $tname     =  shift;
unknown's avatar
unknown committed
615

616 617 618
  my $suitename =  $suite->{name};
  my $name      = "$suitename.$tname";
  my $filename  = "$tpath/${tname}.test";
Michael Widenius's avatar
Michael Widenius committed
619

unknown's avatar
unknown committed
620 621 622
  # ----------------------------------------------------------------------
  # Set defaults
  # ----------------------------------------------------------------------
623 624
  my $tinfo= My::Test->new
    (
625
     name          => $name,
Serge Kozlov's avatar
Serge Kozlov committed
626
     shortname     => $tname,
Sergei Golubchik's avatar
Sergei Golubchik committed
627
     path          => $filename,
628
     suite         => $suite,
629
     in_overlay    => $suite->{in_overlay},
630 631
     master_opt    => [ @{$suite->{opts}} ],
     slave_opt     => [ @{$suite->{opts}} ],
632
    );
unknown's avatar
unknown committed
633 634 635 636

  # ----------------------------------------------------------------------
  # Skip some tests but include in list, just mark them as skipped
  # ----------------------------------------------------------------------
637 638
  if ( $skip_test_reg and ($tname =~ /$skip_test_reg/o or
                            $name =~ /$skip_test_reg/o))
unknown's avatar
unknown committed
639 640 641 642 643 644 645 646
  {
    $tinfo->{'skip'}= 1;
    return $tinfo;
  }

  # ----------------------------------------------------------------------
  # Check for disabled tests
  # ----------------------------------------------------------------------
647
  my $disable = $disabled{".$tname"} || $disabled{$name};
648 649 650 651
  if (not defined $disable and $suite->{parent}) {
    $disable = $disabled{$suite->{parent}->{name} . ".$tname"};
  }
  if (defined $disable)
unknown's avatar
unknown committed
652
  {
653
    $tinfo->{comment}= $disable;
unknown's avatar
unknown committed
654 655 656 657
    if ( $enable_disabled )
    {
      # User has selected to run all disabled tests
      mtr_report(" - $tinfo->{name} wil be run although it's been disabled\n",
658
		 "  due to '$disable'");
unknown's avatar
unknown committed
659 660 661 662 663
    }
    else
    {
      $tinfo->{'skip'}= 1;
      $tinfo->{'disable'}= 1;   # Sub type of 'skip'
664 665 666 667 668

      # we can stop test file processing early if the test if disabled, but
      # only if we're not in the overlay.  for overlays we want to know exactly
      # whether the test is ignored (in_overlay=0) or disabled.
      return $tinfo unless $suite->{parent};
unknown's avatar
unknown committed
669
    }
unknown's avatar
unknown committed
670 671
  }

672 673
  if ($suite->{skip}) {
    $tinfo->{skip}= 1;
674 675
    $tinfo->{comment}= $suite->{skip} unless $tinfo->{comment};
    return $tinfo unless $suite->{parent};
676 677
  }

678 679 680
  # ----------------------------------------------------------------------
  # Check for test specific config file
  # ----------------------------------------------------------------------
681 682
  my $test_cnf_file= find_file_in_dirs($tinfo, tdir => "$tname.cnf");
  if ($test_cnf_file ) {
683 684 685 686
    # Specifies the configuration file to use for this test
    $tinfo->{'template_path'}= $test_cnf_file;
  }

unknown's avatar
unknown committed
687 688 689
  # ----------------------------------------------------------------------
  # master sh
  # ----------------------------------------------------------------------
690 691
  my $master_sh= find_file_in_dirs($tinfo, tdir => "$tname-master.sh");
  if ($master_sh)
unknown's avatar
unknown committed
692
  {
unknown's avatar
unknown committed
693
    if ( IS_WIN32PERL )
unknown's avatar
unknown committed
694 695
    {
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
696
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
unknown's avatar
unknown committed
697
      return $tinfo;
unknown's avatar
unknown committed
698 699 700 701 702 703 704
    }
    else
    {
      $tinfo->{'master_sh'}= $master_sh;
    }
  }

unknown's avatar
unknown committed
705 706 707
  # ----------------------------------------------------------------------
  # slave sh
  # ----------------------------------------------------------------------
708 709
  my $slave_sh= find_file_in_dirs($tinfo, tdir => "$tname-slave.sh");
  if ($slave_sh)
unknown's avatar
unknown committed
710
  {
unknown's avatar
unknown committed
711
    if ( IS_WIN32PERL )
unknown's avatar
unknown committed
712 713
    {
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
714
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
unknown's avatar
unknown committed
715
      return $tinfo;
unknown's avatar
unknown committed
716 717 718 719 720 721 722
    }
    else
    {
      $tinfo->{'slave_sh'}= $slave_sh;
    }
  }

723 724
  my ($master_opts, $slave_opts)= tags_from_test_file($tinfo);
  $tinfo->{in_overlay} = 1 if $file_in_overlay{$filename};
unknown's avatar
unknown committed
725 726

  if ( $tinfo->{'big_test'} and ! $::opt_big_test )
unknown's avatar
unknown committed
727
  {
unknown's avatar
unknown committed
728
    $tinfo->{'skip'}= 1;
Michael Widenius's avatar
Michael Widenius committed
729
    $tinfo->{'comment'}= "Test needs --big-test";
unknown's avatar
unknown committed
730
    return $tinfo
unknown's avatar
unknown committed
731
  }
732

733 734 735 736 737
  if ( $tinfo->{'big_test'} )
  {
    # All 'big_test' takes a long time to run
    $tinfo->{'long_test'}= 1;
  }
unknown's avatar
unknown committed
738

739 740 741 742 743 744 745
  if ( ! $tinfo->{'big_test'} and $::opt_big_test > 1 )
  {
    $tinfo->{'skip'}= 1;
    $tinfo->{'comment'}= "Small test";
    return $tinfo
  }

unknown's avatar
unknown committed
746
  if ( $tinfo->{'ndb_test'} )
unknown's avatar
unknown committed
747
  {
unknown's avatar
unknown committed
748
    # This is a NDB test
749
    if ( $::opt_skip_ndbcluster == 2 )
unknown's avatar
unknown committed
750
    {
unknown's avatar
unknown committed
751
      # Ndb is not supported, skip it
unknown's avatar
unknown committed
752
      $tinfo->{'skip'}= 1;
753
      $tinfo->{'comment'}= "No ndbcluster support or ndb tests not enabled";
unknown's avatar
unknown committed
754
      return $tinfo;
unknown's avatar
unknown committed
755
    }
unknown's avatar
unknown committed
756
    elsif ( $::opt_skip_ndbcluster )
unknown's avatar
unknown committed
757
    {
unknown's avatar
unknown committed
758
      # All ndb test's should be skipped
unknown's avatar
unknown committed
759
      $tinfo->{'skip'}= 1;
Michael Widenius's avatar
Michael Widenius committed
760
      $tinfo->{'comment'}= "No ndbcluster";
unknown's avatar
unknown committed
761
      return $tinfo;
unknown's avatar
unknown committed
762 763 764 765
    }
  }
  else
  {
unknown's avatar
unknown committed
766 767
    # This is not a ndb test
    if ( $opt_with_ndbcluster_only )
unknown's avatar
unknown committed
768
    {
unknown's avatar
unknown committed
769
      # Only the ndb test should be run, all other should be skipped
unknown's avatar
unknown committed
770
      $tinfo->{'skip'}= 1;
unknown's avatar
unknown committed
771 772
      $tinfo->{'comment'}= "Only ndbcluster tests";
      return $tinfo;
unknown's avatar
unknown committed
773
    }
unknown's avatar
unknown committed
774
  }
unknown's avatar
unknown committed
775

unknown's avatar
unknown committed
776 777 778
  if ( $tinfo->{'rpl_test'} )
  {
    if ( $skip_rpl )
unknown's avatar
unknown committed
779 780
    {
      $tinfo->{'skip'}= 1;
Michael Widenius's avatar
Michael Widenius committed
781
      $tinfo->{'comment'}= "No replication tests";
unknown's avatar
unknown committed
782
      return $tinfo;
unknown's avatar
unknown committed
783
    }
unknown's avatar
unknown committed
784
  }
unknown's avatar
unknown committed
785

unknown's avatar
unknown committed
786 787 788
  # ----------------------------------------------------------------------
  # Find config file to use if not already selected in <testname>.opt file
  # ----------------------------------------------------------------------
789
  if (not $tinfo->{template_path} )
unknown's avatar
unknown committed
790
  {
791 792
    my $config= find_file_in_dirs($tinfo, dir => 'my.cnf');
    if (not $config)
793
    {
794
      # Suite has no config, autodetect which one to use
795 796 797 798
      if ($tinfo->{rpl_test}) {
        $config= "suite/rpl/my.cnf";
      } else {
        $config= "include/default_my.cnf";
799
      }
800
    }
unknown's avatar
unknown committed
801 802
    $tinfo->{template_path}= $config;
  }
803

804
  # ----------------------------------------------------------------------
805
  # Append mysqld extra options to master and slave, as appropriate
806
  # ----------------------------------------------------------------------
unknown's avatar
unknown committed
807 808
  push @{$tinfo->{'master_opt'}}, @$master_opts, @::opt_extra_mysqld_opt;
  push @{$tinfo->{'slave_opt'}}, @$slave_opts, @::opt_extra_mysqld_opt;
809

Sergei Golubchik's avatar
Sergei Golubchik committed
810 811
  process_opts($tinfo, 'master_opt');
  process_opts($tinfo, 'slave_opt');
812

Sergei Golubchik's avatar
Sergei Golubchik committed
813
  my @cases = ($tinfo);
814
  for my $comb ($suite->{combinations}, @{$file_combinations{$filename}})
Sergei Golubchik's avatar
Sergei Golubchik committed
815 816 817
  {
    @cases = map make_combinations($_, @{$comb}), @cases;
  }
818 819

  for $tinfo (@cases) {
820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859
    #
    # Now we find a result file for every test file. It's a bit complicated.
    # For a test foobar.test in the combination pair {aa,bb}, and in the
    # overlay "rty" to the suite "qwe", in other words, for the
    # that that mtr prints as
    #   ...
    #   qwe-rty.foobar                   'aa,bb'  [ pass ]
    #   ...
    # the result can be expected in
    #  * either .rdiff or .result file
    #  * either in the overlay or in the original suite
    #  * with or without combinations in the file name.
    # which means any of the following 15 file names can be used:
    #
    #  1    rty/r/foo,aa,bb.result          
    #  2    rty/r/foo,aa,bb.rdiff
    #  3    qwe/r/foo,aa,bb.result
    #  4    qwe/r/foo,aa,bb.rdiff
    #  5    rty/r/foo,aa.result
    #  6    rty/r/foo,aa.rdiff
    #  7    qwe/r/foo,aa.result
    #  8    qwe/r/foo,aa.rdiff
    #  9    rty/r/foo,bb.result
    # 10    rty/r/foo,bb.rdiff
    # 11    qwe/r/foo,bb.result
    # 12    qwe/r/foo,bb.rdiff
    # 13    rty/r/foo.result
    # 14    rty/r/foo.rdiff
    # 15    qwe/r/foo.result
    #
    # They are listed, precisely, in the order of preference.
    # mtr will walk that list from top to bottom and the first file that
    # is found will be used.
    #
    # If this found file is a .rdiff, mtr continues walking down the list
    # until the first .result file is found.
    # A .rdiff is applied to that .result.
    #
    my $re ='';

860
    if ($tinfo->{combinations}) {
861
      $re = '(?:' . join('|', @{$tinfo->{combinations}}) . ')';
862
    }
863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893
    my $resdirglob = $suite->{rdir};
    $resdirglob.= ',' . $suite->{parent}->{rdir} if $suite->{parent};

    my %files;
    for (<{$resdirglob}/$tname*.{rdiff,result}>) {
      my ($path, $combs, $ext) =
                  m@^(.*)/$tname((?:,$re)*)\.(rdiff|result)$@ or next;
      my @combs = sort split /,/, $combs;
      $files{$_} = join '~', (                # sort files by
        99 - scalar(@combs),                  # number of combinations DESC
        join(',', sort @combs),               # combination names ASC
        $path eq $suite->{rdir} ? 1 : 2,      # overlay first
        $ext eq 'result' ? 1 : 2              # result before rdiff
      );
    }
    my @results = sort { $files{$a} cmp $files{$b} } keys %files;

    if (@results) {
      my $result_file = shift @results;
      $tinfo->{result_file} = $result_file;

      if ($result_file =~ /\.rdiff$/) {
        shift @results while $results[0] =~ /\.rdiff$/;
        mtr_error ("$result_file has no corresponding .result file")
          unless @results;
        $tinfo->{base_result} = $results[0];

        if (not $::exe_patch) {
          $tinfo->{skip} = 1;
          $tinfo->{comment} = "requires patch executable";
        }
894
      }
895 896 897 898 899
    } else {
      # No .result file exist
      # Remember the path  where it should be
      # saved in case of --record
      $tinfo->{record_file}= $suite->{rdir} . "/$tname.result";
900 901 902
    }
  }

Sergei Golubchik's avatar
Sergei Golubchik committed
903
  return @cases;
unknown's avatar
unknown committed
904 905 906
}


unknown's avatar
unknown committed
907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924
my $tags_map= {'big_test' => ['big_test', 1],
               'have_ndb' => ['ndb_test', 1],
               'have_multi_ndb' => ['ndb_test', 1],
               'master-slave' => ['rpl_test', 1],
               'ndb_master-slave' => ['rpl_test', 1, 'ndb_test', 1],
               'long_test' => ['long_test', 1],
};
my $tags_regex_string= join('|', keys %$tags_map);
my $tags_regex= qr:include/($tags_regex_string)\.inc:o;

# Get various tags from a file, recursively scanning also included files.
# And get options from .opt file, also recursively for included files.
# Return a list of [TAG_TO_SET, VALUE_TO_SET_TO] of found tags.
# Also returns lists of options for master and slave found in .opt files.
# Each include file is scanned only once, and subsequent calls just look up the
# cached result.
# We need to be a bit careful about speed here; previous version of this code
# took forever to scan the full test suite.
Sergei Golubchik's avatar
Sergei Golubchik committed
925
sub get_tags_from_file($$) {
926
  my ($file, $suite)= @_;
unknown's avatar
unknown committed
927

Sergei Golubchik's avatar
Sergei Golubchik committed
928
  return @{$file_to_tags{$file}} if exists $file_to_tags{$file};
unknown's avatar
unknown committed
929 930 931 932 933 934 935

  my $F= IO::File->new($file)
    or mtr_error("can't open file \"$file\": $!");

  my $tags= [];
  my $master_opts= [];
  my $slave_opts= [];
Sergei Golubchik's avatar
Sergei Golubchik committed
936
  my @combinations;
unknown's avatar
unknown committed
937

938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956
  my $over = defined $suite->{parent};
  my $sdir = $suite->{dir};
  my $pdir = $suite->{parent}->{dir} if $over;
  my $in_overlay = 0;
  my $suffix = $file;
  my @prefix = ('');

  # to be able to look up all auxillary files in the overlay
  # we split the file path in a prefix and a suffix
  if ($file =~ m@^$sdir/(.*)$@) {
    $suffix = $1;
    @prefix =  ("$sdir/");
    push @prefix, "$pdir/" if $over;
    $in_overlay = $over;
  } elsif ($over and $file =~ m@^$pdir/(.*)$@) {
    $suffix = $1;
    @prefix = map { "$_/" } $sdir, $pdir;
  }

unknown's avatar
unknown committed
957
  while (my $line= <$F>)
unknown's avatar
unknown committed
958
  {
unknown's avatar
unknown committed
959 960
    # Ignore comments.
    next if $line =~ /^\#/;
961

unknown's avatar
unknown committed
962 963
    # Add any tag we find.
    if ($line =~ /$tags_regex/o)
unknown's avatar
unknown committed
964
    {
unknown's avatar
unknown committed
965 966
      my $to_set= $tags_map->{$1};
      for (my $i= 0; $i < @$to_set; $i+= 2)
unknown's avatar
unknown committed
967
      {
unknown's avatar
unknown committed
968
        push @$tags, [$to_set->[$i], $to_set->[$i+1]];
unknown's avatar
unknown committed
969 970 971
      }
    }

unknown's avatar
unknown committed
972 973
    # Check for a sourced include file.
    if ($line =~ /^(--)?[[:space:]]*source[[:space:]]+([^;[:space:]]+)/)
unknown's avatar
unknown committed
974
    {
unknown's avatar
unknown committed
975
      my $include= $2;
976
      # The rules below must match open_file() function of mysqltest.cc
unknown's avatar
unknown committed
977 978 979
      # Note that for the purpose of tag collection we ignore
      # non-existing files, and let mysqltest handle the error
      # (e.g. mysqltest.test needs this)
980 981
      for ((map { dirname("$_$suffix") } @prefix),
           $sdir, $pdir, $::glob_mysql_test_dir)
982
      {
983 984 985
        next unless defined $_;
        my $sourced_file = "$_/$include";
        next if $sourced_file eq $file;
unknown's avatar
unknown committed
986 987
        if (-e $sourced_file)
        {
988
          push @$tags, get_tags_from_file($sourced_file, $suite);
Sergei Golubchik's avatar
Sergei Golubchik committed
989 990
          push @$master_opts, @{$file_to_master_opts{$sourced_file}};
          push @$slave_opts, @{$file_to_slave_opts{$sourced_file}};
991
          push @combinations, @{$file_combinations{$sourced_file}};
992
          $file_in_overlay{$file} ||= $file_in_overlay{$sourced_file};
unknown's avatar
unknown committed
993 994
          last;
        }
995
      }
unknown's avatar
unknown committed
996
    }
997
  }
unknown's avatar
unknown committed
998 999 1000 1001

  # Add options from main file _after_ those of any includes; this allows a
  # test file to override options set by includes (eg. rpl.rpl_ddl uses this
  # to enable innodb, then disable innodb in the slave.
1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013
  $suffix =~ s/\.\w+$//;

  for (qw(.opt -master.opt -slave.opt)) {
    my @res;
    push @res, opts_from_file("$prefix[1]$suffix$_") if $over;
    if (-f "$prefix[0]$suffix$_") {
      $in_overlay = $over;
      push @res, opts_from_file("$prefix[0]$suffix$_");
    }
    push @$master_opts, @res unless /slave/;
    push @$slave_opts, @res unless /master/;
  }
unknown's avatar
unknown committed
1014

1015 1016 1017 1018 1019 1020 1021 1022 1023 1024
  # for combinations we need to make sure that its suite object is loaded,
  # even if this file does not belong to a current suite!
  my $comb_file = "$suffix.combinations";
  $suite = load_suite_for_file($comb_file) if $prefix[0] eq '';
  my @comb;
  unless ($suite->{skip}) {
    @comb = combinations_from_file($over, "$prefix[0]$comb_file");
    push @comb, combinations_from_file(undef, "$prefix[1]$comb_file") if $over;
  }
  push @combinations, [ @comb ];
Sergei Golubchik's avatar
Sergei Golubchik committed
1025

unknown's avatar
unknown committed
1026
  # Save results so we can reuse without parsing if seen again.
Sergei Golubchik's avatar
Sergei Golubchik committed
1027 1028 1029
  $file_to_tags{$file}= $tags;
  $file_to_master_opts{$file}= $master_opts;
  $file_to_slave_opts{$file}= $slave_opts;
1030
  $file_combinations{$file}= [ uniq(@combinations) ];
1031
  $file_in_overlay{$file} = 1 if $in_overlay;
Sergei Golubchik's avatar
Sergei Golubchik committed
1032
  return @{$tags};
unknown's avatar
unknown committed
1033 1034 1035
}

sub tags_from_test_file {
1036 1037
  my ($tinfo)= @_;
  my $file = $tinfo->{path};
unknown's avatar
unknown committed
1038

Sergei Golubchik's avatar
Sergei Golubchik committed
1039 1040 1041 1042
  # a suite may generate tests that don't map to real *.test files
  # see unit suite for an example.
  return ([], []) unless -f $file;

1043
  for (get_tags_from_file($file, $tinfo->{suite}))
unknown's avatar
unknown committed
1044 1045 1046
  {
    $tinfo->{$_->[0]}= $_->[1];
  }
Sergei Golubchik's avatar
Sergei Golubchik committed
1047
  return ($file_to_master_opts{$file}, $file_to_slave_opts{$file});
1048 1049
}

unknown's avatar
unknown committed
1050 1051 1052 1053 1054 1055 1056 1057 1058 1059
sub unspace {
  my $string= shift;
  my $quote=  shift;
  $string =~ s/[ \t]/\x11/g;
  return "$quote$string$quote";
}


sub opts_from_file ($) {
  my $file=  shift;
1060
  local $_;
unknown's avatar
unknown committed
1061

Sergei Golubchik's avatar
Sergei Golubchik committed
1062
  return () unless -f $file;
unknown's avatar
unknown committed
1063

1064
  open(FILE, '<', $file) or mtr_error("can't open file \"$file\": $!");
unknown's avatar
unknown committed
1065 1066 1067 1068 1069
  my @args;
  while ( <FILE> )
  {
    chomp;

1070
    #    --init_connect=set @a='a\\0c'
unknown's avatar
unknown committed
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
    s/^\s+//;                           # Remove leading space
    s/\s+$//;                           # Remove ending space

    # This is strange, but we need to fill whitespace inside
    # quotes with something, to remove later. We do this to
    # be able to split on space. Else, we have trouble with
    # options like
    #
    #   --someopt="--insideopt1 --insideopt2"
    #
    # But still with this, we are not 100% sure it is right,
    # we need a shell to do it right.

    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;

    foreach my $arg (split(/[ \t]+/))
    {
      $arg =~ tr/\x11\x0a\x0b/ \'\"/;     # Put back real chars
      # The outermost quotes has to go
      $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/
        or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/;
      $arg =~ s/\\\\/\\/g;

      # Do not pass empty string since my_getopt is not capable to handle it.
      if (length($arg)) {
	push(@args, $arg);
      }
    }
  }
  close FILE;
Sergei Golubchik's avatar
Sergei Golubchik committed
1104
  return @args;
unknown's avatar
unknown committed
1105
}
1106

unknown's avatar
unknown committed
1107
1;
Sergei Golubchik's avatar
Sergei Golubchik committed
1108