1# -*- cperl -*-
2# Copyright (c) 2005, 2011, Oracle and/or its affiliates.
3# Copyright (c) 2010, 2011 Monty Program Ab
4#
5# This program is free software; you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation; version 2 of the License.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License
15# along with this program; if not, write to the Free Software
16# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1335  USA
17
18# This is a library file used by the Perl version of mysql-test-run,
19# and is part of the translation of the Bourne shell script with the
20# same name.
21
22package mtr_cases;
23use strict;
24
25use base qw(Exporter);
26our @EXPORT= qw(collect_option collect_test_cases collect_default_suites);
27
28use Carp;
29
30use mtr_report;
31use mtr_match;
32
33# Options used for the collect phase
34our $skip_rpl;
35our $do_test;
36our $skip_test;
37our $binlog_format;
38our $enable_disabled;
39
40sub collect_option {
41  my ($opt, $value)= @_;
42
43  # Evaluate $opt as string to use "Getopt::Long::Callback legacy API"
44  my $opt_name = "$opt";
45
46  # Convert - to _ in option name
47  $opt_name =~ s/-/_/g;
48  no strict 'refs';
49  ${$opt_name}= $value;
50}
51
52use File::Basename;
53use File::Spec::Functions qw /splitdir/;
54use IO::File();
55use My::Config;
56use My::Platform;
57use My::Test;
58use My::Find;
59use My::Suite;
60
61# locate plugin suites, depending on whether it's a build tree or installed
62my @plugin_suitedirs;
63my $plugin_suitedir_regex;
64my $overlay_regex;
65
66if (-d '../sql') {
67  @plugin_suitedirs= ('storage/*/mysql-test', 'plugin/*/mysql-test', 'storage/*/*/mysql-test', );
68  $overlay_regex= '\b(?:storage|plugin|storage[/][^/]*)/(\w+)/mysql-test\b';
69} else {
70  @plugin_suitedirs= ('mysql-test/plugin/*');
71  $overlay_regex= '\bmysql-test/plugin/(\w+)\b';
72}
73$plugin_suitedir_regex= $overlay_regex;
74$plugin_suitedir_regex=~ s/\Q(\w+)\E/\\w+/;
75
76# Precompiled regex's for tests to do or skip
77my $do_test_reg;
78my $skip_test_reg;
79
80my %suites;
81
82sub init_pattern {
83  my ($from, $what)= @_;
84  return undef unless defined $from;
85  if ( $from =~ /^[a-z0-9\.]*$/ ) {
86    # Does not contain any regex (except . that we allow as
87    # separator betwen suite and testname), make the pattern match
88    # beginning of string
89    $from= "^$from";
90    mtr_verbose("$what='$from'");
91  }
92  # Check that pattern is a valid regex
93  eval { "" =~/$from/; 1 } or
94    mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@");
95  return $from;
96}
97
98
99##############################################################################
100#
101#  Collect information about test cases to be run
102#
103##############################################################################
104
105sub collect_test_cases ($$$$) {
106  my $opt_reorder= shift; # True if we're reordering tests
107  my $suites= shift; # Semicolon separated list of test suites
108  my $opt_cases= shift;
109  my $opt_skip_test_list= shift;
110  my $cases= []; # Array of hash(one hash for each testcase)
111
112  $do_test_reg= init_pattern($do_test, "--do-test");
113  $skip_test_reg= init_pattern($skip_test, "--skip-test");
114
115  parse_disabled($_) for @$opt_skip_test_list;
116
117  # If not reordering, we also shouldn't group by suites, unless
118  # no test cases were named.
119  # This also affects some logic in the loop following this.
120  if ($opt_reorder or !@$opt_cases)
121  {
122    foreach my $suite (split(",", $suites))
123    {
124      push(@$cases, collect_suite_name($suite, $opt_cases));
125    }
126  }
127
128  if ( @$opt_cases )
129  {
130    # A list of tests was specified on the command line
131    # Check that the tests specified were found
132    # in at least one suite
133    foreach my $test_name_spec ( @$opt_cases )
134    {
135      my $found= 0;
136      my ($sname, $tname)= split_testname($test_name_spec);
137      foreach my $test ( @$cases )
138      {
139	last unless $opt_reorder;
140	# test->{name} is always in suite.name format
141	if ( $test->{name} =~ /^$sname.*\.$tname$/ )
142	{
143	  $found= 1;
144	  last;
145	}
146      }
147      if ( not $found )
148      {
149	$sname= "main" if !$opt_reorder and !$sname;
150	mtr_error("Could not find '$tname' in '$suites' suite(s)") unless $sname;
151	# If suite was part of name, find it there, may come with combinations
152	my @this_case = collect_suite_name($sname, [ $test_name_spec ]);
153	if (@this_case)
154        {
155	  push (@$cases, @this_case);
156	}
157	else
158	{
159	  mtr_error("Could not find '$tname' in '$sname' suite");
160        }
161      }
162    }
163  }
164
165  if ( $opt_reorder )
166  {
167    # Make a mapping of test name to a string that represents how that test
168    # should be sorted among the other tests.  Put the most important criterion
169    # first, then a sub-criterion, then sub-sub-criterion, etc.
170    foreach my $tinfo (@$cases)
171    {
172      my @criteria = ();
173
174      #
175      # Collect the criteria for sorting, in order of importance.
176      # Note that criteria are also used in mysql-test-run.pl to
177      # schedule tests to workers, and it preferres tests that have
178      # *identical* criteria. That is, test name is *not* part of
179      # the criteria, but it's part of the sorting function below.
180      #
181      push(@criteria, $tinfo->{template_path});
182      for (qw(master_opt slave_opt)) {
183        # Group test with equal options together.
184        # Ending with "~" makes empty sort later than filled
185        my $opts= $tinfo->{$_} ? $tinfo->{$_} : [];
186        push(@criteria, join("!", sort @{$opts}) . "~");
187      }
188      $tinfo->{criteria}= join(" ", @criteria);
189    }
190
191    @$cases = sort {                            # ORDER BY
192      $b->{skip} <=> $a->{skip}           ||    #   skipped DESC,
193      $a->{criteria} cmp $b->{criteria}   ||    #   criteria ASC,
194      $b->{long_test} <=> $a->{long_test} ||    #   long_test DESC,
195      $a->{name} cmp $b->{name}                 #   name ASC
196    } @$cases;
197  }
198
199  return $cases;
200}
201
202
203# Returns (suitename, testname, combinations....)
204sub split_testname {
205  my ($test_name)= @_;
206
207  # If .test file name is used, get rid of directory part
208  $test_name= basename($test_name) if $test_name =~ /\.test$/;
209
210  # Then, get the combinations:
211  my ($test_name, @combs) = split /,/, $test_name;
212
213  # Now split name on .'s
214  my @parts= split(/\./, $test_name);
215
216  if (@parts == 1){
217    # Only testname given, ex: alias
218    return (undef , $parts[0], @combs);
219  } elsif (@parts == 2) {
220    # Either testname.test or suite.testname given
221    # Ex. main.alias or alias.test
222
223    if ($parts[1] eq "test")
224    {
225      return (undef , $parts[0], @combs);
226    }
227    else
228    {
229      return ($parts[0], $parts[1], @combs);
230    }
231  }
232
233  mtr_error("Illegal format of test name: $test_name");
234}
235
236our %file_to_tags;
237our %file_to_master_opts;
238our %file_to_slave_opts;
239our %file_combinations;
240our %skip_combinations;
241our %file_in_overlay;
242
243sub load_suite_object {
244  my ($suitename, $suitedir) = @_;
245  my $suite;
246  unless (defined $suites{$suitename}) {
247    if (-f "$suitedir/suite.pm") {
248      $suite= do "$suitedir/suite.pm";
249      mtr_error("Cannot load $suitedir/suite.pm: $@") if $@;
250      unless (ref $suite) {
251        my $comment = $suite;
252        $suite = My::Suite->new();
253        $suite->{skip} = $comment;
254      }
255    } else {
256      $suite = My::Suite->new();
257    }
258
259    $suites{$suitename} = $suite;
260
261    # add suite skiplist to a global hash, so that we can check it
262    # with only one lookup
263    my %suite_skiplist = $suite->skip_combinations();
264    while (my ($file, $skiplist) = each %suite_skiplist) {
265      $file =~ s/\.\w+$/\.combinations/;
266      if (ref $skiplist) {
267        $skip_combinations{"$suitedir/$file => $_"} = 1 for (@$skiplist);
268      } else {
269        $skip_combinations{"$suitedir/$file"} = $skiplist;
270      }
271    }
272  }
273  return $suites{$suitename};
274}
275
276
277# returns a pair of (suite, suitedir)
278sub suite_for_file($) {
279  my ($file) = @_;
280  return ($2, $1) if $file =~ m@^(.*/$plugin_suitedir_regex/(\w+))/@o;
281  return ($2, $1) if $file =~ m@^(.*/mysql-test/suite/(\w+))/@;
282  return ('main', $1) if $file =~ m@^(.*/mysql-test)/@;
283  mtr_error("Cannot determine suite for $file");
284}
285
286sub combinations_from_file($$)
287{
288  my ($in_overlay, $filename) = @_;
289  my @combs;
290  if ($skip_combinations{$filename}) {
291    @combs = ({ skip => $skip_combinations{$filename} });
292  } else {
293    return () if @::opt_combinations or not -f $filename;
294    return () if ::using_extern();
295    # Read combinations file in my.cnf format
296    mtr_verbose("Read combinations file $filename");
297    my $config= My::Config->new($filename);
298    foreach my $group ($config->option_groups()) {
299      my $comb= { name => $group->name(), comb_opt => [] };
300      next if $skip_combinations{"$filename => $comb->{name}"};
301      foreach my $option ( $group->options() ) {
302        push(@{$comb->{comb_opt}}, $option->option());
303      }
304      $comb->{in_overlay} = 1 if $in_overlay;
305      push @combs, $comb;
306    }
307    @combs = ({ skip => 'Requires: ' . basename($filename, '.combinations') }) unless @combs;
308  }
309  @combs;
310}
311
312our %disabled;
313our %disabled_wildcards;
314sub parse_disabled {
315  my ($filename, $suitename) = @_;
316
317  if (open(DISABLED, $filename)) {
318    while (<DISABLED>) {
319      chomp;
320      next if /^\s*#/ or /^\s*$/;
321      mtr_error("Syntax error in $filename line $.")
322        unless /^\s*(?:([-0-9A-Za-z_\/]+)\.)?([-0-9A-Za-z_#\*]+)\s*:\s*(.*?)\s*$/;
323      mtr_error("Wrong suite name in $filename line $.: suitename = $suitename but the file says $1")
324        if defined $1 and defined $suitename and $1 ne $suitename;
325      my ($sname, $casename, $text)= (($1 || $suitename || ''), $2, $3);
326
327      if ($casename =~ /\*/) {
328        # Wildcard
329        $disabled_wildcards{$sname . ".$casename"}= $text;
330      }
331      else {
332        $disabled{$sname . ".$casename"}= $text;
333      }
334    }
335    close DISABLED;
336  }
337}
338
339#
340# load suite.pm files from plugin suites
341# collect the list of default plugin suites.
342# XXX currently it does not support nested suites
343#
344sub collect_default_suites(@)
345{
346  use File::Find;
347  my @dirs;
348  find(sub {
349      push @dirs, [$File::Find::topdir, $File::Find::name]
350        if -d and -f "$File::Find::name/suite.pm";
351  }, my_find_dir(dirname($::glob_mysql_test_dir), \@plugin_suitedirs));
352
353  for (@dirs) {
354    my ($plugin_root, $dir) = @$_;
355    my $sname= substr $dir, 1 + length $plugin_root;
356    # ignore overlays here, otherwise we'd need accurate
357    # duplicate detection with overlay support for the default suite list
358    next if $sname eq 'main' or -d "$::glob_mysql_test_dir/suite/$sname";
359    my $s = load_suite_object($sname, $dir);
360    push @_, $sname if $s->is_default();
361  }
362  return @_;
363}
364
365
366#
367# processes one user-specified suite name.
368# it could contain wildcards, e.g engines/*
369#
370sub collect_suite_name($$)
371{
372  my $suitename= shift;  # Test suite name
373  my $opt_cases= shift;
374  my $over;
375  my %suites;
376
377  ($suitename, $over) = split '-', $suitename;
378
379  if ( $suitename ne "main" )
380  {
381    # Allow suite to be path to "some dir" if $suitename has at least
382    # one directory part
383    if ( -d $suitename and splitdir($suitename) > 1 ) {
384      $suites{$suitename} = [ $suitename ];
385      mtr_report(" - from '$suitename'");
386    }
387    else
388    {
389      my @dirs = my_find_dir(dirname($::glob_mysql_test_dir),
390                             ["mysql-test/suite", @plugin_suitedirs ],
391                             $suitename);
392      #
393      # if $suitename contained wildcards, we'll have many suites and
394      # their overlays here. Let's group them appropriately.
395      #
396      for (@dirs) {
397        m@^.*/(?:mysql-test/suite|$plugin_suitedir_regex)/(.*)$@o or confess $_;
398        push @{$suites{$1}}, $_;
399      }
400    }
401  } else {
402    $suites{$suitename} = [ $::glob_mysql_test_dir . "/main",
403                            my_find_dir(dirname($::glob_mysql_test_dir),
404                                        [ @plugin_suitedirs ],
405                                        'main', NOT_REQUIRED) ];
406  }
407
408  my @cases;
409  while (my ($name, $dirs) = each %suites) {
410    #
411    # XXX at the moment, for simplicity, we will not fully support one
412    # plugin overlaying a suite of another plugin. Only suites in the main
413    # mysql-test directory can be safely overlayed. To be fixed, when
414    # needed.  To fix it we'll need a smarter overlay detection (that is,
415    # detection of what is an overlay and what is the "original" suite)
416    # than simply "prefer directories with more files".
417    #
418    if ($dirs->[0] !~ m@/mysql-test/suite/$name$@) {
419      # prefer directories with more files
420      @$dirs = sort { scalar(<$a/*>) <=> scalar(<$b/*>) } @$dirs;
421    }
422    push @cases, collect_one_suite($opt_cases, $name, $over, @$dirs);
423  }
424  return @cases;
425}
426
427sub collect_one_suite {
428  my ($opt_cases, $suitename, $over, $suitedir, @overlays) = @_;
429
430  mtr_verbose("Collecting: $suitename");
431  mtr_verbose("suitedir: $suitedir");
432  mtr_verbose("overlays: @overlays") if @overlays;
433
434  # we always need to process the parent suite, even if we won't use any
435  # test from it.
436  my @cases= process_suite($suitename, undef, $suitedir,
437                           $over ? [ '*BOGUS*' ] : $opt_cases);
438
439  # when working with overlays we cannot use global caches like
440  # %file_to_tags. Because the same file may have different tags
441  # with and without overlays. For example, when a.test includes
442  # b.inc, which includes c.inc, and an overlay replaces c.inc.
443  # In this case b.inc may have different tags in the overlay,
444  # despite the fact that b.inc itself is not replaced.
445  for (@overlays) {
446    local %file_to_tags = ();
447    local %file_to_master_opts = ();
448    local %file_to_slave_opts = ();
449    local %file_combinations = ();
450    local %file_in_overlay = ();
451
452    confess $_ unless m@/$overlay_regex/@o;
453    next unless defined $over and ($over eq '' or $over eq $1);
454    push @cases,
455    # don't add cases that take *all* data from the parent suite
456      grep { $_->{in_overlay} } process_suite($suitename, $1, $_, $opt_cases);
457  }
458  return @cases;
459}
460
461sub process_suite {
462  my ($basename, $overname, $suitedir, $opt_cases) = @_;
463  my $suitename;
464  my $parent;
465
466  if ($overname) {
467    $parent = $suites{$basename};
468    confess unless $parent;
469    $suitename = $basename . '-' . $overname;
470  } else {
471    $suitename = $basename;
472  }
473
474  my $suite = load_suite_object($suitename, (($suitename eq "main") ?
475					     $::glob_mysql_test_dir :
476					     $suitedir));
477
478  #
479  # Read suite config files, unless it was done aleady
480  #
481  unless (defined $suite->{name}) {
482    $suite->{name} = $suitename;
483    $suite->{dir}  = $suitedir;
484
485    # First, we need to find where the test files and result files are.
486    # test files are usually in a t/ dir inside suite dir. Or directly in the
487    # suite dir. result files are in a r/ dir or in the suite dir.
488    # Overlay uses t/ and r/ if and only if its parent does.
489    if ($parent) {
490      $suite->{parent} = $parent;
491      my $tdir = $parent->{tdir};
492      my $rdir = $parent->{rdir};
493      substr($tdir, 0, length $parent->{dir}) = $suitedir;
494      substr($rdir, 0, length $parent->{dir}) = $suitedir;
495      $suite->{tdir} = $tdir if -d $tdir;
496      $suite->{rdir} = $rdir if -d $rdir;
497    } else {
498      my $tdir= "$suitedir/t";
499      my $rdir= "$suitedir/r";
500      $suite->{tdir} = -d $tdir ? $tdir : $suitedir;
501      $suite->{rdir} = -d $rdir ? $rdir : $suite->{tdir};
502    }
503
504    mtr_verbose("testdir: " . $suite->{tdir});
505    mtr_verbose( "resdir: " . $suite->{rdir});
506
507    # disabled.def
508    parse_disabled($suite->{dir} .'/disabled.def', $suitename);
509    parse_disabled($suite->{dir} .'/t/disabled.def', $suitename);
510
511    # combinations
512    if (@::opt_combinations)
513    {
514      # take the combination from command-line
515      mtr_verbose("Take the combination from command line");
516      foreach my $combination (@::opt_combinations) {
517	my $comb= {};
518	$comb->{name}= $combination;
519	push(@{$comb->{comb_opt}}, $combination);
520        push @{$suite->{combinations}}, $comb;
521      }
522    }
523    else
524    {
525      my @combs;
526      my $from =  "$suitedir/combinations";
527      @combs = combinations_from_file($parent, $from) unless $suite->{skip};
528      $suite->{combinations} = [ @combs ];
529      #  in overlays it's a union of parent's and overlay's files.
530      unshift @{$suite->{combinations}},
531        grep { not $skip_combinations{"$from => $_->{name}"} }
532          @{$parent->{combinations}} if $parent;
533    }
534
535    # suite.opt
536    #  in overlays it's a union of parent's and overlay's files.
537    $suite->{opts} = [ opts_from_file("$suitedir/suite.opt") ];
538    $suite->{in_overlay} = 1 if $parent and @{$suite->{opts}};
539    unshift @{$suite->{opts}}, @{$parent->{opts}} if $parent;
540
541    $suite->{cases} = [ $suite->list_cases($suite->{tdir}) ];
542  }
543
544  my %all_cases;
545  %all_cases = map { $_ => $parent->{tdir} } @{$parent->{cases}} if $parent;
546  $all_cases{$_} = $suite->{tdir} for @{$suite->{cases}};
547
548  my @cases;
549  if (@$opt_cases) {
550    # Collect in specified order
551    foreach my $test_name_spec ( @$opt_cases )
552    {
553      my ($sname, $tname, @combs)= split_testname($test_name_spec);
554
555      # Check correct suite if suitename is defined
556      next if defined $sname and $sname ne $suitename
557                             and $sname ne "$basename-";
558
559      next unless $all_cases{$tname};
560      push @cases, collect_one_test_case($suite, $all_cases{$tname}, $tname, @combs);
561    }
562  } else {
563    for (sort keys %all_cases)
564    {
565      # Skip tests that do not match the --do-test= filter
566      next if $do_test_reg and not /$do_test_reg/o;
567      push @cases, collect_one_test_case($suite, $all_cases{$_}, $_);
568    }
569  }
570
571  @cases;
572}
573
574#
575# Read options from the given opt file and append them as an array
576# to $tinfo->{$opt_name}
577#
578sub process_opts {
579  my ($tinfo, $opt_name)= @_;
580
581  my @opts= @{$tinfo->{$opt_name}};
582  $tinfo->{$opt_name} = [];
583
584  foreach my $opt (@opts)
585  {
586    my $value;
587
588    # The opt file is used both to send special options to the mysqld
589    # as well as pass special test case specific options to this
590    # script
591
592    $value= mtr_match_prefix($opt, "--timezone=");
593    if ( defined $value )
594    {
595      $tinfo->{'timezone'}= $value;
596      next;
597    }
598
599    # If we set default time zone, remove the one we have
600    $value= mtr_match_prefix($opt, "--default-time-zone=");
601    if ( defined $value )
602    {
603      # Set timezone for this test case to something different
604      $tinfo->{'timezone'}= "GMT-8";
605      # Fallthrough, add the --default-time-zone option
606    }
607
608    # Ok, this was a real option, add it
609    push(@{$tinfo->{$opt_name}}, $opt);
610  }
611}
612
613sub make_combinations($$@)
614{
615  my ($test, $test_combs, @combinations) = @_;
616
617  return ($test) if $test->{'skip'} or not @combinations;
618  if ($combinations[0]->{skip}) {
619    $test->{skip} = 1;
620    $test->{comment} = $combinations[0]->{skip} unless $test->{comment};
621    confess unless @combinations == 1;
622    return ($test);
623  }
624
625  foreach my $comb (@combinations)
626  {
627    # Skip all other combinations if the values they change
628    # are already fixed in master_opt or slave_opt
629    # (empty combinations are not considered a subset of anything)
630    if (@{$comb->{comb_opt}} &&
631        My::Options::is_subset($test->{master_opt}, $comb->{comb_opt}) &&
632        My::Options::is_subset($test->{slave_opt}, $comb->{comb_opt}) ){
633
634      $test_combs->{$comb->{name}} = 2;
635
636      # Add combination name short name
637      push @{$test->{combinations}}, $comb->{name};
638
639      return ($test);
640    }
641
642    # Skip all other combinations, if this combination is forced
643    if ($test_combs->{$comb->{name}}) {
644      @combinations = ($comb); # run the loop below only for this combination
645      $test_combs->{$comb->{name}} = 2;
646      last;
647    }
648  }
649
650  my @cases;
651  foreach my $comb (@combinations)
652  {
653    # Copy test options
654    my $new_test= $test->copy();
655
656    # Prepend the combination options to master_opt and slave_opt
657    # (on the command line combinations go *before* .opt files)
658    unshift @{$new_test->{master_opt}}, @{$comb->{comb_opt}};
659    unshift @{$new_test->{slave_opt}}, @{$comb->{comb_opt}};
660
661    # Add combination name short name
662    push @{$new_test->{combinations}}, $comb->{name};
663
664    $new_test->{in_overlay} = 1 if $comb->{in_overlay};
665
666    # Add the new test to new test cases list
667    push(@cases, $new_test);
668  }
669  return @cases;
670}
671
672
673sub find_file_in_dirs
674{
675  my ($tinfo, $slot, $filename) = @_;
676  my $parent = $tinfo->{suite}->{parent};
677  my $f = $tinfo->{suite}->{$slot} . '/' . $filename;
678
679  if (-f $f) {
680    $tinfo->{in_overlay} = 1 if $parent;
681    return $f;
682  }
683
684  return undef unless $parent;
685
686  $f = $parent->{$slot} . '/' . $filename;
687  return -f $f ? $f : undef;
688}
689
690##############################################################################
691#
692#  Collect information about a single test case
693#
694##############################################################################
695
696sub collect_one_test_case {
697  my $suite     =  shift;
698  my $tpath     =  shift;
699  my $tname     =  shift;
700  my %test_combs = map { $_ => 1 } @_;
701  my $suitename =  $suite->{name};
702  my $name      = "$suitename.$tname";
703  my $filename  = "$tpath/${tname}.test";
704
705  # ----------------------------------------------------------------------
706  # Set defaults
707  # ----------------------------------------------------------------------
708  my $tinfo= My::Test->new
709    (
710     name          => $name,
711     shortname     => $tname,
712     path          => $filename,
713     suite         => $suite,
714     in_overlay    => $suite->{in_overlay},
715     master_opt    => [ @{$suite->{opts}} ],
716     slave_opt     => [ @{$suite->{opts}} ],
717    );
718
719  # ----------------------------------------------------------------------
720  # Skip some tests but include in list, just mark them as skipped
721  # ----------------------------------------------------------------------
722  if ( $skip_test_reg and ($tname =~ /$skip_test_reg/o or
723                            $name =~ /$skip_test_reg/o))
724  {
725    $tinfo->{'skip'}= 1;
726    return $tinfo;
727  }
728
729  # ----------------------------------------------------------------------
730  # Check for disabled tests
731  # ----------------------------------------------------------------------
732  my $disable = $disabled{".$tname"} || $disabled{$name};
733  if (not $disable) {
734    foreach my $w (keys %disabled_wildcards) {
735      if ($name =~ /^$w/) {
736        $disable= $disabled_wildcards{$w};
737        last;
738      }
739    }
740  }
741  if (not defined $disable and $suite->{parent}) {
742    $disable = $disabled{$suite->{parent}->{name} . ".$tname"};
743  }
744  if (defined $disable)
745  {
746    $tinfo->{comment}= $disable;
747    if ( $enable_disabled )
748    {
749      # User has selected to run all disabled tests
750      mtr_report(" - $tinfo->{name} will be run although it's been disabled\n",
751		 "  due to '$disable'");
752    }
753    else
754    {
755      $tinfo->{'skip'}= 1;
756      $tinfo->{'disable'}= 1;   # Sub type of 'skip'
757
758      # we can stop test file processing early if the test if disabled, but
759      # only if we're not in the overlay.  for overlays we want to know exactly
760      # whether the test is ignored (in_overlay=0) or disabled.
761      return $tinfo unless $suite->{parent};
762    }
763  }
764
765  if ($suite->{skip}) {
766    $tinfo->{skip}= 1;
767    $tinfo->{comment}= $suite->{skip} unless $tinfo->{comment};
768    return $tinfo unless $suite->{parent};
769  }
770
771  # ----------------------------------------------------------------------
772  # Check for test specific config file
773  # ----------------------------------------------------------------------
774  my $test_cnf_file= find_file_in_dirs($tinfo, tdir => "$tname.cnf");
775  if ($test_cnf_file ) {
776    # Specifies the configuration file to use for this test
777    $tinfo->{'template_path'}= $test_cnf_file;
778  }
779
780  # ----------------------------------------------------------------------
781  # master sh
782  # ----------------------------------------------------------------------
783  my $master_sh= find_file_in_dirs($tinfo, tdir => "$tname-master.sh");
784  if ($master_sh)
785  {
786    if ( IS_WIN32PERL )
787    {
788      $tinfo->{'skip'}= 1;
789      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
790      return $tinfo;
791    }
792    else
793    {
794      $tinfo->{'master_sh'}= $master_sh;
795    }
796  }
797
798  # ----------------------------------------------------------------------
799  # slave sh
800  # ----------------------------------------------------------------------
801  my $slave_sh= find_file_in_dirs($tinfo, tdir => "$tname-slave.sh");
802  if ($slave_sh)
803  {
804    if ( IS_WIN32PERL )
805    {
806      $tinfo->{'skip'}= 1;
807      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
808      return $tinfo;
809    }
810    else
811    {
812      $tinfo->{'slave_sh'}= $slave_sh;
813    }
814  }
815
816  my ($master_opts, $slave_opts)= tags_from_test_file($tinfo);
817  $tinfo->{in_overlay} = 1 if $file_in_overlay{$filename};
818
819  if ( $tinfo->{'big_test'} and ! $::opt_big_test )
820  {
821    $tinfo->{'skip'}= 1;
822    $tinfo->{'comment'}= "Test needs --big-test";
823    return $tinfo
824  }
825
826  if ( $tinfo->{'big_test'} )
827  {
828    # All 'big_test' takes a long time to run
829    $tinfo->{'long_test'}= 1;
830  }
831
832  if ( ! $tinfo->{'big_test'} and $::opt_big_test > 1 )
833  {
834    $tinfo->{'skip'}= 1;
835    $tinfo->{'comment'}= "Small test";
836    return $tinfo
837  }
838
839  if ( $tinfo->{'rpl_test'} )
840  {
841    if ( $skip_rpl )
842    {
843      $tinfo->{'skip'}= 1;
844      $tinfo->{'comment'}= "No replication tests";
845      return $tinfo;
846    }
847  }
848
849  # ----------------------------------------------------------------------
850  # Find config file to use if not already selected in <testname>.opt file
851  # ----------------------------------------------------------------------
852  if (not $tinfo->{template_path} )
853  {
854    my $config= find_file_in_dirs($tinfo, dir => 'my.cnf');
855    if (not $config)
856    {
857      # Suite has no config, autodetect which one to use
858      if ($tinfo->{rpl_test}) {
859        $config= "suite/rpl/my.cnf";
860      } else {
861        $config= "include/default_my.cnf";
862      }
863    }
864    $tinfo->{template_path}= $config;
865  }
866
867  # ----------------------------------------------------------------------
868  # Append mysqld extra options to master and slave, as appropriate
869  # ----------------------------------------------------------------------
870  push @{$tinfo->{'master_opt'}}, @$master_opts, @::opt_extra_mysqld_opt;
871  push @{$tinfo->{'slave_opt'}}, @$slave_opts, @::opt_extra_mysqld_opt;
872
873  process_opts($tinfo, 'master_opt');
874  process_opts($tinfo, 'slave_opt');
875
876  my @cases = ($tinfo);
877  for my $comb ($suite->{combinations}, @{$file_combinations{$filename}})
878  {
879    @cases = map make_combinations($_, \%test_combs, @{$comb}), @cases;
880  }
881  my @no_combs = grep { $test_combs{$_} == 1 } keys %test_combs;
882  if (@no_combs) {
883    mtr_error("Could not run $name with '".(
884        join(',', sort @no_combs))."' combination(s)");
885  }
886
887  for $tinfo (@cases) {
888    #
889    # Now we find a result file for every test file. It's a bit complicated.
890    # For a test foobar.test in the combination pair {aa,bb}, and in the
891    # overlay "rty" to the suite "qwe", in other words, for the
892    # that that mtr prints as
893    #   ...
894    #   qwe-rty.foobar                   'aa,bb'  [ pass ]
895    #   ...
896    # the result can be expected in
897    #  * either .rdiff or .result file
898    #  * either in the overlay or in the original suite
899    #  * with or without combinations in the file name.
900    # which means any of the following 15 file names can be used:
901    #
902    #  1    rty/r/foo,aa,bb.result
903    #  2    rty/r/foo,aa,bb.rdiff
904    #  3    qwe/r/foo,aa,bb.result
905    #  4    qwe/r/foo,aa,bb.rdiff
906    #  5    rty/r/foo,aa.result
907    #  6    rty/r/foo,aa.rdiff
908    #  7    qwe/r/foo,aa.result
909    #  8    qwe/r/foo,aa.rdiff
910    #  9    rty/r/foo,bb.result
911    # 10    rty/r/foo,bb.rdiff
912    # 11    qwe/r/foo,bb.result
913    # 12    qwe/r/foo,bb.rdiff
914    # 13    rty/r/foo.result
915    # 14    rty/r/foo.rdiff
916    # 15    qwe/r/foo.result
917    #
918    # They are listed, precisely, in the order of preference.
919    # mtr will walk that list from top to bottom and the first file that
920    # is found will be used.
921    #
922    # If this found file is a .rdiff, mtr continues walking down the list
923    # until the first .result file is found.
924    # A .rdiff is applied to that .result.
925    #
926    my $re ='';
927
928    if ($tinfo->{combinations}) {
929      $re = '(?:' . join('|', @{$tinfo->{combinations}}) . ')';
930    }
931    my $resdirglob = $suite->{rdir};
932    $resdirglob.= ',' . $suite->{parent}->{rdir} if $suite->{parent};
933
934    my %files;
935    for (<{$resdirglob}/$tname*.{rdiff,result}>) {
936      my ($path, $combs, $ext) =
937                  m@^(.*)/$tname((?:,$re)*)\.(rdiff|result)$@ or next;
938      my @combs = sort split /,/, $combs;
939      $files{$_} = join '~', (                # sort files by
940        99 - scalar(@combs),                  # number of combinations DESC
941        join(',', sort @combs),               # combination names ASC
942        $path eq $suite->{rdir} ? 1 : 2,      # overlay first
943        $ext eq 'result' ? 1 : 2              # result before rdiff
944      );
945    }
946    my @results = sort { $files{$a} cmp $files{$b} } keys %files;
947
948    if (@results) {
949      my $result_file = shift @results;
950      $tinfo->{result_file} = $result_file;
951
952      if ($result_file =~ /\.rdiff$/) {
953        shift @results while $results[0] =~ /\.rdiff$/;
954        mtr_error ("$result_file has no corresponding .result file")
955          unless @results;
956        $tinfo->{base_result} = $results[0];
957
958        if (not $::exe_patch) {
959          $tinfo->{skip} = 1;
960          $tinfo->{comment} = "requires patch executable";
961        }
962      }
963    } else {
964      # No .result file exist
965      # Remember the path  where it should be
966      # saved in case of --record
967      $tinfo->{record_file}= $suite->{rdir} . "/$tname.result";
968    }
969  }
970
971  return @cases;
972}
973
974
975my $tags_map= {'big_test' => ['big_test', 1],
976               'master-slave' => ['rpl_test', 1],
977               'long_test' => ['long_test', 1],
978};
979my $tags_regex_string= join('|', keys %$tags_map);
980my $tags_regex= qr:include/($tags_regex_string)\.inc:o;
981
982# Get various tags from a file, recursively scanning also included files.
983# And get options from .opt file, also recursively for included files.
984# Return a list of [TAG_TO_SET, VALUE_TO_SET_TO] of found tags.
985# Also returns lists of options for master and slave found in .opt files.
986# Each include file is scanned only once, and subsequent calls just look up the
987# cached result.
988# We need to be a bit careful about speed here; previous version of this code
989# took forever to scan the full test suite.
990sub get_tags_from_file($$) {
991  my ($file, $suite)= @_;
992
993  return @{$file_to_tags{$file}} if exists $file_to_tags{$file};
994
995  my $F= IO::File->new($file)
996    or mtr_error("can't open file \"$file\": $!");
997
998  my $tags= [];
999  my $master_opts= [];
1000  my $slave_opts= [];
1001  my @combinations;
1002
1003  my $over = defined $suite->{parent};
1004  my $sdir = $suite->{dir};
1005  my $pdir = $suite->{parent}->{dir} if $over;
1006  my $in_overlay = 0;
1007  my $suffix = $file;
1008  my @prefix = ('');
1009
1010  # to be able to look up all auxillary files in the overlay
1011  # we split the file path in a prefix and a suffix
1012  if ($file =~ m@^$sdir/(.*)$@) {
1013    $suffix = $1;
1014    @prefix =  ("$sdir/");
1015    push @prefix, "$pdir/" if $over;
1016    $in_overlay = $over;
1017  } elsif ($over and $file =~ m@^$pdir/(.*)$@) {
1018    $suffix = $1;
1019    @prefix = map { "$_/" } $sdir, $pdir;
1020  } else {
1021    $over = 0; # file neither in $sdir nor in $pdir
1022  }
1023
1024  while (my $line= <$F>)
1025  {
1026    # Ignore comments.
1027    next if $line =~ /^\#/;
1028
1029    # Add any tag we find.
1030    if ($line =~ /$tags_regex/o)
1031    {
1032      my $to_set= $tags_map->{$1};
1033      for (my $i= 0; $i < @$to_set; $i+= 2)
1034      {
1035        push @$tags, [$to_set->[$i], $to_set->[$i+1]];
1036      }
1037    }
1038
1039    # Check for a sourced include file.
1040    if ($line =~ /^(--)?[[:space:]]*source[[:space:]]+([^;[:space:]]+)/)
1041    {
1042      my $include= $2;
1043      # The rules below must match open_file() function of mysqltest.cc
1044      # Note that for the purpose of tag collection we ignore
1045      # non-existing files, and let mysqltest handle the error
1046      # (e.g. mysqltest.test needs this)
1047      for ((map { dirname("$_$suffix") } @prefix),
1048           $sdir, $pdir, $::glob_mysql_test_dir)
1049      {
1050        next unless defined $_;
1051        my $sourced_file = "$_/$include";
1052        next if $sourced_file eq $file;
1053        if (-e $sourced_file)
1054        {
1055          push @$tags, get_tags_from_file($sourced_file, $suite);
1056          push @$master_opts, @{$file_to_master_opts{$sourced_file}};
1057          push @$slave_opts, @{$file_to_slave_opts{$sourced_file}};
1058          push @combinations, @{$file_combinations{$sourced_file}};
1059          $file_in_overlay{$file} ||= $file_in_overlay{$sourced_file};
1060          last;
1061        }
1062      }
1063    }
1064  }
1065
1066  # Add options from main file _after_ those of any includes; this allows a
1067  # test file to override options set by includes (eg. rpl.rpl_ddl uses this
1068  # to enable innodb, then disable innodb in the slave.
1069  $suffix =~ s/\.\w+$//;
1070
1071  for (qw(.opt -master.opt -slave.opt)) {
1072    my @res;
1073    push @res, opts_from_file("$prefix[1]$suffix$_") if $over;
1074    if (-f "$prefix[0]$suffix$_") {
1075      $in_overlay = $over;
1076      push @res, opts_from_file("$prefix[0]$suffix$_");
1077    }
1078    push @$master_opts, @res unless /slave/;
1079    push @$slave_opts, @res unless /master/;
1080  }
1081
1082  # for combinations we need to make sure that its suite object is loaded,
1083  # even if this file does not belong to a current suite!
1084  my $comb_file = "$suffix.combinations";
1085  $suite = load_suite_object(suite_for_file($comb_file)) if $prefix[0] eq '';
1086  my @comb;
1087  unless ($suite->{skip}) {
1088    my $from = "$prefix[0]$comb_file";
1089    @comb = combinations_from_file($over, $from);
1090    push @comb,
1091      grep { not $skip_combinations{"$from => $_->{name}"} }
1092        combinations_from_file(undef, "$prefix[1]$comb_file") if $over;
1093  }
1094  push @combinations, [ @comb ];
1095
1096  # Save results so we can reuse without parsing if seen again.
1097  $file_to_tags{$file}= $tags;
1098  $file_to_master_opts{$file}= $master_opts;
1099  $file_to_slave_opts{$file}= $slave_opts;
1100  $file_combinations{$file}= [ ::uniq(@combinations) ];
1101  $file_in_overlay{$file} = 1 if $in_overlay;
1102
1103  return @{$tags};
1104}
1105
1106sub tags_from_test_file {
1107  my ($tinfo)= @_;
1108  my $file = $tinfo->{path};
1109
1110  # a suite may generate tests that don't map to real *.test files
1111  # see unit suite for an example.
1112  return ([], []) unless -f $file;
1113
1114  for (get_tags_from_file($file, $tinfo->{suite}))
1115  {
1116    $tinfo->{$_->[0]}= $_->[1];
1117  }
1118  return ($file_to_master_opts{$file}, $file_to_slave_opts{$file});
1119}
1120
1121sub unspace {
1122  my $string= shift;
1123  my $quote=  shift;
1124  $string =~ s/[ \t]/\x11/g;
1125  return "$quote$string$quote";
1126}
1127
1128
1129sub opts_from_file ($) {
1130  my $file=  shift;
1131  local $_;
1132
1133  return () unless -f $file;
1134
1135  open(FILE, '<', $file) or mtr_error("can't open file \"$file\": $!");
1136  my @args;
1137  while ( <FILE> )
1138  {
1139    chomp;
1140
1141    #    --init_connect=set @a='a\\0c'
1142    s/^\s+//;                           # Remove leading space
1143    s/\s+$//;                           # Remove ending space
1144
1145    # This is strange, but we need to fill whitespace inside
1146    # quotes with something, to remove later. We do this to
1147    # be able to split on space. Else, we have trouble with
1148    # options like
1149    #
1150    #   --someopt="--insideopt1 --insideopt2"
1151    #
1152    # But still with this, we are not 100% sure it is right,
1153    # we need a shell to do it right.
1154
1155    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
1156    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
1157    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
1158    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
1159
1160    foreach my $arg (split(/[ \t]+/))
1161    {
1162      $arg =~ tr/\x11\x0a\x0b/ \'\"/;     # Put back real chars
1163      # The outermost quotes has to go
1164      $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/
1165        or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/;
1166      $arg =~ s/\\\\/\\/g;
1167
1168      # Do not pass empty string since my_getopt is not capable to handle it.
1169      if (length($arg)) {
1170	push(@args, $arg);
1171      }
1172    }
1173  }
1174  close FILE;
1175  return @args;
1176}
1177
11781;
1179
1180