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