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', 'storage/*/*/mysql-test', ); 68 $overlay_regex= '\b(?:storage|plugin|storage[/][^/]*)/(\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 return () if ::using_extern(); 295 # Read combinations file in my.cnf format 296 mtr_verbose("Read combinations file $filename"); 297 my $config= My::Config->new($filename); 298 foreach my $group ($config->option_groups()) { 299 my $comb= { name => $group->name(), comb_opt => [] }; 300 next if $skip_combinations{"$filename => $comb->{name}"}; 301 foreach my $option ( $group->options() ) { 302 push(@{$comb->{comb_opt}}, $option->option()); 303 } 304 $comb->{in_overlay} = 1 if $in_overlay; 305 push @combs, $comb; 306 } 307 @combs = ({ skip => 'Requires: ' . basename($filename, '.combinations') }) unless @combs; 308 } 309 @combs; 310} 311 312our %disabled; 313our %disabled_wildcards; 314sub parse_disabled { 315 my ($filename, $suitename) = @_; 316 317 if (open(DISABLED, $filename)) { 318 while (<DISABLED>) { 319 chomp; 320 next if /^\s*#/ or /^\s*$/; 321 mtr_error("Syntax error in $filename line $.") 322 unless /^\s*(?:([-0-9A-Za-z_\/]+)\.)?([-0-9A-Za-z_#\*]+)\s*:\s*(.*?)\s*$/; 323 mtr_error("Wrong suite name in $filename line $.: suitename = $suitename but the file says $1") 324 if defined $1 and defined $suitename and $1 ne $suitename; 325 my ($sname, $casename, $text)= (($1 || $suitename || ''), $2, $3); 326 327 if ($casename =~ /\*/) { 328 # Wildcard 329 $disabled_wildcards{$sname . ".$casename"}= $text; 330 } 331 else { 332 $disabled{$sname . ".$casename"}= $text; 333 } 334 } 335 close DISABLED; 336 } 337} 338 339# 340# load suite.pm files from plugin suites 341# collect the list of default plugin suites. 342# XXX currently it does not support nested suites 343# 344sub collect_default_suites(@) 345{ 346 use File::Find; 347 my @dirs; 348 find(sub { 349 push @dirs, [$File::Find::topdir, $File::Find::name] 350 if -d and -f "$File::Find::name/suite.pm"; 351 }, my_find_dir(dirname($::glob_mysql_test_dir), \@plugin_suitedirs)); 352 353 for (@dirs) { 354 my ($plugin_root, $dir) = @$_; 355 my $sname= substr $dir, 1 + length $plugin_root; 356 # ignore overlays here, otherwise we'd need accurate 357 # duplicate detection with overlay support for the default suite list 358 next if $sname eq 'main' or -d "$::glob_mysql_test_dir/suite/$sname"; 359 my $s = load_suite_object($sname, $dir); 360 push @_, $sname if $s->is_default(); 361 } 362 return @_; 363} 364 365 366# 367# processes one user-specified suite name. 368# it could contain wildcards, e.g engines/* 369# 370sub collect_suite_name($$) 371{ 372 my $suitename= shift; # Test suite name 373 my $opt_cases= shift; 374 my $over; 375 my %suites; 376 377 ($suitename, $over) = split '-', $suitename; 378 379 if ( $suitename ne "main" ) 380 { 381 # Allow suite to be path to "some dir" if $suitename has at least 382 # one directory part 383 if ( -d $suitename and splitdir($suitename) > 1 ) { 384 $suites{$suitename} = [ $suitename ]; 385 mtr_report(" - from '$suitename'"); 386 } 387 else 388 { 389 my @dirs = my_find_dir(dirname($::glob_mysql_test_dir), 390 ["mysql-test/suite", @plugin_suitedirs ], 391 $suitename); 392 # 393 # if $suitename contained wildcards, we'll have many suites and 394 # their overlays here. Let's group them appropriately. 395 # 396 for (@dirs) { 397 m@^.*/(?:mysql-test/suite|$plugin_suitedir_regex)/(.*)$@o or confess $_; 398 push @{$suites{$1}}, $_; 399 } 400 } 401 } else { 402 $suites{$suitename} = [ $::glob_mysql_test_dir . "/main", 403 my_find_dir(dirname($::glob_mysql_test_dir), 404 [ @plugin_suitedirs ], 405 'main', NOT_REQUIRED) ]; 406 } 407 408 my @cases; 409 while (my ($name, $dirs) = each %suites) { 410 # 411 # XXX at the moment, for simplicity, we will not fully support one 412 # plugin overlaying a suite of another plugin. Only suites in the main 413 # mysql-test directory can be safely overlayed. To be fixed, when 414 # needed. To fix it we'll need a smarter overlay detection (that is, 415 # detection of what is an overlay and what is the "original" suite) 416 # than simply "prefer directories with more files". 417 # 418 if ($dirs->[0] !~ m@/mysql-test/suite/$name$@) { 419 # prefer directories with more files 420 @$dirs = sort { scalar(<$a/*>) <=> scalar(<$b/*>) } @$dirs; 421 } 422 push @cases, collect_one_suite($opt_cases, $name, $over, @$dirs); 423 } 424 return @cases; 425} 426 427sub collect_one_suite { 428 my ($opt_cases, $suitename, $over, $suitedir, @overlays) = @_; 429 430 mtr_verbose("Collecting: $suitename"); 431 mtr_verbose("suitedir: $suitedir"); 432 mtr_verbose("overlays: @overlays") if @overlays; 433 434 # we always need to process the parent suite, even if we won't use any 435 # test from it. 436 my @cases= process_suite($suitename, undef, $suitedir, 437 $over ? [ '*BOGUS*' ] : $opt_cases); 438 439 # when working with overlays we cannot use global caches like 440 # %file_to_tags. Because the same file may have different tags 441 # with and without overlays. For example, when a.test includes 442 # b.inc, which includes c.inc, and an overlay replaces c.inc. 443 # In this case b.inc may have different tags in the overlay, 444 # despite the fact that b.inc itself is not replaced. 445 for (@overlays) { 446 local %file_to_tags = (); 447 local %file_to_master_opts = (); 448 local %file_to_slave_opts = (); 449 local %file_combinations = (); 450 local %file_in_overlay = (); 451 452 confess $_ unless m@/$overlay_regex/@o; 453 next unless defined $over and ($over eq '' or $over eq $1); 454 push @cases, 455 # don't add cases that take *all* data from the parent suite 456 grep { $_->{in_overlay} } process_suite($suitename, $1, $_, $opt_cases); 457 } 458 return @cases; 459} 460 461sub process_suite { 462 my ($basename, $overname, $suitedir, $opt_cases) = @_; 463 my $suitename; 464 my $parent; 465 466 if ($overname) { 467 $parent = $suites{$basename}; 468 confess unless $parent; 469 $suitename = $basename . '-' . $overname; 470 } else { 471 $suitename = $basename; 472 } 473 474 my $suite = load_suite_object($suitename, (($suitename eq "main") ? 475 $::glob_mysql_test_dir : 476 $suitedir)); 477 478 # 479 # Read suite config files, unless it was done aleady 480 # 481 unless (defined $suite->{name}) { 482 $suite->{name} = $suitename; 483 $suite->{dir} = $suitedir; 484 485 # First, we need to find where the test files and result files are. 486 # test files are usually in a t/ dir inside suite dir. Or directly in the 487 # suite dir. result files are in a r/ dir or in the suite dir. 488 # Overlay uses t/ and r/ if and only if its parent does. 489 if ($parent) { 490 $suite->{parent} = $parent; 491 my $tdir = $parent->{tdir}; 492 my $rdir = $parent->{rdir}; 493 substr($tdir, 0, length $parent->{dir}) = $suitedir; 494 substr($rdir, 0, length $parent->{dir}) = $suitedir; 495 $suite->{tdir} = $tdir if -d $tdir; 496 $suite->{rdir} = $rdir if -d $rdir; 497 } else { 498 my $tdir= "$suitedir/t"; 499 my $rdir= "$suitedir/r"; 500 $suite->{tdir} = -d $tdir ? $tdir : $suitedir; 501 $suite->{rdir} = -d $rdir ? $rdir : $suite->{tdir}; 502 } 503 504 mtr_verbose("testdir: " . $suite->{tdir}); 505 mtr_verbose( "resdir: " . $suite->{rdir}); 506 507 # disabled.def 508 parse_disabled($suite->{dir} .'/disabled.def', $suitename); 509 parse_disabled($suite->{dir} .'/t/disabled.def', $suitename); 510 511 # combinations 512 if (@::opt_combinations) 513 { 514 # take the combination from command-line 515 mtr_verbose("Take the combination from command line"); 516 foreach my $combination (@::opt_combinations) { 517 my $comb= {}; 518 $comb->{name}= $combination; 519 push(@{$comb->{comb_opt}}, $combination); 520 push @{$suite->{combinations}}, $comb; 521 } 522 } 523 else 524 { 525 my @combs; 526 my $from = "$suitedir/combinations"; 527 @combs = combinations_from_file($parent, $from) unless $suite->{skip}; 528 $suite->{combinations} = [ @combs ]; 529 # in overlays it's a union of parent's and overlay's files. 530 unshift @{$suite->{combinations}}, 531 grep { not $skip_combinations{"$from => $_->{name}"} } 532 @{$parent->{combinations}} if $parent; 533 } 534 535 # suite.opt 536 # in overlays it's a union of parent's and overlay's files. 537 $suite->{opts} = [ opts_from_file("$suitedir/suite.opt") ]; 538 $suite->{in_overlay} = 1 if $parent and @{$suite->{opts}}; 539 unshift @{$suite->{opts}}, @{$parent->{opts}} if $parent; 540 541 $suite->{cases} = [ $suite->list_cases($suite->{tdir}) ]; 542 } 543 544 my %all_cases; 545 %all_cases = map { $_ => $parent->{tdir} } @{$parent->{cases}} if $parent; 546 $all_cases{$_} = $suite->{tdir} for @{$suite->{cases}}; 547 548 my @cases; 549 if (@$opt_cases) { 550 # Collect in specified order 551 foreach my $test_name_spec ( @$opt_cases ) 552 { 553 my ($sname, $tname, @combs)= split_testname($test_name_spec); 554 555 # Check correct suite if suitename is defined 556 next if defined $sname and $sname ne $suitename 557 and $sname ne "$basename-"; 558 559 next unless $all_cases{$tname}; 560 push @cases, collect_one_test_case($suite, $all_cases{$tname}, $tname, @combs); 561 } 562 } else { 563 for (sort keys %all_cases) 564 { 565 # Skip tests that do not match the --do-test= filter 566 next if $do_test_reg and not /$do_test_reg/o; 567 push @cases, collect_one_test_case($suite, $all_cases{$_}, $_); 568 } 569 } 570 571 @cases; 572} 573 574# 575# Read options from the given opt file and append them as an array 576# to $tinfo->{$opt_name} 577# 578sub process_opts { 579 my ($tinfo, $opt_name)= @_; 580 581 my @opts= @{$tinfo->{$opt_name}}; 582 $tinfo->{$opt_name} = []; 583 584 foreach my $opt (@opts) 585 { 586 my $value; 587 588 # The opt file is used both to send special options to the mysqld 589 # as well as pass special test case specific options to this 590 # script 591 592 $value= mtr_match_prefix($opt, "--timezone="); 593 if ( defined $value ) 594 { 595 $tinfo->{'timezone'}= $value; 596 next; 597 } 598 599 # If we set default time zone, remove the one we have 600 $value= mtr_match_prefix($opt, "--default-time-zone="); 601 if ( defined $value ) 602 { 603 # Set timezone for this test case to something different 604 $tinfo->{'timezone'}= "GMT-8"; 605 # Fallthrough, add the --default-time-zone option 606 } 607 608 # Ok, this was a real option, add it 609 push(@{$tinfo->{$opt_name}}, $opt); 610 } 611} 612 613sub make_combinations($$@) 614{ 615 my ($test, $test_combs, @combinations) = @_; 616 617 return ($test) if $test->{'skip'} or not @combinations; 618 if ($combinations[0]->{skip}) { 619 $test->{skip} = 1; 620 $test->{comment} = $combinations[0]->{skip} unless $test->{comment}; 621 confess unless @combinations == 1; 622 return ($test); 623 } 624 625 foreach my $comb (@combinations) 626 { 627 # Skip all other combinations if the values they change 628 # are already fixed in master_opt or slave_opt 629 # (empty combinations are not considered a subset of anything) 630 if (@{$comb->{comb_opt}} && 631 My::Options::is_subset($test->{master_opt}, $comb->{comb_opt}) && 632 My::Options::is_subset($test->{slave_opt}, $comb->{comb_opt}) ){ 633 634 $test_combs->{$comb->{name}} = 2; 635 636 # Add combination name short name 637 push @{$test->{combinations}}, $comb->{name}; 638 639 return ($test); 640 } 641 642 # Skip all other combinations, if this combination is forced 643 if ($test_combs->{$comb->{name}}) { 644 @combinations = ($comb); # run the loop below only for this combination 645 $test_combs->{$comb->{name}} = 2; 646 last; 647 } 648 } 649 650 my @cases; 651 foreach my $comb (@combinations) 652 { 653 # Copy test options 654 my $new_test= $test->copy(); 655 656 # Prepend the combination options to master_opt and slave_opt 657 # (on the command line combinations go *before* .opt files) 658 unshift @{$new_test->{master_opt}}, @{$comb->{comb_opt}}; 659 unshift @{$new_test->{slave_opt}}, @{$comb->{comb_opt}}; 660 661 # Add combination name short name 662 push @{$new_test->{combinations}}, $comb->{name}; 663 664 $new_test->{in_overlay} = 1 if $comb->{in_overlay}; 665 666 # Add the new test to new test cases list 667 push(@cases, $new_test); 668 } 669 return @cases; 670} 671 672 673sub find_file_in_dirs 674{ 675 my ($tinfo, $slot, $filename) = @_; 676 my $parent = $tinfo->{suite}->{parent}; 677 my $f = $tinfo->{suite}->{$slot} . '/' . $filename; 678 679 if (-f $f) { 680 $tinfo->{in_overlay} = 1 if $parent; 681 return $f; 682 } 683 684 return undef unless $parent; 685 686 $f = $parent->{$slot} . '/' . $filename; 687 return -f $f ? $f : undef; 688} 689 690############################################################################## 691# 692# Collect information about a single test case 693# 694############################################################################## 695 696sub collect_one_test_case { 697 my $suite = shift; 698 my $tpath = shift; 699 my $tname = shift; 700 my %test_combs = map { $_ => 1 } @_; 701 my $suitename = $suite->{name}; 702 my $name = "$suitename.$tname"; 703 my $filename = "$tpath/${tname}.test"; 704 705 # ---------------------------------------------------------------------- 706 # Set defaults 707 # ---------------------------------------------------------------------- 708 my $tinfo= My::Test->new 709 ( 710 name => $name, 711 shortname => $tname, 712 path => $filename, 713 suite => $suite, 714 in_overlay => $suite->{in_overlay}, 715 master_opt => [ @{$suite->{opts}} ], 716 slave_opt => [ @{$suite->{opts}} ], 717 ); 718 719 # ---------------------------------------------------------------------- 720 # Skip some tests but include in list, just mark them as skipped 721 # ---------------------------------------------------------------------- 722 if ( $skip_test_reg and ($tname =~ /$skip_test_reg/o or 723 $name =~ /$skip_test_reg/o)) 724 { 725 $tinfo->{'skip'}= 1; 726 return $tinfo; 727 } 728 729 # ---------------------------------------------------------------------- 730 # Check for disabled tests 731 # ---------------------------------------------------------------------- 732 my $disable = $disabled{".$tname"} || $disabled{$name}; 733 if (not $disable) { 734 foreach my $w (keys %disabled_wildcards) { 735 if ($name =~ /^$w/) { 736 $disable= $disabled_wildcards{$w}; 737 last; 738 } 739 } 740 } 741 if (not defined $disable and $suite->{parent}) { 742 $disable = $disabled{$suite->{parent}->{name} . ".$tname"}; 743 } 744 if (defined $disable) 745 { 746 $tinfo->{comment}= $disable; 747 if ( $enable_disabled ) 748 { 749 # User has selected to run all disabled tests 750 mtr_report(" - $tinfo->{name} will be run although it's been disabled\n", 751 " due to '$disable'"); 752 } 753 else 754 { 755 $tinfo->{'skip'}= 1; 756 $tinfo->{'disable'}= 1; # Sub type of 'skip' 757 758 # we can stop test file processing early if the test if disabled, but 759 # only if we're not in the overlay. for overlays we want to know exactly 760 # whether the test is ignored (in_overlay=0) or disabled. 761 return $tinfo unless $suite->{parent}; 762 } 763 } 764 765 if ($suite->{skip}) { 766 $tinfo->{skip}= 1; 767 $tinfo->{comment}= $suite->{skip} unless $tinfo->{comment}; 768 return $tinfo unless $suite->{parent}; 769 } 770 771 # ---------------------------------------------------------------------- 772 # Check for test specific config file 773 # ---------------------------------------------------------------------- 774 my $test_cnf_file= find_file_in_dirs($tinfo, tdir => "$tname.cnf"); 775 if ($test_cnf_file ) { 776 # Specifies the configuration file to use for this test 777 $tinfo->{'template_path'}= $test_cnf_file; 778 } 779 780 # ---------------------------------------------------------------------- 781 # master sh 782 # ---------------------------------------------------------------------- 783 my $master_sh= find_file_in_dirs($tinfo, tdir => "$tname-master.sh"); 784 if ($master_sh) 785 { 786 if ( IS_WIN32PERL ) 787 { 788 $tinfo->{'skip'}= 1; 789 $tinfo->{'comment'}= "No tests with sh scripts on Windows"; 790 return $tinfo; 791 } 792 else 793 { 794 $tinfo->{'master_sh'}= $master_sh; 795 } 796 } 797 798 # ---------------------------------------------------------------------- 799 # slave sh 800 # ---------------------------------------------------------------------- 801 my $slave_sh= find_file_in_dirs($tinfo, tdir => "$tname-slave.sh"); 802 if ($slave_sh) 803 { 804 if ( IS_WIN32PERL ) 805 { 806 $tinfo->{'skip'}= 1; 807 $tinfo->{'comment'}= "No tests with sh scripts on Windows"; 808 return $tinfo; 809 } 810 else 811 { 812 $tinfo->{'slave_sh'}= $slave_sh; 813 } 814 } 815 816 my ($master_opts, $slave_opts)= tags_from_test_file($tinfo); 817 $tinfo->{in_overlay} = 1 if $file_in_overlay{$filename}; 818 819 if ( $tinfo->{'big_test'} and ! $::opt_big_test ) 820 { 821 $tinfo->{'skip'}= 1; 822 $tinfo->{'comment'}= "Test needs --big-test"; 823 return $tinfo 824 } 825 826 if ( $tinfo->{'big_test'} ) 827 { 828 # All 'big_test' takes a long time to run 829 $tinfo->{'long_test'}= 1; 830 } 831 832 if ( ! $tinfo->{'big_test'} and $::opt_big_test > 1 ) 833 { 834 $tinfo->{'skip'}= 1; 835 $tinfo->{'comment'}= "Small test"; 836 return $tinfo 837 } 838 839 if ( $tinfo->{'rpl_test'} ) 840 { 841 if ( $skip_rpl ) 842 { 843 $tinfo->{'skip'}= 1; 844 $tinfo->{'comment'}= "No replication tests"; 845 return $tinfo; 846 } 847 } 848 849 # ---------------------------------------------------------------------- 850 # Find config file to use if not already selected in <testname>.opt file 851 # ---------------------------------------------------------------------- 852 if (not $tinfo->{template_path} ) 853 { 854 my $config= find_file_in_dirs($tinfo, dir => 'my.cnf'); 855 if (not $config) 856 { 857 # Suite has no config, autodetect which one to use 858 if ($tinfo->{rpl_test}) { 859 $config= "suite/rpl/my.cnf"; 860 } else { 861 $config= "include/default_my.cnf"; 862 } 863 } 864 $tinfo->{template_path}= $config; 865 } 866 867 # ---------------------------------------------------------------------- 868 # Append mysqld extra options to master and slave, as appropriate 869 # ---------------------------------------------------------------------- 870 push @{$tinfo->{'master_opt'}}, @$master_opts, @::opt_extra_mysqld_opt; 871 push @{$tinfo->{'slave_opt'}}, @$slave_opts, @::opt_extra_mysqld_opt; 872 873 process_opts($tinfo, 'master_opt'); 874 process_opts($tinfo, 'slave_opt'); 875 876 my @cases = ($tinfo); 877 for my $comb ($suite->{combinations}, @{$file_combinations{$filename}}) 878 { 879 @cases = map make_combinations($_, \%test_combs, @{$comb}), @cases; 880 } 881 my @no_combs = grep { $test_combs{$_} == 1 } keys %test_combs; 882 if (@no_combs) { 883 mtr_error("Could not run $name with '".( 884 join(',', sort @no_combs))."' combination(s)"); 885 } 886 887 for $tinfo (@cases) { 888 # 889 # Now we find a result file for every test file. It's a bit complicated. 890 # For a test foobar.test in the combination pair {aa,bb}, and in the 891 # overlay "rty" to the suite "qwe", in other words, for the 892 # that that mtr prints as 893 # ... 894 # qwe-rty.foobar 'aa,bb' [ pass ] 895 # ... 896 # the result can be expected in 897 # * either .rdiff or .result file 898 # * either in the overlay or in the original suite 899 # * with or without combinations in the file name. 900 # which means any of the following 15 file names can be used: 901 # 902 # 1 rty/r/foo,aa,bb.result 903 # 2 rty/r/foo,aa,bb.rdiff 904 # 3 qwe/r/foo,aa,bb.result 905 # 4 qwe/r/foo,aa,bb.rdiff 906 # 5 rty/r/foo,aa.result 907 # 6 rty/r/foo,aa.rdiff 908 # 7 qwe/r/foo,aa.result 909 # 8 qwe/r/foo,aa.rdiff 910 # 9 rty/r/foo,bb.result 911 # 10 rty/r/foo,bb.rdiff 912 # 11 qwe/r/foo,bb.result 913 # 12 qwe/r/foo,bb.rdiff 914 # 13 rty/r/foo.result 915 # 14 rty/r/foo.rdiff 916 # 15 qwe/r/foo.result 917 # 918 # They are listed, precisely, in the order of preference. 919 # mtr will walk that list from top to bottom and the first file that 920 # is found will be used. 921 # 922 # If this found file is a .rdiff, mtr continues walking down the list 923 # until the first .result file is found. 924 # A .rdiff is applied to that .result. 925 # 926 my $re =''; 927 928 if ($tinfo->{combinations}) { 929 $re = '(?:' . join('|', @{$tinfo->{combinations}}) . ')'; 930 } 931 my $resdirglob = $suite->{rdir}; 932 $resdirglob.= ',' . $suite->{parent}->{rdir} if $suite->{parent}; 933 934 my %files; 935 for (<{$resdirglob}/$tname*.{rdiff,result}>) { 936 my ($path, $combs, $ext) = 937 m@^(.*)/$tname((?:,$re)*)\.(rdiff|result)$@ or next; 938 my @combs = sort split /,/, $combs; 939 $files{$_} = join '~', ( # sort files by 940 99 - scalar(@combs), # number of combinations DESC 941 join(',', sort @combs), # combination names ASC 942 $path eq $suite->{rdir} ? 1 : 2, # overlay first 943 $ext eq 'result' ? 1 : 2 # result before rdiff 944 ); 945 } 946 my @results = sort { $files{$a} cmp $files{$b} } keys %files; 947 948 if (@results) { 949 my $result_file = shift @results; 950 $tinfo->{result_file} = $result_file; 951 952 if ($result_file =~ /\.rdiff$/) { 953 shift @results while $results[0] =~ /\.rdiff$/; 954 mtr_error ("$result_file has no corresponding .result file") 955 unless @results; 956 $tinfo->{base_result} = $results[0]; 957 958 if (not $::exe_patch) { 959 $tinfo->{skip} = 1; 960 $tinfo->{comment} = "requires patch executable"; 961 } 962 } 963 } else { 964 # No .result file exist 965 # Remember the path where it should be 966 # saved in case of --record 967 $tinfo->{record_file}= $suite->{rdir} . "/$tname.result"; 968 } 969 } 970 971 return @cases; 972} 973 974 975my $tags_map= {'big_test' => ['big_test', 1], 976 'master-slave' => ['rpl_test', 1], 977 'long_test' => ['long_test', 1], 978}; 979my $tags_regex_string= join('|', keys %$tags_map); 980my $tags_regex= qr:include/($tags_regex_string)\.inc:o; 981 982# Get various tags from a file, recursively scanning also included files. 983# And get options from .opt file, also recursively for included files. 984# Return a list of [TAG_TO_SET, VALUE_TO_SET_TO] of found tags. 985# Also returns lists of options for master and slave found in .opt files. 986# Each include file is scanned only once, and subsequent calls just look up the 987# cached result. 988# We need to be a bit careful about speed here; previous version of this code 989# took forever to scan the full test suite. 990sub get_tags_from_file($$) { 991 my ($file, $suite)= @_; 992 993 return @{$file_to_tags{$file}} if exists $file_to_tags{$file}; 994 995 my $F= IO::File->new($file) 996 or mtr_error("can't open file \"$file\": $!"); 997 998 my $tags= []; 999 my $master_opts= []; 1000 my $slave_opts= []; 1001 my @combinations; 1002 1003 my $over = defined $suite->{parent}; 1004 my $sdir = $suite->{dir}; 1005 my $pdir = $suite->{parent}->{dir} if $over; 1006 my $in_overlay = 0; 1007 my $suffix = $file; 1008 my @prefix = (''); 1009 1010 # to be able to look up all auxillary files in the overlay 1011 # we split the file path in a prefix and a suffix 1012 if ($file =~ m@^$sdir/(.*)$@) { 1013 $suffix = $1; 1014 @prefix = ("$sdir/"); 1015 push @prefix, "$pdir/" if $over; 1016 $in_overlay = $over; 1017 } elsif ($over and $file =~ m@^$pdir/(.*)$@) { 1018 $suffix = $1; 1019 @prefix = map { "$_/" } $sdir, $pdir; 1020 } else { 1021 $over = 0; # file neither in $sdir nor in $pdir 1022 } 1023 1024 while (my $line= <$F>) 1025 { 1026 # Ignore comments. 1027 next if $line =~ /^\#/; 1028 1029 # Add any tag we find. 1030 if ($line =~ /$tags_regex/o) 1031 { 1032 my $to_set= $tags_map->{$1}; 1033 for (my $i= 0; $i < @$to_set; $i+= 2) 1034 { 1035 push @$tags, [$to_set->[$i], $to_set->[$i+1]]; 1036 } 1037 } 1038 1039 # Check for a sourced include file. 1040 if ($line =~ /^(--)?[[:space:]]*source[[:space:]]+([^;[:space:]]+)/) 1041 { 1042 my $include= $2; 1043 # The rules below must match open_file() function of mysqltest.cc 1044 # Note that for the purpose of tag collection we ignore 1045 # non-existing files, and let mysqltest handle the error 1046 # (e.g. mysqltest.test needs this) 1047 for ((map { dirname("$_$suffix") } @prefix), 1048 $sdir, $pdir, $::glob_mysql_test_dir) 1049 { 1050 next unless defined $_; 1051 my $sourced_file = "$_/$include"; 1052 next if $sourced_file eq $file; 1053 if (-e $sourced_file) 1054 { 1055 push @$tags, get_tags_from_file($sourced_file, $suite); 1056 push @$master_opts, @{$file_to_master_opts{$sourced_file}}; 1057 push @$slave_opts, @{$file_to_slave_opts{$sourced_file}}; 1058 push @combinations, @{$file_combinations{$sourced_file}}; 1059 $file_in_overlay{$file} ||= $file_in_overlay{$sourced_file}; 1060 last; 1061 } 1062 } 1063 } 1064 } 1065 1066 # Add options from main file _after_ those of any includes; this allows a 1067 # test file to override options set by includes (eg. rpl.rpl_ddl uses this 1068 # to enable innodb, then disable innodb in the slave. 1069 $suffix =~ s/\.\w+$//; 1070 1071 for (qw(.opt -master.opt -slave.opt)) { 1072 my @res; 1073 push @res, opts_from_file("$prefix[1]$suffix$_") if $over; 1074 if (-f "$prefix[0]$suffix$_") { 1075 $in_overlay = $over; 1076 push @res, opts_from_file("$prefix[0]$suffix$_"); 1077 } 1078 push @$master_opts, @res unless /slave/; 1079 push @$slave_opts, @res unless /master/; 1080 } 1081 1082 # for combinations we need to make sure that its suite object is loaded, 1083 # even if this file does not belong to a current suite! 1084 my $comb_file = "$suffix.combinations"; 1085 $suite = load_suite_object(suite_for_file($comb_file)) if $prefix[0] eq ''; 1086 my @comb; 1087 unless ($suite->{skip}) { 1088 my $from = "$prefix[0]$comb_file"; 1089 @comb = combinations_from_file($over, $from); 1090 push @comb, 1091 grep { not $skip_combinations{"$from => $_->{name}"} } 1092 combinations_from_file(undef, "$prefix[1]$comb_file") if $over; 1093 } 1094 push @combinations, [ @comb ]; 1095 1096 # Save results so we can reuse without parsing if seen again. 1097 $file_to_tags{$file}= $tags; 1098 $file_to_master_opts{$file}= $master_opts; 1099 $file_to_slave_opts{$file}= $slave_opts; 1100 $file_combinations{$file}= [ ::uniq(@combinations) ]; 1101 $file_in_overlay{$file} = 1 if $in_overlay; 1102 1103 return @{$tags}; 1104} 1105 1106sub tags_from_test_file { 1107 my ($tinfo)= @_; 1108 my $file = $tinfo->{path}; 1109 1110 # a suite may generate tests that don't map to real *.test files 1111 # see unit suite for an example. 1112 return ([], []) unless -f $file; 1113 1114 for (get_tags_from_file($file, $tinfo->{suite})) 1115 { 1116 $tinfo->{$_->[0]}= $_->[1]; 1117 } 1118 return ($file_to_master_opts{$file}, $file_to_slave_opts{$file}); 1119} 1120 1121sub unspace { 1122 my $string= shift; 1123 my $quote= shift; 1124 $string =~ s/[ \t]/\x11/g; 1125 return "$quote$string$quote"; 1126} 1127 1128 1129sub opts_from_file ($) { 1130 my $file= shift; 1131 local $_; 1132 1133 return () unless -f $file; 1134 1135 open(FILE, '<', $file) or mtr_error("can't open file \"$file\": $!"); 1136 my @args; 1137 while ( <FILE> ) 1138 { 1139 chomp; 1140 1141 # --init_connect=set @a='a\\0c' 1142 s/^\s+//; # Remove leading space 1143 s/\s+$//; # Remove ending space 1144 1145 # This is strange, but we need to fill whitespace inside 1146 # quotes with something, to remove later. We do this to 1147 # be able to split on space. Else, we have trouble with 1148 # options like 1149 # 1150 # --someopt="--insideopt1 --insideopt2" 1151 # 1152 # But still with this, we are not 100% sure it is right, 1153 # we need a shell to do it right. 1154 1155 s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge; 1156 s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge; 1157 s/\'([^\'\"]*)\'/unspace($1,"\x0a")/ge; 1158 s/\"([^\'\"]*)\"/unspace($1,"\x0b")/ge; 1159 1160 foreach my $arg (split(/[ \t]+/)) 1161 { 1162 $arg =~ tr/\x11\x0a\x0b/ \'\"/; # Put back real chars 1163 # The outermost quotes has to go 1164 $arg =~ s/^([^\'\"]*)\'(.*)\'([^\'\"]*)$/$1$2$3/ 1165 or $arg =~ s/^([^\'\"]*)\"(.*)\"([^\'\"]*)$/$1$2$3/; 1166 $arg =~ s/\\\\/\\/g; 1167 1168 # Do not pass empty string since my_getopt is not capable to handle it. 1169 if (length($arg)) { 1170 push(@args, $arg); 1171 } 1172 } 1173 } 1174 close FILE; 1175 return @args; 1176} 1177 11781; 1179 1180