~drizzle-trunk/drizzle/development

1 by brian
clean slate
1
# -*- cperl -*-
2
# Copyright (C) 2005-2006 MySQL AB
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 as published by
6
# the Free Software Foundation; version 2 of the License.
7
# 
8
# This program is distributed in the hope that it will be useful,
9
# but WITHOUT ANY WARRANTY; without even the implied warranty of
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11
# GNU General Public License for more details.
12
# 
13
# You should have received a copy of the GNU General Public License
14
# along with this program; if not, write to the Free Software
15
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
16
17
# This is a library file used by the Perl version of mysql-test-run,
18
# and is part of the translation of the Bourne shell script with the
19
# same name.
20
21
use File::Basename;
22
use IO::File();
23
use strict;
24
25
use My::Config;
26
27
sub collect_test_cases ($);
28
sub collect_one_suite ($);
29
sub collect_one_test_case ($$$$$$$$$);
30
31
sub mtr_options_from_test_file($$);
32
33
my $do_test;
34
my $skip_test;
35
36
sub init_pattern {
37
  my ($from, $what)= @_;
38
  if ( $from =~ /^[a-z0-9]$/ ) {
39
    # Does not contain any regex, make the pattern match
40
    # beginning of string
41
    $from= "^$from";
42
  }
43
  # Check that pattern is a valid regex
44
  eval { "" =~/$from/; 1 } or
45
    mtr_error("Invalid regex '$from' passed to $what\nPerl says: $@");
46
  return $from;
47
}
48
49
50
51
##############################################################################
52
#
53
#  Collect information about test cases we are to run
54
#
55
##############################################################################
56
57
sub collect_test_cases ($) {
58
  $do_test= init_pattern($::opt_do_test, "--do-test");
59
  $skip_test= init_pattern($::opt_skip_test, "--skip-test");
60
61
  my $suites= shift; # Semicolon separated list of test suites
62
  my $cases = [];    # Array of hash
63
64
  foreach my $suite (split(",", $suites))
65
  {
66
    push(@$cases, collect_one_suite($suite));
67
  }
68
69
70
  if ( @::opt_cases )
71
  {
72
    # Check that the tests specified was found
73
    # in at least one suite
74
    foreach my $test_name_spec ( @::opt_cases )
75
    {
76
      my $found= 0;
77
      my ($sname, $tname, $extension)= split_testname($test_name_spec);
78
      foreach my $test ( @$cases )
79
      {
80
	# test->{name} is always in suite.name format
81
	if ( $test->{name} =~ /.*\.$tname/ )
82
	{
83
	  $found= 1;
84
	}
85
      }
86
      if ( not $found )
87
      {
88
	mtr_error("Could not find $tname in any suite");
89
      }
90
    }
91
  }
92
93
  if ( $::opt_reorder )
94
  {
95
    # Reorder the test cases in an order that will make them faster to run
96
    my %sort_criteria;
97
98
    # Make a mapping of test name to a string that represents how that test
99
    # should be sorted among the other tests.  Put the most important criterion
100
    # first, then a sub-criterion, then sub-sub-criterion, et c.
101
    foreach my $tinfo (@$cases)
102
    {
103
      my @criteria = ();
104
105
      # Look for tests that muct be in run in a defined order
106
      # that is defined by test having the same name except for
107
      # the ending digit
108
109
      # Put variables into hash
110
      my $test_name= $tinfo->{'name'};
111
      my $depend_on_test_name;
112
      if ( $test_name =~ /^([\D]+)([0-9]{1})$/ )
113
      {
114
	my $base_name= $1;
115
	my $idx= $2;
116
	mtr_verbose("$test_name =>  $base_name idx=$idx");
117
	if ( $idx > 1 )
118
	{
119
	  $idx-= 1;
120
	  $base_name= "$base_name$idx";
121
	  mtr_verbose("New basename $base_name");
122
	}
123
124
	foreach my $tinfo2 (@$cases)
125
	{
126
	  if ( $tinfo2->{'name'} eq $base_name )
127
	  {
128
	    mtr_verbose("found dependent test $tinfo2->{'name'}");
129
	    $depend_on_test_name=$base_name;
130
	  }
131
	}
132
      }
133
134
      if ( defined $depend_on_test_name )
135
      {
136
	mtr_verbose("Giving $test_name same critera as $depend_on_test_name");
137
	$sort_criteria{$test_name} = $sort_criteria{$depend_on_test_name};
138
      }
139
      else
140
      {
141
	#
142
	# Append the criteria for sorting, in order of importance.
143
	#
144
	# Group test with equal options together.
145
	# Ending with "~" makes empty sort later than filled
146
	push(@criteria, join("!", sort @{$tinfo->{'master_opt'}}) . "~");
147
148
	$sort_criteria{$test_name} = join(" ", @criteria);
149
      }
150
    }
151
152
    @$cases = sort {
153
      $sort_criteria{$a->{'name'}} . $a->{'name'} cmp
154
	$sort_criteria{$b->{'name'}} . $b->{'name'}; } @$cases;
155
156
    if ( $::opt_script_debug )
157
    {
158
      # For debugging the sort-order
159
      foreach my $tinfo (@$cases)
160
      {
161
	print("$sort_criteria{$tinfo->{'name'}} -> \t$tinfo->{'name'}\n");
162
      }
163
    }
164
  }
165
166
  return $cases;
167
168
}
169
170
# Valid extensions and their corresonding component id
171
my %exts = ( 'test' => 'mysqld',
172
	     'imtest' => 'im'
173
	   );
174
175
176
# Returns (suitename, testname, extension)
177
sub split_testname {
178
  my ($test_name)= @_;
179
180
  # Get rid of directory part and split name on .'s
181
  my @parts= split(/\./, basename($test_name));
182
183
  if (@parts == 1){
184
    # Only testname given, ex: alias
185
    return (undef , $parts[0], undef);
186
  } elsif (@parts == 2) {
187
    # Either testname.test or suite.testname given
188
    # Ex. main.alias or alias.test
189
190
    if (defined $exts{$parts[1]})
191
    {
192
      return (undef , $parts[0], $parts[1]);
193
    }
194
    else
195
    {
196
      return ($parts[0], $parts[1], undef);
197
    }
198
199
  } elsif (@parts == 3) {
200
    # Fully specified suitename.testname.test
201
    # ex main.alias.test
202
    return ( $parts[0], $parts[1], $parts[2]);
203
  }
204
205
  mtr_error("Illegal format of test name: $test_name");
206
}
207
208
209
sub collect_one_suite($)
210
{
211
  my $suite= shift;  # Test suite name
212
  my @cases;  # Array of hash
213
214
  mtr_verbose("Collecting: $suite");
215
216
  my $suitedir= "$::glob_mysql_test_dir"; # Default
217
  if ( $suite ne "main" )
218
  {
219
    $suitedir= mtr_path_exists("$suitedir/suite/$suite",
220
			       "$suitedir/$suite");
221
    mtr_verbose("suitedir: $suitedir");
222
  }
223
224
  my $testdir= "$suitedir/t";
225
  my $resdir=  "$suitedir/r";
226
227
  # ----------------------------------------------------------------------
228
  # Build a hash of disabled testcases for this suite
229
  # ----------------------------------------------------------------------
230
  my %disabled;
231
  if ( open(DISABLED, "$testdir/disabled.def" ) )
232
  {
233
    while ( <DISABLED> )
234
      {
235
        chomp;
236
        if ( /^\s*(\S+)\s*:\s*(.*?)\s*$/ )
237
          {
238
            $disabled{$1}= $2;
239
          }
240
      }
241
    close DISABLED;
242
  }
243
244
  # Read suite.opt file
245
  my $suite_opt_file=  "$testdir/suite.opt";
246
  my $suite_opts= [];
247
  if ( -f $suite_opt_file )
248
  {
249
    $suite_opts= mtr_get_opts_from_file($suite_opt_file);
250
  }
251
252
  if ( @::opt_cases )
253
  {
254
    # Collect in specified order
255
    foreach my $test_name_spec ( @::opt_cases )
256
    {
257
      my ($sname, $tname, $extension)= split_testname($test_name_spec);
258
259
      # The test name parts have now been defined
260
      #print "  suite_name: $sname\n";
261
      #print "  tname:      $tname\n";
262
      #print "  extension:  $extension\n";
263
264
      # Check cirrect suite if suitename is defined
265
      next if (defined $sname and $suite ne $sname);
266
267
      my $component_id;
268
      if ( defined $extension )
269
      {
270
	my $full_name= "$testdir/$tname.$extension";
271
	# Extension was specified, check if the test exists
272
        if ( ! -f $full_name)
273
        {
274
	  # This is only an error if suite was specified, otherwise it
275
	  # could exist in another suite
276
          mtr_error("Test '$full_name' was not found in suite '$sname'")
277
	    if $sname;
278
279
	  next;
280
        }
281
	$component_id= $exts{$extension};
282
      }
283
      else
284
      {
285
	# No extension was specified
286
	my ($ext, $component);
287
	while (($ext, $component)= each %exts) {
288
	  my $full_name= "$testdir/$tname.$ext";
289
290
	  if ( ! -f $full_name ) {
291
	    next;
292
	  }
293
	  $component_id= $component;
294
	  $extension= $ext;
295
	}
296
	# Test not found here, could exist in other suite
297
	next unless $component_id;
298
      }
299
300
      collect_one_test_case($testdir,$resdir,$suite,$tname,
301
                            "$tname.$extension",\@cases,\%disabled,
302
			    $component_id,$suite_opts);
303
    }
304
  }
305
  else
306
  {
307
    opendir(TESTDIR, $testdir) or mtr_error("Can't open dir \"$testdir\": $!");
308
309
    foreach my $elem ( sort readdir(TESTDIR) )
310
    {
311
      my $component_id= undef;
312
      my $tname= undef;
313
314
      if ($tname= mtr_match_extension($elem, 'test'))
315
      {
316
        $component_id = 'mysqld';
317
      }
318
      elsif ($tname= mtr_match_extension($elem, 'imtest'))
319
      {
320
        $component_id = 'im';
321
      }
322
      else
323
      {
324
        next;
325
      }
326
327
      # Skip tests that does not match the --do-test= filter
328
      next if ($do_test and not $tname =~ /$do_test/o);
329
330
      collect_one_test_case($testdir,$resdir,$suite,$tname,
331
                            $elem,\@cases,\%disabled,$component_id,
332
			    $suite_opts);
333
    }
334
    closedir TESTDIR;
335
  }
336
337
338
  #  Return empty list if no testcases found
339
  return if (@cases == 0);
340
341
  # ----------------------------------------------------------------------
342
  # Read combinations for this suite and build testcases x combinations
343
  # if any combinations exists
344
  # ----------------------------------------------------------------------
345
  if ( ! $::opt_skip_combination )
346
  {
347
    my @combinations;
348
    my $combination_file= "$suitedir/combinations";
349
    #print "combination_file: $combination_file\n";
350
    if (@::opt_combinations)
351
    {
352
      # take the combination from command-line
353
      mtr_verbose("Take the combination from command line");
354
      foreach my $combination (@::opt_combinations) {
355
	my $comb= {};
356
	$comb->{name}= $combination;
357
	push(@{$comb->{comb_opt}}, $combination);
358
	push(@combinations, $comb);
359
      }
360
    }
361
    elsif (-f $combination_file )
362
    {
363
      # Read combinations file in my.cnf format
364
      mtr_verbose("Read combinations file");
365
      my $config= My::Config->new($combination_file);
366
367
      foreach my $group ($config->groups()) {
368
	my $comb= {};
369
	$comb->{name}= $group->name();
370
        foreach my $option ( $group->options() ) {
371
	  push(@{$comb->{comb_opt}}, $option->name()."=".$option->value());
372
	}
373
	push(@combinations, $comb);
374
      }
375
    }
376
377
    if (@combinations)
378
    {
379
      print " - adding combinations\n";
380
      #print_testcases(@cases);
381
382
      my @new_cases;
383
      foreach my $comb (@combinations)
384
      {
385
	foreach my $test (@cases)
386
	{
387
	  #print $test->{name}, " ", $comb, "\n";
388
	  my $new_test= {};
389
390
	  while (my ($key, $value) = each(%$test)) {
391
	    if (ref $value eq "ARRAY") {
392
	      push(@{$new_test->{$key}}, @$value);
393
	    } else {
394
	      $new_test->{$key}= $value;
395
	    }
396
	  }
397
398
	  # Append the combination options to master_opt and slave_opt
399
	  push(@{$new_test->{master_opt}}, @{$comb->{comb_opt}});
400
	  push(@{$new_test->{slave_opt}}, @{$comb->{comb_opt}});
401
402
	  # Add combination name shrt name
403
	  $new_test->{combination}= $comb->{name};
404
405
	  # Add the new test to new test cases list
406
	  push(@new_cases, $new_test);
407
	}
408
      }
409
      #print_testcases(@new_cases);
410
      @cases= @new_cases;
411
      #print_testcases(@cases);
412
    }
413
  }
414
415
  optimize_cases(\@cases);
416
  #print_testcases(@cases);
417
418
  return @cases;
419
}
420
421
422
#
423
# Loop through all test cases
424
# - optimize which test to run by skipping unnecessary ones
425
# - update settings if necessary
426
#
427
sub optimize_cases {
428
  my ($cases)= @_;
429
430
  foreach my $tinfo ( @$cases )
431
  {
432
    # Skip processing if already marked as skipped
433
    next if $tinfo->{skip};
434
435
    # Replication test needs an adjustment of binlog format
436
    if (mtr_match_prefix($tinfo->{'name'}, "rpl"))
437
    {
438
439
      # =======================================================
440
      # Get binlog-format used by this test from master_opt
441
      # =======================================================
442
      my $test_binlog_format;
443
      foreach my $opt ( @{$tinfo->{master_opt}} ) {
444
	$test_binlog_format= $test_binlog_format ||
445
	  mtr_match_prefix($opt, "--binlog-format=");
446
      }
447
      # print $tinfo->{name}." uses ".$test_binlog_format."\n";
448
449
      # =======================================================
450
      # If a special binlog format was selected with
451
      # --mysqld=--binlog-format=x, skip all test with different
452
      # binlog-format
453
      # =======================================================
454
      if (defined $::used_binlog_format and
455
	  $test_binlog_format and
456
	  $::used_binlog_format ne $test_binlog_format)
457
      {
458
	$tinfo->{'skip'}= 1;
459
	$tinfo->{'comment'}= "Requires --binlog-format='$test_binlog_format'";
460
	next;
461
      }
462
463
      # =======================================================
464
      # Check that testcase supports the designated binlog-format
465
      # =======================================================
466
      if ($test_binlog_format and defined $tinfo->{'sup_binlog_formats'} )
467
      {
468
	my $supported=
469
	  grep { $_ eq $test_binlog_format } @{$tinfo->{'sup_binlog_formats'}};
470
	if ( !$supported )
471
	{
472
	  $tinfo->{'skip'}= 1;
473
	  $tinfo->{'comment'}=
474
	    "Doesn't support --binlog-format='$test_binlog_format'";
475
	  next;
476
	}
477
      }
478
479
      # =======================================================
480
      # Use dynamic switching of binlog-format if mtr started
481
      # w/o --mysqld=--binlog-format=xxx and combinations.
482
      # =======================================================
483
      if (!defined $tinfo->{'combination'} and
484
          !defined $::used_binlog_format)
485
      {
486
        $test_binlog_format= $tinfo->{'sup_binlog_formats'}->[0];
487
      }
488
489
      # Save binlog format for dynamic switching
490
      $tinfo->{binlog_format}= $test_binlog_format;
491
    }
492
  }
493
}
494
495
496
##############################################################################
497
#
498
#  Collect information about a single test case
499
#
500
##############################################################################
501
502
503
sub collect_one_test_case($$$$$$$$$) {
504
  my $testdir= shift;
505
  my $resdir=  shift;
506
  my $suite=   shift;
507
  my $tname=   shift;
508
  my $elem=    shift;
509
  my $cases=   shift;
510
  my $disabled=shift;
511
  my $component_id= shift;
512
  my $suite_opts= shift;
513
514
  my $path= "$testdir/$elem";
515
516
  # ----------------------------------------------------------------------
517
  # Skip some tests silently
518
  # ----------------------------------------------------------------------
519
520
  if ( $::opt_start_from and $tname lt $::opt_start_from )
521
  {
522
    return;
523
  }
524
525
526
  my $tinfo= {};
527
  $tinfo->{'name'}= basename($suite) . ".$tname";
496.1.1 by Paul McCullagh
Added --engine option to drizzle-test-run (default innodb)
528
  if ( -f "$resdir/$::opt_engine/$tname.result")
529
  {
530
    $tinfo->{'result_file'}= "$resdir/$::opt_engine/$tname.result";
531
  }
532
  else
533
  {
534
    $tinfo->{'result_file'}= "$resdir/$tname.result";
535
  }
1 by brian
clean slate
536
  $tinfo->{'component_id'} = $component_id;
537
  push(@$cases, $tinfo);
538
539
  # ----------------------------------------------------------------------
540
  # Skip some tests but include in list, just mark them to skip
541
  # ----------------------------------------------------------------------
542
543
  if ( $skip_test and $tname =~ /$skip_test/o )
544
  {
545
    $tinfo->{'skip'}= 1;
546
    return;
547
  }
548
549
  # ----------------------------------------------------------------------
550
  # Collect information about test case
551
  # ----------------------------------------------------------------------
552
553
  $tinfo->{'path'}= $path;
554
  $tinfo->{'timezone'}= "GMT-3"; # for UNIX_TIMESTAMP tests to work
555
556
  $tinfo->{'slave_num'}= 0; # Default, no slave
557
  $tinfo->{'master_num'}= 1; # Default, 1 master
558
  if ( defined mtr_match_prefix($tname,"rpl") )
559
  {
560
    if ( $::opt_skip_rpl )
561
    {
562
      $tinfo->{'skip'}= 1;
563
      $tinfo->{'comment'}= "No replication tests(--skip-rpl)";
564
      return;
565
    }
566
567
    $tinfo->{'slave_num'}= 1; # Default for rpl* tests, use one slave
568
569
  }
570
571
  if ( defined mtr_match_prefix($tname,"federated") )
572
  {
573
    # Default, federated uses the first slave as it's federated database
574
    $tinfo->{'slave_num'}= 1;
575
  }
576
577
  my $master_opt_file= "$testdir/$tname-master.opt";
578
  my $slave_opt_file=  "$testdir/$tname-slave.opt";
579
  my $slave_mi_file=   "$testdir/$tname.slave-mi";
580
  my $master_sh=       "$testdir/$tname-master.sh";
581
  my $slave_sh=        "$testdir/$tname-slave.sh";
582
  my $disabled_file=   "$testdir/$tname.disabled";
583
  my $im_opt_file=     "$testdir/$tname-im.opt";
584
585
  $tinfo->{'master_opt'}= [];
586
  $tinfo->{'slave_opt'}=  [];
587
  $tinfo->{'slave_mi'}=   [];
588
589
590
  # Add suite opts
591
  foreach my $opt ( @$suite_opts )
592
  {
593
    mtr_verbose($opt);
594
    push(@{$tinfo->{'master_opt'}}, $opt);
595
    push(@{$tinfo->{'slave_opt'}}, $opt);
596
  }
597
598
  # Add master opts
599
  if ( -f $master_opt_file )
600
  {
601
602
    my $master_opt= mtr_get_opts_from_file($master_opt_file);
603
604
    foreach my $opt ( @$master_opt )
605
    {
606
      my $value;
607
608
      # The opt file is used both to send special options to the mysqld
609
      # as well as pass special test case specific options to this
610
      # script
611
612
      $value= mtr_match_prefix($opt, "--timezone=");
613
      if ( defined $value )
614
      {
615
	$tinfo->{'timezone'}= $value;
616
	next;
617
      }
618
619
      $value= mtr_match_prefix($opt, "--slave-num=");
620
      if ( defined $value )
621
      {
622
	$tinfo->{'slave_num'}= $value;
623
	next;
624
      }
625
626
      $value= mtr_match_prefix($opt, "--result-file=");
627
      if ( defined $value )
628
      {
629
	# Specifies the file mysqltest should compare
630
	# output against
496.1.1 by Paul McCullagh
Added --engine option to drizzle-test-run (default innodb)
631
	if ( -f "r/$::opt_engine/$value.result")
632
        {
633
	  $tinfo->{'result_file'}= "r/$::opt_engine/$value.result";
634
        }
635
        else
636
        {
637
	  $tinfo->{'result_file'}= "r/$value.result";
638
        }
639
1 by brian
clean slate
640
	next;
641
      }
642
643
      # If we set default time zone, remove the one we have
644
      $value= mtr_match_prefix($opt, "--default-time-zone=");
645
      if ( defined $value )
646
      {
647
	# Set timezone for this test case to something different
648
	$tinfo->{'timezone'}= "GMT-8";
649
	# Fallthrough, add the --default-time-zone option
650
      }
651
652
      # The --restart option forces a restart even if no special
653
      # option is set. If the options are the same as next testcase
654
      # there is no need to restart after the testcase
655
      # has completed
656
      if ( $opt eq "--force-restart" )
657
      {
658
	$tinfo->{'force_restart'}= 1;
659
	next;
660
      }
661
662
      # Ok, this was a real option, add it
663
      push(@{$tinfo->{'master_opt'}}, $opt);
664
    }
665
  }
666
667
  # Add slave opts
668
  if ( -f $slave_opt_file )
669
  {
670
    my $slave_opt= mtr_get_opts_from_file($slave_opt_file);
671
672
    foreach my $opt ( @$slave_opt )
673
    {
674
      # If we set default time zone, remove the one we have
675
      my $value= mtr_match_prefix($opt, "--default-time-zone=");
676
      $tinfo->{'slave_opt'}= [] if defined $value;
677
    }
678
    push(@{$tinfo->{'slave_opt'}}, @$slave_opt);
679
  }
680
681
  if ( -f $slave_mi_file )
682
  {
683
    $tinfo->{'slave_mi'}= mtr_get_opts_from_file($slave_mi_file);
684
  }
685
686
  if ( -f $master_sh )
687
  {
688
    if ( $::glob_win32_perl )
689
    {
690
      $tinfo->{'skip'}= 1;
691
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
692
      return;
693
    }
694
    else
695
    {
696
      $tinfo->{'master_sh'}= $master_sh;
697
    }
698
  }
699
700
  if ( -f $slave_sh )
701
  {
702
    if ( $::glob_win32_perl )
703
    {
704
      $tinfo->{'skip'}= 1;
705
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
706
      return;
707
    }
708
    else
709
    {
710
      $tinfo->{'slave_sh'}= $slave_sh;
711
    }
712
  }
713
714
  if ( -f $im_opt_file )
715
  {
716
    $tinfo->{'im_opts'} = mtr_get_opts_from_file($im_opt_file);
717
  }
718
  else
719
  {
720
    $tinfo->{'im_opts'} = [];
721
  }
722
723
  # FIXME why this late?
724
  my $marked_as_disabled= 0;
725
  if ( $disabled->{$tname} )
726
  {
727
    $marked_as_disabled= 1;
728
    $tinfo->{'comment'}= $disabled->{$tname};
729
  }
730
731
  if ( -f $disabled_file )
732
  {
733
    $marked_as_disabled= 1;
734
    $tinfo->{'comment'}= mtr_fromfile($disabled_file);
735
  }
736
737
  # If test was marked as disabled, either opt_enable_disabled is off and then
738
  # we skip this test, or it is on and then we run this test but warn
739
740
  if ( $marked_as_disabled )
741
  {
742
    if ( $::opt_enable_disabled )
743
    {
744
      $tinfo->{'dont_skip_though_disabled'}= 1;
745
    }
746
    else
747
    {
748
      $tinfo->{'skip'}= 1;
749
      $tinfo->{'disable'}= 1;   # Sub type of 'skip'
750
      return;
751
    }
752
  }
753
754
  if ( $component_id eq 'im' )
755
  {
756
    if ( $::glob_use_embedded_server )
757
    {
758
      $tinfo->{'skip'}= 1;
759
      $tinfo->{'comment'}= "No IM with embedded server";
760
      return;
761
    }
762
    elsif ( $::opt_ps_protocol )
763
    {
764
      $tinfo->{'skip'}= 1;
765
      $tinfo->{'comment'}= "No IM with --ps-protocol";
766
      return;
767
    }
768
    elsif ( $::opt_skip_im )
769
    {
770
      $tinfo->{'skip'}= 1;
771
      $tinfo->{'comment'}= "No IM tests(--skip-im)";
772
      return;
773
    }
774
  }
775
  else
776
  {
777
    mtr_options_from_test_file($tinfo,"$testdir/${tname}.test");
778
779
    if ( defined $::used_default_engine )
780
    {
781
      # Different default engine is used
782
      # tag test to require that engine
783
      $tinfo->{'ndb_test'}= 1
784
	if ( $::used_default_engine =~ /^ndb/i );
785
786
      $tinfo->{'innodb_test'}= 1
787
	if ( $::used_default_engine =~ /^innodb/i );
788
    }
789
790
    if ( $tinfo->{'big_test'} and ! $::opt_big_test )
791
    {
792
      $tinfo->{'skip'}= 1;
793
      $tinfo->{'comment'}= "Test need 'big-test' option";
794
      return;
795
    }
796
797
    if ( $tinfo->{'ndb_extra'} and ! $::opt_ndb_extra_test )
798
    {
799
      $tinfo->{'skip'}= 1;
800
      $tinfo->{'comment'}= "Test need 'ndb_extra' option";
801
      return;
802
    }
803
804
    if ( $tinfo->{'require_manager'} )
805
    {
806
      $tinfo->{'skip'}= 1;
807
      $tinfo->{'comment'}= "Test need the _old_ manager(to be removed)";
808
      return;
809
    }
810
811
    if ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries )
812
    {
813
      $tinfo->{'skip'}= 1;
814
      $tinfo->{'comment'}= "Test need debug binaries";
815
      return;
816
    }
817
  }
818
}
819
820
821
# List of tags in the .test files that if found should set
822
# the specified value in "tinfo"
823
our @tags=
824
(
825
 ["include/have_innodb.inc", "innodb_test", 1],
826
 ["include/have_binlog_format_row.inc", "sup_binlog_formats", ["row"]],
827
 ["include/have_log_bin.inc", "need_binlog", 1],
828
 ["include/have_binlog_format_statement.inc",
829
  "sup_binlog_formats", ["statement"]],
830
 ["include/have_binlog_format_mixed.inc", "sup_binlog_formats", ["mixed"]],
831
 ["include/have_binlog_format_mixed_or_row.inc",
832
  "sup_binlog_formats", ["mixed","row"]],
833
 ["include/have_binlog_format_mixed_or_statement.inc",
834
  "sup_binlog_formats", ["mixed","statement"]],
835
 ["include/have_binlog_format_row_or_statement.inc",
836
  "sup_binlog_formats", ["row","statement"]],
837
 ["include/big_test.inc", "big_test", 1],
838
 ["include/have_debug.inc", "need_debug", 1],
839
 ["require_manager", "require_manager", 1],
840
);
841
842
sub mtr_options_from_test_file($$) {
843
  my $tinfo= shift;
844
  my $file= shift;
845
  #mtr_verbose("$file");
846
  my $F= IO::File->new($file) or mtr_error("can't open file \"$file\": $!");
847
848
  while ( my $line= <$F> )
849
  {
850
851
    # Skip line if it start's with #
852
    next if ( $line =~ /^#/ );
853
854
    # Match this line against tag in "tags" array
855
    foreach my $tag (@tags)
856
    {
857
      if ( index($line, $tag->[0]) >= 0 )
858
      {
859
    	  # Tag matched, assign value to "tinfo"
860
        $tinfo->{"$tag->[1]"}= $tag->[2];
861
      }
862
    }
863
864
    # If test sources another file, open it as well
865
    if ( $line =~ /^\-\-([[:space:]]*)source(.*)$/ or
866
	 $line =~ /^([[:space:]]*)source(.*);$/ )
867
    {
868
      my $value= $2;
869
      $value =~ s/^\s+//;  # Remove leading space
870
      $value =~ s/[[:space:]]+$//;  # Remove ending space
871
872
      my $sourced_file= "$::glob_mysql_test_dir/$value";
873
      if ( -f $sourced_file )
874
      {
875
	# Only source the file if it exists, we may get
876
	# false positives in the regexes above if someone
877
	# writes "source nnnn;" in a test case(such as mysqltest.test)
878
	mtr_options_from_test_file($tinfo, $sourced_file);
879
      }
880
    }
881
  }
882
}
883
884
885
sub print_testcases {
886
  my (@cases)= @_;
887
888
  print "=" x 60, "\n";
889
  foreach my $test (@cases){
890
    print "[", $test->{name}, "]", "\n";
891
    while ((my ($key, $value)) = each(%$test)) {
892
      print " ", $key, "=";
893
      if (ref $value eq "ARRAY") {
894
	print join(", ", @$value);
895
      } else {
896
	print $value;
897
      }
898
      print "\n";
899
    }
900
    print "\n";
901
  }
902
  print "=" x 60, "\n";
903
}
904
905
906
1;