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