1# -*- cperl -*-
2# Copyright (c) 2005, 2017, Oracle and/or its affiliates. All rights reserved.
3#
4# This program is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License, version 2.0,
6# as published by the Free Software Foundation.
7#
8# This program is also distributed with certain software (including
9# but not limited to OpenSSL) that is licensed under separate terms,
10# as designated in a particular file or component or in included license
11# documentation.  The authors of MySQL hereby grant you an additional
12# permission to link the program and your derivative works with the
13# separately licensed software that they have included with MySQL.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License, version 2.0, for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
23
24# This is a library file used by the Perl version of mysql-test-run,
25# and is part of the translation of the Bourne shell script with the
26# same name.
27
28package mtr_cases;
29use strict;
30
31use base qw(Exporter);
32our @EXPORT= qw(collect_option collect_test_cases);
33
34use mtr_report;
35use mtr_match;
36
37# Options used for the collect phase
38our $start_from;
39our $print_testcases;
40our $skip_rpl;
41our $do_test;
42our $skip_test;
43our $skip_combinations;
44our $binlog_format;
45our $enable_disabled;
46our $default_storage_engine;
47our $opt_with_ndbcluster_only;
48our $defaults_file;
49our $defaults_extra_file;
50our $quick_collect;
51# Set to 1 if you want the tests to override
52# default storage engine settings, and use MyISAM
53# as default.  (temporary option used in connection
54# with the change of default storage engine to InnoDB)
55our $default_myisam= 1;
56
57
58sub collect_option {
59  my ($opt, $value)= @_;
60
61  # Evaluate $opt as string to use "Getopt::Long::Callback legacy API"
62  my $opt_name = "$opt";
63
64  # Convert - to _ in option name
65  $opt_name =~ s/-/_/g;
66  no strict 'refs';
67  ${$opt_name}= $value;
68}
69
70use File::Basename;
71use File::Spec::Functions qw / splitdir /;
72use IO::File();
73use My::Config;
74use My::Platform;
75use My::Test;
76use My::Find;
77
78require "mtr_misc.pl";
79
80# Precompiled regex's for tests to do or skip
81my $do_test_reg;
82my $skip_test_reg;
83
84# Related to adding InnoDB plugin combinations
85my $lib_innodb_plugin;
86my $do_innodb_plugin;
87
88# If "Quick collect", set to 1 once a test to run has been found.
89my $some_test_found;
90
91sub init_pattern {
92  my ($from, $what)= @_;
93  return undef unless defined $from;
94  if ( $from =~ /^[a-z0-9\.]*$/ ) {
95    # Does not contain any regex (except . that we allow as
96    # separator betwen suite and testname), make the pattern match
97    # beginning of string
98    $from= "^$from";
99    mtr_verbose("$what='$from'");
100  }
101  # Check that pattern is a valid regex
102  eval { "" =~/$from/; 1 } or
103    mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@");
104  return $from;
105}
106
107
108##############################################################################
109#
110#  Collect information about test cases to be run
111#
112##############################################################################
113
114sub collect_test_cases ($$$$) {
115  my $opt_reorder= shift; # True if we're reordering tests
116  my $suites= shift; # Semicolon separated list of test suites
117  my $opt_cases= shift;
118  my $opt_skip_test_list= shift;
119  my $cases= []; # Array of hash(one hash for each testcase)
120
121  # Unit tests off by default also if using --do-test or --start-from
122  $::opt_ctest= 0 if $::opt_ctest == -1 && ($do_test || $start_from);
123
124  $do_test_reg= init_pattern($do_test, "--do-test");
125  $skip_test_reg= init_pattern($skip_test, "--skip-test");
126
127  $lib_innodb_plugin=
128    my_find_file($::basedir,
129		 ["storage/innodb_plugin", "storage/innodb_plugin/.libs",
130		  "lib/mysql/plugin", "lib/plugin"],
131		 ["ha_innodb_plugin.dll", "ha_innodb_plugin.so",
132		  "ha_innodb_plugin.sl"],
133		 NOT_REQUIRED);
134  $do_innodb_plugin= ($::mysql_version_id >= 50100 &&
135		      !(IS_WINDOWS && $::opt_embedded_server) &&
136		      $lib_innodb_plugin);
137
138  # If not reordering, we also shouldn't group by suites, unless
139  # no test cases were named.
140  # This also effects some logic in the loop following this.
141  if ($opt_reorder or !@$opt_cases)
142  {
143    foreach my $suite (split(",", $suites))
144    {
145      push(@$cases, collect_one_suite($suite, $opt_cases, $opt_skip_test_list));
146      last if $some_test_found;
147      push(@$cases, collect_one_suite("i_".$suite, $opt_cases, $opt_skip_test_list));
148    }
149  }
150
151  if ( @$opt_cases )
152  {
153    # A list of tests was specified on the command line.
154    # Among those, the tests which are not already collected will be
155    # collected and stored temporarily in an array of hashes pointed
156    # by the below reference. This array is eventually appeneded to
157    # the one having all collected test cases.
158    my $cmdline_cases;
159
160    # Check that the tests specified was found
161    # in at least one suite
162    foreach my $test_name_spec ( @$opt_cases )
163    {
164      my $found= 0;
165      my ($sname, $tname, $extension)= split_testname($test_name_spec);
166      foreach my $test ( @$cases )
167      {
168	last unless $opt_reorder;
169	# test->{name} is always in suite.name format
170	if ( $test->{name} =~ /^$sname.*\.$tname$/ )
171	{
172	  $found= 1;
173	  last;
174	}
175      }
176      if ( not $found )
177      {
178        if ( $sname )
179        {
180	  # If suite was part of name, find it there, may come with combinations
181	  my @this_case = collect_one_suite($sname, [ $tname ]);
182
183          # If a test is specified multiple times on the command line, all
184          # instances of the test need to be picked. Hence, such tests are
185          # stored in the temporary array instead of adding them to $cases
186          # directly so that repeated tests are not run only once
187	  if (@this_case)
188          {
189	    push (@$cmdline_cases, @this_case);
190	  }
191	  else
192	  {
193	    mtr_error("Could not find '$tname' in '$sname' suite");
194          }
195        }
196        else
197        {
198          if ( !$opt_reorder )
199          {
200            # If --no-reorder is passed and if suite was not part of name,
201            # search in all the suites
202            foreach my $suite (split(",", $suites))
203            {
204              my @this_case = collect_one_suite($suite, [ $tname ]);
205              if ( @this_case )
206              {
207                push (@$cmdline_cases, @this_case);
208                $found= 1;
209              }
210              @this_case= collect_one_suite("i_".$suite, [ $tname ]);
211              if ( @this_case )
212              {
213                push (@$cmdline_cases, @this_case);
214                $found= 1;
215              }
216            }
217          }
218          if ( !$found )
219          {
220            mtr_error("Could not find '$tname' in '$suites' suite(s)");
221          }
222        }
223      }
224    }
225    # Add test cases collected in the temporary array to the one
226    # containing all previously collected test cases
227    push (@$cases, @$cmdline_cases) if $cmdline_cases;
228  }
229
230  if ( $opt_reorder && !$quick_collect)
231  {
232    # Reorder the test cases in an order that will make them faster to run
233    # Make a mapping of test name to a string that represents how that test
234    # should be sorted among the other tests.  Put the most important criterion
235    # first, then a sub-criterion, then sub-sub-criterion, etc.
236    foreach my $tinfo (@$cases)
237    {
238      my @criteria = ();
239
240      #
241      # Append the criteria for sorting, in order of importance.
242      #
243      push(@criteria, "ndb=" . ($tinfo->{'ndb_test'} ? "A" : "B"));
244      push(@criteria, $tinfo->{template_path});
245      # Group test with equal options together.
246      # Ending with "~" makes empty sort later than filled
247      my $opts= $tinfo->{'master_opt'} ? $tinfo->{'master_opt'} : [];
248      push(@criteria, join("!", sort @{$opts}) . "~");
249      # Add slave opts if any
250      if ($tinfo->{'slave_opt'})
251      {
252	push(@criteria, join("!", sort @{$tinfo->{'slave_opt'}}));
253      }
254      # This sorts tests with force-restart *before* identical tests
255      push(@criteria, $tinfo->{force_restart} ? "force-restart" : "no-restart");
256
257      $tinfo->{criteria}= join(" ", @criteria);
258    }
259
260    @$cases = sort {$a->{criteria} cmp $b->{criteria}; } @$cases;
261
262    # For debugging the sort-order
263    # foreach my $tinfo (@$cases)
264    # {
265    #   my $tname= $tinfo->{name} . ' ' . $tinfo->{combination};
266    #   my $crit= $tinfo->{criteria};
267    #   print("$tname\n\t$crit\n");
268    # }
269  }
270
271  if (defined $print_testcases){
272    print_testcases(@$cases);
273    exit(1);
274  }
275
276  return $cases;
277
278}
279
280
281# Returns (suitename, testname, extension)
282sub split_testname {
283  my ($test_name)= @_;
284
285  # If .test file name is used, get rid of directory part
286  $test_name= basename($test_name) if $test_name =~ /\.test$/;
287
288  # Now split name on .'s
289  my @parts= split(/\./, $test_name);
290
291  if (@parts == 1){
292    # Only testname given, ex: alias
293    return (undef , $parts[0], undef);
294  } elsif (@parts == 2) {
295    # Either testname.test or suite.testname given
296    # Ex. main.alias or alias.test
297
298    if ($parts[1] eq "test")
299    {
300      return (undef , $parts[0], $parts[1]);
301    }
302    else
303    {
304      return ($parts[0], $parts[1], undef);
305    }
306
307  } elsif (@parts == 3) {
308    # Fully specified suitename.testname.test
309    # ex main.alias.test
310    return ( $parts[0], $parts[1], $parts[2]);
311  }
312
313  mtr_error("Illegal format of test name: $test_name");
314}
315
316
317sub collect_one_suite($)
318{
319  my $suite= shift;  # Test suite name
320  my $opt_cases= shift;
321  my $opt_skip_test_list= shift;
322  my @cases; # Array of hash
323
324  mtr_verbose("Collecting: $suite");
325
326  my $suitedir= "$::glob_mysql_test_dir"; # Default
327  if ( $suite ne "main" )
328  {
329    # Allow suite to be path to "some dir" if $suite has at least
330    # one directory part
331    if ( -d $suite and splitdir($suite) > 1 ){
332      $suitedir= $suite;
333      mtr_report(" - from '$suitedir'");
334
335    }
336    else
337    {
338      $suitedir= my_find_dir($::basedir,
339			     ["share/mysql-test/suite",
340			      "mysql-test/suite",
341                              "lib/mysql-test/suite",
342			      "internal/mysql-test/suite",
343			      "mysql-test",
344			      # Look in storage engine specific suite dirs
345			      "storage/*/mtr",
346			      # Look in plugin specific suite dir
347			      "plugin/$suite/tests",
348			      "internal/plugin/$suite/tests",
349			     ],
350			     [$suite, "mtr"], ($suite =~ /^i_/));
351      return unless $suitedir;
352    }
353    mtr_verbose("suitedir: $suitedir");
354  }
355
356  my $testdir= "$suitedir/t";
357  my $resdir=  "$suitedir/r";
358
359  # Check if t/ exists
360  if (-d $testdir){
361    # t/ exists
362
363    if ( -d $resdir )
364    {
365      # r/exists
366    }
367    else
368    {
369      # No r/, use t/ as result dir
370      $resdir= $testdir;
371    }
372
373  }
374  else {
375    # No t/ dir => there can' be any r/ dir
376    mtr_error("Can't have r/ dir without t/") if -d $resdir;
377
378    # No t/ or r/ => use suitedir
379    $resdir= $testdir= $suitedir;
380  }
381
382  mtr_verbose("testdir: $testdir");
383  mtr_verbose("resdir: $resdir");
384
385  # ----------------------------------------------------------------------
386  # Build a hash of disabled testcases for this suite
387  # ----------------------------------------------------------------------
388  my %disabled;
389  my @disabled_collection= @{$opt_skip_test_list} if $opt_skip_test_list;
390  unshift (@disabled_collection, "$testdir/disabled.def");
391  for my $skip (@disabled_collection)
392    {
393      if ( open(DISABLED, $skip ) )
394	{
395	  # $^O on Windows considered not generic enough
396	  my $plat= (IS_WINDOWS) ? 'windows' : $^O;
397
398	  while ( <DISABLED> )
399	    {
400	      chomp;
401	      #diasble the test case if platform matches
402	      if ( /\@/ )
403		{
404		  if ( /\@$plat/ )
405		    {
406		      /^\s*(\S+)\s*\@$plat.*:\s*(.*?)\s*$/ ;
407		      $disabled{$1}= $2 if not exists $disabled{$1};
408		    }
409		  elsif ( /\@!(\S*)/ )
410		    {
411		      if ( $1 ne $plat)
412			{
413			  /^\s*(\S+)\s*\@!.*:\s*(.*?)\s*$/ ;
414			  $disabled{$1}= $2 if not exists $disabled{$1};
415			}
416		    }
417		}
418	      elsif ( /^\s*(\S+)\s*:\s*(.*?)\s*$/ )
419		{
420		  chomp;
421		  if ( /^\s*(\S+)\s*:\s*(.*?)\s*$/ )
422		    {
423		      $disabled{$1}= $2 if not exists $disabled{$1};
424		    }
425		}
426	    }
427	  close DISABLED;
428	}
429    }
430
431  # Read suite.opt file
432  my $suite_opt_file=  "$testdir/suite.opt";
433  my $suite_opts= [];
434  if ( -f $suite_opt_file )
435  {
436    $suite_opts= opts_from_file($suite_opt_file);
437  }
438
439  if ( @$opt_cases )
440  {
441    # Collect in specified order
442    foreach my $test_name_spec ( @$opt_cases )
443    {
444      my ($sname, $tname, $extension)= split_testname($test_name_spec);
445
446      # The test name parts have now been defined
447      #print "  suite_name: $sname\n";
448      #print "  tname:      $tname\n";
449      #print "  extension:  $extension\n";
450
451      # Check cirrect suite if suitename is defined
452      next if (defined $sname and $suite ne $sname);
453
454      if ( defined $extension )
455      {
456	my $full_name= "$testdir/$tname.$extension";
457	# Extension was specified, check if the test exists
458        if ( ! -f $full_name)
459        {
460	  # This is only an error if suite was specified, otherwise it
461	  # could exist in another suite
462          mtr_error("Test '$full_name' was not found in suite '$sname'")
463	    if $sname;
464
465	  next;
466        }
467      }
468      else
469      {
470	# No extension was specified, use default
471	$extension= "test";
472	my $full_name= "$testdir/$tname.$extension";
473
474	# Test not found here, could exist in other suite
475	next if ( ! -f $full_name );
476      }
477
478      push(@cases,
479	   collect_one_test_case($suitedir,
480				 $testdir,
481				 $resdir,
482				 $suite,
483				 $tname,
484				 "$tname.$extension",
485				 \%disabled,
486				 $suite_opts));
487    }
488  }
489  else
490  {
491    opendir(TESTDIR, $testdir) or mtr_error("Can't open dir \"$testdir\": $!");
492
493    foreach my $elem ( sort readdir(TESTDIR) )
494    {
495      my $tname= mtr_match_extension($elem, 'test');
496
497      next unless defined $tname;
498
499      # Skip tests that does not match the --do-test= filter
500      next if ($do_test_reg and not $tname =~ /$do_test_reg/o);
501
502      push(@cases,
503	   collect_one_test_case($suitedir,
504				 $testdir,
505				 $resdir,
506				 $suite,
507				 $tname,
508				 $elem,
509				 \%disabled,
510				 $suite_opts));
511    }
512    closedir TESTDIR;
513  }
514
515  #  Return empty list if no testcases found
516  return if (@cases == 0);
517
518  # ----------------------------------------------------------------------
519  # Read combinations for this suite and build testcases x combinations
520  # if any combinations exists
521  # ----------------------------------------------------------------------
522  if ( ! $skip_combinations && ! $quick_collect )
523  {
524    my @combinations;
525    my $combination_file= "$suitedir/combinations";
526    #print "combination_file: $combination_file\n";
527    if (@::opt_combinations)
528    {
529      # take the combination from command-line
530      mtr_verbose("Take the combination from command line");
531      foreach my $combination (@::opt_combinations) {
532	my $comb= {};
533	$comb->{name}= $combination;
534	push(@{$comb->{comb_opt}}, $combination);
535	push(@combinations, $comb);
536      }
537    }
538    elsif (-f $combination_file )
539    {
540      # Read combinations file in my.cnf format
541      mtr_verbose("Read combinations file");
542      my $config= My::Config->new($combination_file);
543      foreach my $group ($config->groups()) {
544	my $comb= {};
545	$comb->{name}= $group->name();
546        foreach my $option ( $group->options() ) {
547	  push(@{$comb->{comb_opt}}, $option->option());
548	}
549	push(@combinations, $comb);
550      }
551    }
552
553    if (@combinations)
554    {
555      print " - adding combinations for $suite\n";
556      #print_testcases(@cases);
557
558      my @new_cases;
559      foreach my $comb (@combinations)
560      {
561	# ENV is used in My::Config::ENV to store the environment so is not a true combination
562	next if ( $comb->{'name'} eq 'ENV' );
563
564	foreach my $test (@cases)
565	{
566
567	  next if ( $test->{'skip'} );
568
569	  # Skip this combination if the values it provides
570	  # already are set in master_opt or slave_opt
571	  if (My::Options::is_set($test->{master_opt}, $comb->{comb_opt}) &&
572	      My::Options::is_set($test->{slave_opt}, $comb->{comb_opt}) ){
573	    next;
574	  }
575
576	  # Copy test options
577	  my $new_test= My::Test->new();
578	  while (my ($key, $value) = each(%$test)) {
579	    if (ref $value eq "ARRAY") {
580	      push(@{$new_test->{$key}}, @$value);
581	    } else {
582	      $new_test->{$key}= $value;
583	    }
584	  }
585
586	  # Append the combination options to master_opt and slave_opt
587	  push(@{$new_test->{master_opt}}, @{$comb->{comb_opt}});
588	  push(@{$new_test->{slave_opt}}, @{$comb->{comb_opt}});
589
590	  # Add combination name short name
591	  $new_test->{combination}= $comb->{name};
592
593	  # Add the new test to new test cases list
594	  push(@new_cases, $new_test);
595	}
596      }
597
598      # Add the plain test if it was not already added
599      # as part of a combination
600      my %added;
601      foreach my $new_test (@new_cases){
602	$added{$new_test->{name}}= 1;
603      }
604      foreach my $test (@cases){
605	push(@new_cases, $test) unless $added{$test->{name}};
606      }
607
608
609      #print_testcases(@new_cases);
610      @cases= @new_cases;
611      #print_testcases(@cases);
612    }
613  }
614
615  optimize_cases(\@cases);
616  #print_testcases(@cases);
617
618  return @cases;
619}
620
621
622
623#
624# Loop through all test cases
625# - optimize which test to run by skipping unnecessary ones
626# - update settings if necessary
627#
628sub optimize_cases {
629  my ($cases)= @_;
630
631  foreach my $tinfo ( @$cases )
632  {
633    # Skip processing if already marked as skipped
634    next if $tinfo->{skip};
635
636    # =======================================================
637    # If a special binlog format was selected with
638    # --mysqld=--binlog-format=x, skip all test that does not
639    # support it
640    # =======================================================
641    #print "binlog_format: $binlog_format\n";
642    if (defined $binlog_format )
643    {
644      # =======================================================
645      # Fixed --binlog-format=x specified on command line
646      # =======================================================
647      if ( defined $tinfo->{'binlog_formats'} )
648      {
649	#print "binlog_formats: ". join(", ", @{$tinfo->{binlog_formats}})."\n";
650
651	# The test supports different binlog formats
652	# check if the selected one is ok
653	my $supported=
654	  grep { $_ eq $binlog_format } @{$tinfo->{'binlog_formats'}};
655	if ( !$supported )
656	{
657	  $tinfo->{'skip'}= 1;
658	  $tinfo->{'comment'}=
659	    "Doesn't support --binlog-format='$binlog_format'";
660	}
661      }
662    }
663    else
664    {
665      # =======================================================
666      # Use dynamic switching of binlog format
667      # =======================================================
668
669      # Get binlog-format used by this test from master_opt
670      my $test_binlog_format;
671      foreach my $opt ( @{$tinfo->{master_opt}} ) {
672	$test_binlog_format=
673	  mtr_match_prefix($opt, "--binlog-format=") || $test_binlog_format;
674      }
675
676      if (defined $test_binlog_format and
677	  defined $tinfo->{binlog_formats} )
678      {
679	my $supported=
680	  grep { $_ eq $test_binlog_format } @{$tinfo->{'binlog_formats'}};
681	if ( !$supported )
682	{
683	  $tinfo->{'skip'}= 1;
684	  $tinfo->{'comment'}=
685	    "Doesn't support --binlog-format='$test_binlog_format'";
686	  next;
687	}
688      }
689    }
690
691    # =======================================================
692    # Check that engine selected by
693    # --default-storage-engine=<engine> is supported
694    # =======================================================
695    my %builtin_engines = ('myisam' => 1, 'memory' => 1, 'csv' => 1);
696
697    foreach my $opt ( @{$tinfo->{master_opt}} ) {
698      my $default_engine=
699	mtr_match_prefix($opt, "--default-storage-engine=");
700      my $default_tmp_engine=
701	mtr_match_prefix($opt, "--default-tmp-storage-engine=");
702
703      # Allow use of uppercase, convert to all lower case
704      $default_engine =~ tr/A-Z/a-z/;
705      $default_tmp_engine =~ tr/A-Z/a-z/;
706
707      if (defined $default_engine){
708
709	#print " $tinfo->{name}\n";
710	#print " - The test asked to use '$default_engine'\n";
711
712	#my $engine_value= $::mysqld_variables{$default_engine};
713	#print " - The mysqld_variables says '$engine_value'\n";
714
715	if ( ! exists $::mysqld_variables{$default_engine} and
716	     ! exists $builtin_engines{$default_engine} )
717	{
718	  $tinfo->{'skip'}= 1;
719	  $tinfo->{'comment'}=
720	    "'$default_engine' not supported";
721	}
722
723	$tinfo->{'ndb_test'}= 1
724	  if ( $default_engine =~ /^ndb/i );
725	$tinfo->{'innodb_test'}= 1
726	  if ( $default_engine =~ /^innodb/i );
727      }
728      if (defined $default_tmp_engine){
729
730	#print " $tinfo->{name}\n";
731	#print " - The test asked to use '$default_tmp_engine' as temp engine\n";
732
733	#my $engine_value= $::mysqld_variables{$default_tmp_engine};
734	#print " - The mysqld_variables says '$engine_value'\n";
735
736	if ( ! exists $::mysqld_variables{$default_tmp_engine} and
737	     ! exists $builtin_engines{$default_tmp_engine} )
738	{
739	  $tinfo->{'skip'}= 1;
740	  $tinfo->{'comment'}=
741	    "'$default_tmp_engine' not supported";
742	}
743
744	$tinfo->{'ndb_test'}= 1
745	  if ( $default_tmp_engine =~ /^ndb/i );
746	$tinfo->{'innodb_test'}= 1
747	  if ( $default_tmp_engine =~ /^innodb/i );
748      }
749    }
750
751    if ($quick_collect && ! $tinfo->{'skip'})
752    {
753      $some_test_found= 1;
754      return;
755    }
756  }
757}
758
759
760#
761# Read options from the given opt file and append them as an array
762# to $tinfo->{$opt_name}
763#
764sub process_opts_file {
765  my ($tinfo, $opt_file, $opt_name)= @_;
766
767  if ( -f $opt_file )
768  {
769    my $opts= opts_from_file($opt_file);
770
771    foreach my $opt ( @$opts )
772    {
773      my $value;
774
775      # The opt file is used both to send special options to the mysqld
776      # as well as pass special test case specific options to this
777      # script
778
779      $value= mtr_match_prefix($opt, "--timezone=");
780      if ( defined $value )
781      {
782	$tinfo->{'timezone'}= $value;
783	next;
784      }
785
786      $value= mtr_match_prefix($opt, "--result-file=");
787      if ( defined $value )
788      {
789	# Specifies the file mysqltest should compare
790	# output against
791	$tinfo->{'result_file'}= "r/$value.result";
792	next;
793      }
794
795      $value= mtr_match_prefix($opt, "--config-file-template=");
796      if ( defined $value)
797      {
798	# Specifies the configuration file to use for this test
799	$tinfo->{'template_path'}= dirname($tinfo->{path})."/$value";
800	next;
801      }
802
803      # If we set default time zone, remove the one we have
804      $value= mtr_match_prefix($opt, "--default-time-zone=");
805      if ( defined $value )
806      {
807	# Set timezone for this test case to something different
808	$tinfo->{'timezone'}= "GMT-8";
809	# Fallthrough, add the --default-time-zone option
810      }
811
812      # The --restart option forces a restart even if no special
813      # option is set. If the options are the same as next testcase
814      # there is no need to restart after the testcase
815      # has completed
816      if ( $opt eq "--force-restart" )
817      {
818	$tinfo->{'force_restart'}= 1;
819	next;
820      }
821
822      $value= mtr_match_prefix($opt, "--testcase-timeout=");
823      if ( defined $value ) {
824	# Overrides test case timeout for this test
825	$tinfo->{'case-timeout'}= $value;
826	next;
827      }
828
829      # Ok, this was a real option, add it
830      push(@{$tinfo->{$opt_name}}, $opt);
831    }
832  }
833}
834
835##############################################################################
836#
837#  Collect information about a single test case
838#
839##############################################################################
840
841sub collect_one_test_case {
842  my $suitedir=   shift;
843  my $testdir=    shift;
844  my $resdir=     shift;
845  my $suitename=  shift;
846  my $tname=      shift;
847  my $filename=   shift;
848  my $disabled=   shift;
849  my $suite_opts= shift;
850
851  #print "collect_one_test_case\n";
852  #print " suitedir: $suitedir\n";
853  #print " testdir: $testdir\n";
854  #print " resdir: $resdir\n";
855  #print " suitename: $suitename\n";
856  #print " tname: $tname\n";
857  #print " filename: $filename\n";
858
859  # ----------------------------------------------------------------------
860  # Check --start-from
861  # ----------------------------------------------------------------------
862  if ( $start_from )
863  {
864    # start_from can be specified as [suite.].testname_prefix
865    my ($suite, $test, $ext)= split_testname($start_from);
866
867    if ( $suite and $suitename lt $suite){
868      return; # Skip silently
869    }
870    if ( $tname lt $test ){
871      return; # Skip silently
872    }
873  }
874
875  # ----------------------------------------------------------------------
876  # Set defaults
877  # ----------------------------------------------------------------------
878  my $tinfo= My::Test->new
879    (
880     name          => "$suitename.$tname",
881     shortname     => $tname,
882     path          => "$testdir/$filename",
883
884    );
885
886  my $result_file= "$resdir/$tname.result";
887  if (-f $result_file) {
888    # Allow nonexistsing result file
889    # in that case .test must issue "exit" otherwise test
890    # should fail by default
891    $tinfo->{result_file}= $result_file;
892  }
893  else {
894    # No .result file exist
895    # Remember the path  where it should be
896    # saved in case of --record
897    $tinfo->{record_file}= $result_file;
898  }
899
900  # ----------------------------------------------------------------------
901  # Skip some tests but include in list, just mark them as skipped
902  # ----------------------------------------------------------------------
903  if ( $skip_test_reg and $tname =~ /$skip_test_reg/o )
904  {
905    $tinfo->{'skip'}= 1;
906    return $tinfo;
907  }
908
909  # ----------------------------------------------------------------------
910  # Check for disabled tests
911  # ----------------------------------------------------------------------
912  my $marked_as_disabled= 0;
913  if ( $disabled->{$tname} or $disabled->{"$suitename.$tname"} )
914  {
915    # Test was marked as disabled in suites disabled.def file
916    $marked_as_disabled= 1;
917    # Test name may have been disabled with or without suite name part
918    $tinfo->{'comment'}= $disabled->{$tname} ||
919                         $disabled->{"$suitename.$tname"};
920  }
921
922  my $disabled_file= "$testdir/$tname.disabled";
923  if ( -f $disabled_file )
924  {
925    $marked_as_disabled= 1;
926    $tinfo->{'comment'}= mtr_fromfile($disabled_file);
927  }
928
929  if ( $marked_as_disabled )
930  {
931    if ( $enable_disabled )
932    {
933      # User has selected to run all disabled tests
934      mtr_report(" - $tinfo->{name} wil be run although it's been disabled\n",
935		 "  due to '$tinfo->{comment}'");
936    }
937    else
938    {
939      $tinfo->{'skip'}= 1;
940      $tinfo->{'disable'}= 1;   # Sub type of 'skip'
941      return $tinfo;
942    }
943  }
944
945  # ----------------------------------------------------------------------
946  # Append suite extra options to both master and slave
947  # ----------------------------------------------------------------------
948  push(@{$tinfo->{'master_opt'}}, @$suite_opts);
949  push(@{$tinfo->{'slave_opt'}}, @$suite_opts);
950
951  #-----------------------------------------------------------------------
952  # Check for test specific config file
953  #-----------------------------------------------------------------------
954  my $test_cnf_file= "$testdir/$tname.cnf";
955  if ( -f $test_cnf_file) {
956    # Specifies the configuration file to use for this test
957    $tinfo->{'template_path'}= $test_cnf_file;
958  }
959
960  # ----------------------------------------------------------------------
961  # Check for test specific config file
962  # ----------------------------------------------------------------------
963  my $test_cnf_file= "$testdir/$tname.cnf";
964  if ( -f $test_cnf_file ) {
965    # Specifies the configuration file to use for this test
966    $tinfo->{'template_path'}= $test_cnf_file;
967  }
968
969  # ----------------------------------------------------------------------
970  # master sh
971  # ----------------------------------------------------------------------
972  my $master_sh= "$testdir/$tname-master.sh";
973  if ( -f $master_sh )
974  {
975    if ( IS_WIN32PERL )
976    {
977      $tinfo->{'skip'}= 1;
978      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
979      return $tinfo;
980    }
981    else
982    {
983      $tinfo->{'master_sh'}= $master_sh;
984    }
985  }
986
987  # ----------------------------------------------------------------------
988  # slave sh
989  # ----------------------------------------------------------------------
990  my $slave_sh= "$testdir/$tname-slave.sh";
991  if ( -f $slave_sh )
992  {
993    if ( IS_WIN32PERL )
994    {
995      $tinfo->{'skip'}= 1;
996      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
997      return $tinfo;
998    }
999    else
1000    {
1001      $tinfo->{'slave_sh'}= $slave_sh;
1002    }
1003  }
1004
1005  # ----------------------------------------------------------------------
1006  # <tname>.slave-mi
1007  # ----------------------------------------------------------------------
1008  mtr_error("$tname: slave-mi not supported anymore")
1009    if ( -f "$testdir/$tname.slave-mi");
1010
1011
1012  tags_from_test_file($tinfo,"$testdir/${tname}.test");
1013
1014  if ( defined $default_storage_engine )
1015  {
1016    # Different default engine is used
1017    # tag test to require that engine
1018    $tinfo->{'ndb_test'}= 1
1019      if ( $default_storage_engine =~ /^ndb/i );
1020
1021    $tinfo->{'innodb_test'}= 1
1022      if ( $default_storage_engine =~ /^innodb/i );
1023
1024  }
1025
1026  if ( $tinfo->{'big_test'} and ! $::opt_big_test )
1027  {
1028    $tinfo->{'skip'}= 1;
1029    $tinfo->{'comment'}= "Test needs 'big-test' option";
1030    return $tinfo
1031  }
1032
1033  if ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries )
1034  {
1035    $tinfo->{'skip'}= 1;
1036    $tinfo->{'comment'}= "Test needs debug binaries";
1037    return $tinfo
1038  }
1039
1040  if ( $tinfo->{'ndb_test'} )
1041  {
1042    # This is a NDB test
1043    if ( $::ndbcluster_enabled == 0)
1044    {
1045      # ndbcluster is disabled
1046      $tinfo->{'skip'}= 1;
1047      $tinfo->{'comment'}= "ndbcluster disabled";
1048      return $tinfo;
1049    }
1050  }
1051  else
1052  {
1053    # This is not a ndb test
1054    if ( $opt_with_ndbcluster_only )
1055    {
1056      # Only the ndb test should be run, all other should be skipped
1057      $tinfo->{'skip'}= 1;
1058      $tinfo->{'comment'}= "Only ndbcluster tests";
1059      return $tinfo;
1060    }
1061  }
1062
1063  if ($tinfo->{'federated_test'})
1064  {
1065    # This is a test that needs federated, enable it
1066    push(@{$tinfo->{'master_opt'}}, "--loose-federated");
1067    push(@{$tinfo->{'slave_opt'}}, "--loose-federated");
1068  }
1069
1070  if ( $tinfo->{'innodb_test'} )
1071  {
1072    # This is a test that needs innodb
1073    if ( $::mysqld_variables{'innodb'} eq "OFF" ||
1074         ! exists $::mysqld_variables{'innodb'} )
1075    {
1076      # innodb is not supported, skip it
1077      $tinfo->{'skip'}= 1;
1078      # This comment is checked for running with innodb plugin (see above),
1079      # please keep that in mind if changing the text.
1080      $tinfo->{'comment'}= "No innodb support";
1081      # But continue processing if we may run it with innodb plugin
1082      return $tinfo unless $do_innodb_plugin;
1083    }
1084  }
1085  elsif ($default_myisam)
1086  {
1087    # This is a temporary fix to allow non-innodb tests to run even if
1088    # the default storage engine is innodb.
1089    push(@{$tinfo->{'master_opt'}}, "--default-storage-engine=MyISAM");
1090    push(@{$tinfo->{'slave_opt'}}, "--default-storage-engine=MyISAM");
1091    push(@{$tinfo->{'master_opt'}}, "--default-tmp-storage-engine=MyISAM");
1092    push(@{$tinfo->{'slave_opt'}}, "--default-tmp-storage-engine=MyISAM");
1093  }
1094
1095  if ( $tinfo->{'need_binlog'} )
1096  {
1097    if (grep(/^--skip-log-bin/,  @::opt_extra_mysqld_opt) )
1098    {
1099      $tinfo->{'skip'}= 1;
1100      $tinfo->{'comment'}= "Test needs binlog";
1101      return $tinfo;
1102    }
1103  }
1104  else
1105  {
1106    # Test does not need binlog, add --skip-binlog to
1107    # the options used when starting
1108    push(@{$tinfo->{'master_opt'}}, "--loose-skip-log-bin");
1109    push(@{$tinfo->{'slave_opt'}}, "--loose-skip-log-bin");
1110  }
1111
1112  if ( $tinfo->{'rpl_test'} )
1113  {
1114    if ( $skip_rpl )
1115    {
1116      $tinfo->{'skip'}= 1;
1117      $tinfo->{'comment'}= "No replication tests(--skip-rpl)";
1118      return $tinfo;
1119    }
1120  }
1121
1122  if ( $::opt_embedded_server )
1123  {
1124    if ( $tinfo->{'not_embedded'} )
1125    {
1126      $tinfo->{'skip'}= 1;
1127      $tinfo->{'comment'}= "Not run for embedded server";
1128      return $tinfo;
1129    }
1130  }
1131
1132  if ( $tinfo->{'need_ssl'} )
1133  {
1134    # This is a test that needs ssl
1135    if ( ! $::opt_ssl_supported ) {
1136      # SSL is not supported, skip it
1137      $tinfo->{'skip'}= 1;
1138      $tinfo->{'comment'}= "No SSL support";
1139      return $tinfo;
1140    }
1141  }
1142
1143  if ( $tinfo->{'not_windows'} && IS_WINDOWS )
1144  {
1145    $tinfo->{'skip'}= 1;
1146    $tinfo->{'comment'}= "Test not supported on Windows";
1147    return $tinfo;
1148  }
1149
1150  # ----------------------------------------------------------------------
1151  # Find config file to use if not already selected in <testname>.opt file
1152  # ----------------------------------------------------------------------
1153  if (defined $defaults_file) {
1154    # Using same config file for all tests
1155    $tinfo->{template_path}= $defaults_file;
1156  }
1157  elsif (! $tinfo->{template_path} )
1158  {
1159    my $config= "$suitedir/my.cnf";
1160    if (! -f $config )
1161    {
1162      # assume default.cnf will be used
1163      $config= "include/default_my.cnf";
1164
1165      # Suite has no config, autodetect which one to use
1166      if ( $tinfo->{rpl_test} ){
1167	$config= "suite/rpl/my.cnf";
1168	if ( $tinfo->{ndb_test} ){
1169	  $config= "suite/rpl_ndb/my.cnf";
1170	}
1171      }
1172      elsif ( $tinfo->{ndb_test} ){
1173	$config= "suite/ndb/my.cnf";
1174      }
1175    }
1176    $tinfo->{template_path}= $config;
1177  }
1178
1179  # Set extra config file to use
1180  if (defined $defaults_extra_file) {
1181    $tinfo->{extra_template_path}= $defaults_extra_file;
1182  }
1183
1184  # ----------------------------------------------------------------------
1185  # Append mysqld extra options to both master and slave
1186  # ----------------------------------------------------------------------
1187  push(@{$tinfo->{'master_opt'}}, @::opt_extra_mysqld_opt);
1188  push(@{$tinfo->{'slave_opt'}}, @::opt_extra_mysqld_opt);
1189
1190  # ----------------------------------------------------------------------
1191  # Add master opts, extra options only for master
1192  # ----------------------------------------------------------------------
1193  process_opts_file($tinfo, "$testdir/$tname-master.opt", 'master_opt');
1194
1195  # ----------------------------------------------------------------------
1196  # Add slave opts, list of extra option only for slave
1197  # ----------------------------------------------------------------------
1198  process_opts_file($tinfo, "$testdir/$tname-slave.opt", 'slave_opt');
1199
1200  return $tinfo;
1201}
1202
1203
1204# List of tags in the .test files that if found should set
1205# the specified value in "tinfo"
1206my @tags=
1207(
1208 ["include/have_binlog_format_row.inc", "binlog_formats", ["row"]],
1209 ["include/have_binlog_format_statement.inc", "binlog_formats", ["statement"]],
1210 ["include/have_binlog_format_mixed.inc", "binlog_formats", ["mixed"]],
1211 ["include/have_binlog_format_mixed_or_row.inc",
1212  "binlog_formats", ["mixed", "row"]],
1213 ["include/have_binlog_format_mixed_or_statement.inc",
1214  "binlog_formats", ["mixed", "statement"]],
1215 ["include/have_binlog_format_row_or_statement.inc",
1216  "binlog_formats", ["row", "statement"]],
1217
1218 ["include/have_log_bin.inc", "need_binlog", 1],
1219
1220 ["include/have_innodb.inc", "innodb_test", 1],
1221 ["include/big_test.inc", "big_test", 1],
1222 ["include/have_debug.inc", "need_debug", 1],
1223 ["include/have_ndb.inc", "ndb_test", 1],
1224 ["include/have_multi_ndb.inc", "ndb_test", 1],
1225 ["include/master-slave.inc", "rpl_test", 1],
1226 ["include/ndb_master-slave.inc", "rpl_test", 1],
1227 ["include/ndb_master-slave.inc", "ndb_test", 1],
1228 ["federated.inc", "federated_test", 1],
1229 ["include/not_embedded.inc", "not_embedded", 1],
1230 ["include/have_ssl.inc", "need_ssl", 1],
1231 ["include/have_ssl_communication.inc", "need_ssl", 1],
1232 ["include/not_windows.inc", "not_windows", 1],
1233);
1234
1235
1236sub tags_from_test_file {
1237  my $tinfo= shift;
1238  my $file= shift;
1239  #mtr_verbose("$file");
1240  my $F= IO::File->new($file) or mtr_error("can't open file \"$file\": $!");
1241
1242  while ( my $line= <$F> )
1243  {
1244
1245    # Skip line if it start's with #
1246    next if ( $line =~ /^#/ );
1247
1248    # Match this line against tag in "tags" array
1249    foreach my $tag (@tags)
1250    {
1251      if ( index($line, $tag->[0]) >= 0 )
1252      {
1253	# Tag matched, assign value to "tinfo"
1254	$tinfo->{"$tag->[1]"}= $tag->[2];
1255      }
1256    }
1257
1258    # If test sources another file, open it as well
1259    if ( $line =~ /^\-\-([[:space:]]*)source(.*)$/ or
1260	 $line =~ /^([[:space:]]*)source(.*);$/ )
1261    {
1262      my $value= $2;
1263      $value =~ s/^\s+//;  # Remove leading space
1264      $value =~ s/[[:space:]]+$//;  # Remove ending space
1265
1266      # Sourced file may exist relative to test or
1267      # in global location
1268      foreach my $sourced_file (dirname($file). "/$value",
1269				"$::glob_mysql_test_dir/$value")
1270      {
1271	if ( -f $sourced_file )
1272	{
1273	  # Only source the file if it exists, we may get
1274	  # false positives in the regexes above if someone
1275	  # writes "source nnnn;" in a test case(such as mysqltest.test)
1276	  tags_from_test_file($tinfo, $sourced_file);
1277	  last;
1278	}
1279      }
1280    }
1281
1282  }
1283}
1284
1285sub unspace {
1286  my $string= shift;
1287  my $quote=  shift;
1288  $string =~ s/[ \t]/\x11/g;
1289  return "$quote$string$quote";
1290}
1291
1292
1293sub opts_from_file ($) {
1294  my $file=  shift;
1295
1296  open(FILE,"<",$file) or mtr_error("can't open file \"$file\": $!");
1297  my @args;
1298  while ( <FILE> )
1299  {
1300    chomp;
1301
1302    #    --init_connect=set @a='a\\0c'
1303    s/^\s+//;                           # Remove leading space
1304    s/\s+$//;                           # Remove ending space
1305
1306    # This is strange, but we need to fill whitespace inside
1307    # quotes with something, to remove later. We do this to
1308    # be able to split on space. Else, we have trouble with
1309    # options like
1310    #
1311    #   --someopt="--insideopt1 --insideopt2"
1312    #
1313    # But still with this, we are not 100% sure it is right,
1314    # we need a shell to do it right.
1315
1316    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
1317    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
1318    s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge;
1319    s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge;
1320
1321    foreach my $arg (split(/[ \t]+/))
1322    {
1323      $arg =~ tr/\x11\x0a\x0b/ \'\"/;     # Put back real chars
1324      # The outermost quotes has to go
1325      $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/
1326        or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/;
1327      $arg =~ s/\\\\/\\/g;
1328
1329      # Do not pass empty string since my_getopt is not capable to handle it.
1330      if (length($arg)) {
1331	push(@args, $arg);
1332      }
1333    }
1334  }
1335  close FILE;
1336  return \@args;
1337}
1338
1339sub print_testcases {
1340  my (@cases)= @_;
1341
1342  print "=" x 60, "\n";
1343  foreach my $test (@cases){
1344    $test->print_test();
1345  }
1346  print "=" x 60, "\n";
1347}
1348
1349
13501;
1351