← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/lib/dtr_cases.pl

  • Committer: Monty Taylor
  • Date: 2008-09-16 00:00:48 UTC
  • mto: This revision was merged to the branch mainline in revision 391.
  • Revision ID: monty@inaugust.com-20080916000048-3rvrv3gv9l0ad3gs
Fixed copyright headers in drizzled/

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/lib/dtr_cases.pl
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 drizzle-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 dtr_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
 
    dtr_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
 
        dtr_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
 
        dtr_verbose("$test_name =>  $base_name idx=$idx");
117
 
        if ( $idx > 1 )
118
 
        {
119
 
          $idx-= 1;
120
 
          $base_name= "$base_name$idx";
121
 
          dtr_verbose("New basename $base_name");
122
 
        }
123
 
 
124
 
        foreach my $tinfo2 (@$cases)
125
 
        {
126
 
          if ( $tinfo2->{'name'} eq $base_name )
127
 
          {
128
 
            dtr_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
 
        dtr_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' => 'drizzled',
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
 
  dtr_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
 
  dtr_verbose("Collecting: $suite");
215
 
 
216
 
  my $suitepath= "$::glob_suite_path";
217
 
  my $suitedir= "$::glob_drizzle_test_dir"; # Default
218
 
  if ( $suite ne "main" )
219
 
  {
220
 
    $suitedir= dtr_path_exists(
221
 
             "$suitepath/$suite/drizzle-tests",
222
 
             "$suitepath/$suite/tests",
223
 
             "$suitedir/suite/$suite",
224
 
                               "$suitedir/$suite");
225
 
    dtr_verbose("suitedir: $suitedir");
226
 
  }
227
 
 
228
 
  my $testdir= "$suitedir/t";
229
 
  my $resdir=  "$suitedir/r";
230
 
 
231
 
  # ----------------------------------------------------------------------
232
 
  # Build a hash of disabled testcases for this suite
233
 
  # ----------------------------------------------------------------------
234
 
  my %disabled;
235
 
  if ( open(DISABLED, "$testdir/disabled.def" ) )
236
 
  {
237
 
    while ( <DISABLED> )
238
 
      {
239
 
        chomp;
240
 
        if ( /^\s*(\S+)\s*:\s*(.*?)\s*$/ )
241
 
          {
242
 
            $disabled{$1}= $2;
243
 
          }
244
 
      }
245
 
    close DISABLED;
246
 
  }
247
 
 
248
 
  # Read suite.opt file
249
 
  my $suite_opt_file=  "$testdir/suite.opt";
250
 
  my $suite_opts= [];
251
 
  if ( -f $suite_opt_file )
252
 
  {
253
 
    $suite_opts= dtr_get_opts_from_file($suite_opt_file);
254
 
  }
255
 
 
256
 
  if ( @::opt_cases )
257
 
  {
258
 
    # Collect in specified order
259
 
    foreach my $test_name_spec ( @::opt_cases )
260
 
    {
261
 
      my ($sname, $tname, $extension)= split_testname($test_name_spec);
262
 
 
263
 
      # The test name parts have now been defined
264
 
      #print "  suite_name: $sname\n";
265
 
      #print "  tname:      $tname\n";
266
 
      #print "  extension:  $extension\n";
267
 
 
268
 
      # Check cirrect suite if suitename is defined
269
 
      next if (defined $sname and $suite ne $sname);
270
 
 
271
 
      my $component_id;
272
 
      if ( defined $extension )
273
 
      {
274
 
        my $full_name= "$testdir/$tname.$extension";
275
 
        # Extension was specified, check if the test exists
276
 
        if ( ! -f $full_name)
277
 
        {
278
 
          # This is only an error if suite was specified, otherwise it
279
 
          # could exist in another suite
280
 
          dtr_error("Test '$full_name' was not found in suite '$sname'")
281
 
            if $sname;
282
 
 
283
 
          next;
284
 
        }
285
 
        $component_id= $exts{$extension};
286
 
      }
287
 
      else
288
 
      {
289
 
        # No extension was specified
290
 
        my ($ext, $component);
291
 
        while (($ext, $component)= each %exts) {
292
 
          my $full_name= "$testdir/$tname.$ext";
293
 
 
294
 
          if ( ! -f $full_name ) {
295
 
            next;
296
 
          }
297
 
          $component_id= $component;
298
 
          $extension= $ext;
299
 
        }
300
 
        # Test not found here, could exist in other suite
301
 
        next unless $component_id;
302
 
      }
303
 
 
304
 
      collect_one_test_case($testdir,$resdir,$suite,$tname,
305
 
                            "$tname.$extension",\@cases,\%disabled,
306
 
                            $component_id,$suite_opts);
307
 
    }
308
 
  }
309
 
  else
310
 
  {
311
 
    opendir(TESTDIR, $testdir) or dtr_error("Can't open dir \"$testdir\": $!");
312
 
 
313
 
    foreach my $elem ( sort readdir(TESTDIR) )
314
 
    {
315
 
      my $component_id= undef;
316
 
      my $tname= undef;
317
 
 
318
 
      if ($tname= dtr_match_extension($elem, 'test'))
319
 
      {
320
 
        $component_id = 'drizzled';
321
 
      }
322
 
      elsif ($tname= dtr_match_extension($elem, 'imtest'))
323
 
      {
324
 
        $component_id = 'im';
325
 
      }
326
 
      else
327
 
      {
328
 
        next;
329
 
      }
330
 
 
331
 
      # Skip tests that does not match the --do-test= filter
332
 
      next if ($do_test and not $tname =~ /$do_test/o);
333
 
 
334
 
      collect_one_test_case($testdir,$resdir,$suite,$tname,
335
 
                            $elem,\@cases,\%disabled,$component_id,
336
 
                            $suite_opts);
337
 
    }
338
 
    closedir TESTDIR;
339
 
  }
340
 
 
341
 
 
342
 
  #  Return empty list if no testcases found
343
 
  return if (@cases == 0);
344
 
 
345
 
  # ----------------------------------------------------------------------
346
 
  # Read combinations for this suite and build testcases x combinations
347
 
  # if any combinations exists
348
 
  # ----------------------------------------------------------------------
349
 
  if ( ! $::opt_skip_combination )
350
 
  {
351
 
    my @combinations;
352
 
    my $combination_file= "$suitedir/combinations";
353
 
    #print "combination_file: $combination_file\n";
354
 
    if (@::opt_combinations)
355
 
    {
356
 
      # take the combination from command-line
357
 
      dtr_verbose("Take the combination from command line");
358
 
      foreach my $combination (@::opt_combinations) {
359
 
        my $comb= {};
360
 
        $comb->{name}= $combination;
361
 
        push(@{$comb->{comb_opt}}, $combination);
362
 
        push(@combinations, $comb);
363
 
      }
364
 
    }
365
 
    elsif (-f $combination_file )
366
 
    {
367
 
      # Read combinations file in my.cnf format
368
 
      dtr_verbose("Read combinations file");
369
 
      my $config= My::Config->new($combination_file);
370
 
 
371
 
      foreach my $group ($config->groups()) {
372
 
        my $comb= {};
373
 
        $comb->{name}= $group->name();
374
 
        foreach my $option ( $group->options() ) {
375
 
          push(@{$comb->{comb_opt}}, $option->name()."=".$option->value());
376
 
        }
377
 
        push(@combinations, $comb);
378
 
      }
379
 
    }
380
 
 
381
 
    if (@combinations)
382
 
    {
383
 
      print " - adding combinations\n";
384
 
      #print_testcases(@cases);
385
 
 
386
 
      my @new_cases;
387
 
      foreach my $comb (@combinations)
388
 
      {
389
 
        foreach my $test (@cases)
390
 
        {
391
 
          #print $test->{name}, " ", $comb, "\n";
392
 
          my $new_test= {};
393
 
 
394
 
          while (my ($key, $value) = each(%$test)) {
395
 
            if (ref $value eq "ARRAY") {
396
 
              push(@{$new_test->{$key}}, @$value);
397
 
            } else {
398
 
              $new_test->{$key}= $value;
399
 
            }
400
 
          }
401
 
 
402
 
          # Append the combination options to master_opt and slave_opt
403
 
          push(@{$new_test->{master_opt}}, @{$comb->{comb_opt}});
404
 
          push(@{$new_test->{slave_opt}}, @{$comb->{comb_opt}});
405
 
 
406
 
          # Add combination name shrt name
407
 
          $new_test->{combination}= $comb->{name};
408
 
 
409
 
          # Add the new test to new test cases list
410
 
          push(@new_cases, $new_test);
411
 
        }
412
 
      }
413
 
      #print_testcases(@new_cases);
414
 
      @cases= @new_cases;
415
 
      #print_testcases(@cases);
416
 
    }
417
 
  }
418
 
 
419
 
  optimize_cases(\@cases);
420
 
  #print_testcases(@cases);
421
 
 
422
 
  return @cases;
423
 
}
424
 
 
425
 
 
426
 
#
427
 
# Loop through all test cases
428
 
# - optimize which test to run by skipping unnecessary ones
429
 
# - update settings if necessary
430
 
#
431
 
sub optimize_cases {
432
 
  my ($cases)= @_;
433
 
 
434
 
  foreach my $tinfo ( @$cases )
435
 
  {
436
 
    # Skip processing if already marked as skipped
437
 
    next if $tinfo->{skip};
438
 
 
439
 
    # Replication test needs an adjustment of binlog format
440
 
    if (dtr_match_prefix($tinfo->{'name'}, "rpl"))
441
 
    {
442
 
 
443
 
      # =======================================================
444
 
      # Get binlog-format used by this test from master_opt
445
 
      # =======================================================
446
 
      my $test_binlog_format;
447
 
      foreach my $opt ( @{$tinfo->{master_opt}} ) {
448
 
        $test_binlog_format= $test_binlog_format ||
449
 
          dtr_match_prefix($opt, "--binlog-format=");
450
 
      }
451
 
      # print $tinfo->{name}." uses ".$test_binlog_format."\n";
452
 
 
453
 
      # =======================================================
454
 
      # If a special binlog format was selected with
455
 
      # --drizzled=--binlog-format=x, skip all test with different
456
 
      # binlog-format
457
 
      # =======================================================
458
 
      if (defined $::used_binlog_format and
459
 
          $test_binlog_format and
460
 
          $::used_binlog_format ne $test_binlog_format)
461
 
      {
462
 
        $tinfo->{'skip'}= 1;
463
 
        $tinfo->{'comment'}= "Requires --binlog-format='$test_binlog_format'";
464
 
        next;
465
 
      }
466
 
 
467
 
      # =======================================================
468
 
      # Check that testcase supports the designated binlog-format
469
 
      # =======================================================
470
 
      if ($test_binlog_format and defined $tinfo->{'sup_binlog_formats'} )
471
 
      {
472
 
        my $supported=
473
 
          grep { $_ eq $test_binlog_format } @{$tinfo->{'sup_binlog_formats'}};
474
 
        if ( !$supported )
475
 
        {
476
 
          $tinfo->{'skip'}= 1;
477
 
          $tinfo->{'comment'}=
478
 
            "Doesn't support --binlog-format='$test_binlog_format'";
479
 
          next;
480
 
        }
481
 
      }
482
 
 
483
 
      # =======================================================
484
 
      # Use dynamic switching of binlog-format if dtr started
485
 
      # w/o --drizzled=--binlog-format=xxx and combinations.
486
 
      # =======================================================
487
 
      if (!defined $tinfo->{'combination'} and
488
 
          !defined $::used_binlog_format)
489
 
      {
490
 
        $test_binlog_format= $tinfo->{'sup_binlog_formats'}->[0];
491
 
      }
492
 
 
493
 
      # Save binlog format for dynamic switching
494
 
      $tinfo->{binlog_format}= $test_binlog_format;
495
 
    }
496
 
  }
497
 
}
498
 
 
499
 
 
500
 
##############################################################################
501
 
#
502
 
#  Collect information about a single test case
503
 
#
504
 
##############################################################################
505
 
 
506
 
 
507
 
sub collect_one_test_case($$$$$$$$$) {
508
 
  my $testdir= shift;
509
 
  my $resdir=  shift;
510
 
  my $suite=   shift;
511
 
  my $tname=   shift;
512
 
  my $elem=    shift;
513
 
  my $cases=   shift;
514
 
  my $disabled=shift;
515
 
  my $component_id= shift;
516
 
  my $suite_opts= shift;
517
 
 
518
 
  my $path= "$testdir/$elem";
519
 
 
520
 
  # ----------------------------------------------------------------------
521
 
  # Skip some tests silently
522
 
  # ----------------------------------------------------------------------
523
 
 
524
 
  if ( $::opt_start_from and $tname lt $::opt_start_from )
525
 
  {
526
 
    return;
527
 
  }
528
 
 
529
 
 
530
 
  my $tinfo= {};
531
 
  $tinfo->{'name'}= basename($suite) . ".$tname";
532
 
  if ( -f "$resdir/$::opt_engine/$tname.result")
533
 
  {
534
 
    $tinfo->{'result_file'}= "$resdir/$::opt_engine/$tname.result";
535
 
  }
536
 
  else
537
 
  {
538
 
    $tinfo->{'result_file'}= "$resdir/$tname.result";
539
 
  }
540
 
  $tinfo->{'component_id'} = $component_id;
541
 
  push(@$cases, $tinfo);
542
 
 
543
 
  # ----------------------------------------------------------------------
544
 
  # Skip some tests but include in list, just mark them to skip
545
 
  # ----------------------------------------------------------------------
546
 
 
547
 
  if ( $skip_test and $tname =~ /$skip_test/o )
548
 
  {
549
 
    $tinfo->{'skip'}= 1;
550
 
    return;
551
 
  }
552
 
 
553
 
  # ----------------------------------------------------------------------
554
 
  # Collect information about test case
555
 
  # ----------------------------------------------------------------------
556
 
 
557
 
  $tinfo->{'path'}= $path;
558
 
  $tinfo->{'timezone'}= "GMT-3"; # for UNIX_TIMESTAMP tests to work
559
 
 
560
 
  $tinfo->{'slave_num'}= 0; # Default, no slave
561
 
  $tinfo->{'master_num'}= 1; # Default, 1 master
562
 
  if ( defined dtr_match_prefix($tname,"rpl") )
563
 
  {
564
 
    if ( $::opt_skip_rpl )
565
 
    {
566
 
      $tinfo->{'skip'}= 1;
567
 
      $tinfo->{'comment'}= "No replication tests(--skip-rpl)";
568
 
      return;
569
 
    }
570
 
 
571
 
    $tinfo->{'slave_num'}= 1; # Default for rpl* tests, use one slave
572
 
 
573
 
  }
574
 
 
575
 
  if ( defined dtr_match_prefix($tname,"federated") )
576
 
  {
577
 
    # Default, federated uses the first slave as it's federated database
578
 
    $tinfo->{'slave_num'}= 1;
579
 
  }
580
 
 
581
 
  my $global_master_opt_file= "$testdir/master.opt";
582
 
  my $test_master_opt_file= "$testdir/$tname-master.opt";
583
 
  my $slave_opt_file=  "$testdir/$tname-slave.opt";
584
 
  my $slave_mi_file=   "$testdir/$tname.slave-mi";
585
 
  my $master_sh=       "$testdir/$tname-master.sh";
586
 
  my $slave_sh=        "$testdir/$tname-slave.sh";
587
 
  my $disabled_file=   "$testdir/$tname.disabled";
588
 
  my $im_opt_file=     "$testdir/$tname-im.opt";
589
 
 
590
 
  $tinfo->{'master_opt'}= [];
591
 
  $tinfo->{'slave_opt'}=  [];
592
 
  $tinfo->{'slave_mi'}=   [];
593
 
 
594
 
 
595
 
  # Add suite opts
596
 
  foreach my $opt ( @$suite_opts )
597
 
  {
598
 
    dtr_verbose($opt);
599
 
    push(@{$tinfo->{'master_opt'}}, $opt);
600
 
    push(@{$tinfo->{'slave_opt'}}, $opt);
601
 
  }
602
 
 
603
 
  foreach  my $master_opt_file ($global_master_opt_file, $test_master_opt_file)
604
 
  {
605
 
    # Add master opts
606
 
    if ( -f $master_opt_file )
607
 
    {
608
 
 
609
 
      my $master_opt= dtr_get_opts_from_file($master_opt_file);
610
 
 
611
 
      foreach my $opt ( @$master_opt )
612
 
      {
613
 
        my $value;
614
 
 
615
 
        # The opt file is used both to send special options to the drizzled
616
 
        # as well as pass special test case specific options to this
617
 
        # script
618
 
 
619
 
        $value= dtr_match_prefix($opt, "--timezone=");
620
 
        if ( defined $value )
621
 
        {
622
 
          $tinfo->{'timezone'}= $value;
623
 
          next;
624
 
        }
625
 
 
626
 
        $value= dtr_match_prefix($opt, "--slave-num=");
627
 
        if ( defined $value )
628
 
        {
629
 
          $tinfo->{'slave_num'}= $value;
630
 
          next;
631
 
        }
632
 
 
633
 
        $value= dtr_match_prefix($opt, "--result-file=");
634
 
        if ( defined $value )
635
 
        {
636
 
          # Specifies the file drizzletest should compare
637
 
          # output against
638
 
          if ( -f "r/$::opt_engine/$value.result")
639
 
          {
640
 
            $tinfo->{'result_file'}= "r/$::opt_engine/$value.result";
641
 
          }
642
 
          else
643
 
          {
644
 
            $tinfo->{'result_file'}= "r/$value.result";
645
 
          }
646
 
 
647
 
          next;
648
 
        }
649
 
 
650
 
        # If we set default time zone, remove the one we have
651
 
        $value= dtr_match_prefix($opt, "--default-time-zone=");
652
 
        if ( defined $value )
653
 
        {
654
 
          # Set timezone for this test case to something different
655
 
          $tinfo->{'timezone'}= "GMT-8";
656
 
          # Fallthrough, add the --default-time-zone option
657
 
        }
658
 
 
659
 
        # The --restart option forces a restart even if no special
660
 
        # option is set. If the options are the same as next testcase
661
 
        # there is no need to restart after the testcase
662
 
        # has completed
663
 
        if ( $opt eq "--force-restart" )
664
 
        {
665
 
          $tinfo->{'force_restart'}= 1;
666
 
          next;
667
 
        }
668
 
 
669
 
        # Ok, this was a real option, add it
670
 
        push(@{$tinfo->{'master_opt'}}, $opt);
671
 
      }
672
 
    }
673
 
  }
674
 
 
675
 
  # Add slave opts
676
 
  if ( -f $slave_opt_file )
677
 
  {
678
 
    my $slave_opt= dtr_get_opts_from_file($slave_opt_file);
679
 
 
680
 
    foreach my $opt ( @$slave_opt )
681
 
    {
682
 
      # If we set default time zone, remove the one we have
683
 
      my $value= dtr_match_prefix($opt, "--default-time-zone=");
684
 
      $tinfo->{'slave_opt'}= [] if defined $value;
685
 
    }
686
 
    push(@{$tinfo->{'slave_opt'}}, @$slave_opt);
687
 
  }
688
 
 
689
 
  if ( -f $slave_mi_file )
690
 
  {
691
 
    $tinfo->{'slave_mi'}= dtr_get_opts_from_file($slave_mi_file);
692
 
  }
693
 
 
694
 
  if ( -f $master_sh )
695
 
  {
696
 
    if ( $::glob_win32_perl )
697
 
    {
698
 
      $tinfo->{'skip'}= 1;
699
 
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
700
 
      return;
701
 
    }
702
 
    else
703
 
    {
704
 
      $tinfo->{'master_sh'}= $master_sh;
705
 
    }
706
 
  }
707
 
 
708
 
  if ( -f $slave_sh )
709
 
  {
710
 
    if ( $::glob_win32_perl )
711
 
    {
712
 
      $tinfo->{'skip'}= 1;
713
 
      $tinfo->{'comment'}= "No tests with sh scripts on Windows";
714
 
      return;
715
 
    }
716
 
    else
717
 
    {
718
 
      $tinfo->{'slave_sh'}= $slave_sh;
719
 
    }
720
 
  }
721
 
 
722
 
  if ( -f $im_opt_file )
723
 
  {
724
 
    $tinfo->{'im_opts'} = dtr_get_opts_from_file($im_opt_file);
725
 
  }
726
 
  else
727
 
  {
728
 
    $tinfo->{'im_opts'} = [];
729
 
  }
730
 
 
731
 
  # FIXME why this late?
732
 
  my $marked_as_disabled= 0;
733
 
  if ( $disabled->{$tname} )
734
 
  {
735
 
    $marked_as_disabled= 1;
736
 
    $tinfo->{'comment'}= $disabled->{$tname};
737
 
  }
738
 
 
739
 
  if ( -f $disabled_file )
740
 
  {
741
 
    $marked_as_disabled= 1;
742
 
    $tinfo->{'comment'}= dtr_fromfile($disabled_file);
743
 
  }
744
 
 
745
 
  # If test was marked as disabled, either opt_enable_disabled is off and then
746
 
  # we skip this test, or it is on and then we run this test but warn
747
 
 
748
 
  if ( $marked_as_disabled )
749
 
  {
750
 
    if ( $::opt_enable_disabled )
751
 
    {
752
 
      $tinfo->{'dont_skip_though_disabled'}= 1;
753
 
    }
754
 
    else
755
 
    {
756
 
      $tinfo->{'skip'}= 1;
757
 
      $tinfo->{'disable'}= 1;   # Sub type of 'skip'
758
 
      return;
759
 
    }
760
 
  }
761
 
 
762
 
  if ( $component_id eq 'im' )
763
 
  {
764
 
    if ( $::glob_use_embedded_server )
765
 
    {
766
 
      $tinfo->{'skip'}= 1;
767
 
      $tinfo->{'comment'}= "No IM with embedded server";
768
 
      return;
769
 
    }
770
 
    elsif ( $::opt_ps_protocol )
771
 
    {
772
 
      $tinfo->{'skip'}= 1;
773
 
      $tinfo->{'comment'}= "No IM with --ps-protocol";
774
 
      return;
775
 
    }
776
 
    elsif ( $::opt_skip_im )
777
 
    {
778
 
      $tinfo->{'skip'}= 1;
779
 
      $tinfo->{'comment'}= "No IM tests(--skip-im)";
780
 
      return;
781
 
    }
782
 
  }
783
 
  else
784
 
  {
785
 
    dtr_options_from_test_file($tinfo,"$testdir/${tname}.test");
786
 
 
787
 
    if ( defined $::used_default_engine )
788
 
    {
789
 
      # Different default engine is used
790
 
      # tag test to require that engine
791
 
      $tinfo->{'ndb_test'}= 1
792
 
        if ( $::used_default_engine =~ /^ndb/i );
793
 
 
794
 
      $tinfo->{'innodb_test'}= 1
795
 
        if ( $::used_default_engine =~ /^innodb/i );
796
 
    }
797
 
 
798
 
    if ( $tinfo->{'ndb_extra'} and ! $::opt_ndb_extra_test )
799
 
    {
800
 
      $tinfo->{'skip'}= 1;
801
 
      $tinfo->{'comment'}= "Test need 'ndb_extra' option";
802
 
      return;
803
 
    }
804
 
 
805
 
    if ( $tinfo->{'require_manager'} )
806
 
    {
807
 
      $tinfo->{'skip'}= 1;
808
 
      $tinfo->{'comment'}= "Test need the _old_ manager(to be removed)";
809
 
      return;
810
 
    }
811
 
 
812
 
    if ( $tinfo->{'need_debug'} && ! $::debug_compiled_binaries )
813
 
    {
814
 
      $tinfo->{'skip'}= 1;
815
 
      $tinfo->{'comment'}= "Test need debug binaries";
816
 
      return;
817
 
    }
818
 
  }
819
 
}
820
 
 
821
 
 
822
 
# List of tags in the .test files that if found should set
823
 
# the specified value in "tinfo"
824
 
our @tags=
825
 
(
826
 
 ["include/have_innodb.inc", "innodb_test", 1],
827
 
 ["include/have_binlog_format_row.inc", "sup_binlog_formats", ["row"]],
828
 
 ["include/have_log_bin.inc", "need_binlog", 1],
829
 
 ["include/have_binlog_format_statement.inc",
830
 
  "sup_binlog_formats", ["statement"]],
831
 
 ["include/have_binlog_format_mixed.inc", "sup_binlog_formats", ["mixed"]],
832
 
 ["include/have_binlog_format_mixed_or_row.inc",
833
 
  "sup_binlog_formats", ["mixed","row"]],
834
 
 ["include/have_binlog_format_mixed_or_statement.inc",
835
 
  "sup_binlog_formats", ["mixed","statement"]],
836
 
 ["include/have_binlog_format_row_or_statement.inc",
837
 
  "sup_binlog_formats", ["row","statement"]],
838
 
 ["include/have_debug.inc", "need_debug", 1],
839
 
 ["require_manager", "require_manager", 1],
840
 
);
841
 
 
842
 
sub dtr_options_from_test_file($$) {
843
 
  my $tinfo= shift;
844
 
  my $file= shift;
845
 
  #dtr_verbose("$file");
846
 
  my $F= IO::File->new($file) or dtr_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_drizzle_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 drizzletest.test)
878
 
        dtr_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;