1
0
mirror of https://github.com/MariaDB/server.git synced 2025-07-30 16:24:05 +03:00

generalization of mtr to support suite.pm extensions:

* no automatic --loose-skip-innodb added by mtr based on the test name.
  instead loose-skip-innodb is now in the default_mysqld.cnf
* have_innodb_plugin.inc is changed to give a verbose "skip" message
  (instead of "require: true")
* My::Suite class. It's support in mtr, and everywhere
* support for suite.pm
* when sorting tests, take combinations into account
* support for SUITENAME_COMBINATIONS
* no special treatment for innodb_plugin in mtr_cases.pm
* two special pre-created config groups: ENV and OPT
* allow option names to start from #
* allow magic option to have an argument
* remove dead code
* fix @-substitution to works as expected
* new processes take the value of $opt_verbose automatically, no need to pass it to a constructor
* innodb_plugin suite uses suite.pm and combinations file to test as much as possible
  (innodb plugin, xtradb plugin, xtradb static - whatever available)
* besides test-master.opt and test-slave.opt a test.opt file is also
  loaded, both for master and slave
* .opt files for all included files are loaded too
* progress report in the xterm titlebar
This commit is contained in:
Sergei Golubchik
2010-08-17 11:14:46 +04:00
parent b87a737739
commit 8da7be6302
111 changed files with 708 additions and 681 deletions

View File

@ -6,7 +6,6 @@ use strict;
use warnings;
use Carp;
sub new {
my ($class, $option_name, $option_value)= @_;
my $self= bless { name => $option_name,
@ -61,7 +60,7 @@ sub insert {
$option->{value}= $value;
}
else {
my $option= My::Config::Option->new($option_name, $value);
$option= My::Config::Option->new($option_name, $value);
# Insert option in list
push(@{$self->{options}}, $option);
# Insert option in hash
@ -163,6 +162,62 @@ sub if_exist {
return $option->value();
}
package My::Config::Group::ENV;
our @ISA=qw(My::Config::Group);
use strict;
use warnings;
use Carp;
sub new {
my ($class, $group_name)= @_;
bless My::Config::Group->new($group_name), $class;
}
#
# Return value for an option in the group, fail if it does not exist
#
sub value {
my ($self, $option_name)= @_;
my $option= $self->option($option_name);
if (! defined($option) and defined $ENV{$option_name}) {
my $value= $ENV{$option_name};
$option= My::Config::Option->new($option_name, $value);
}
croak "No option named '$option_name' in group '$self->{name}'"
if ! defined($option);
return $option->value();
}
package My::Config::Group::OPT;
our @ISA=qw(My::Config::Group);
use strict;
use warnings;
use Carp;
sub new {
my ($class, $group_name)= @_;
bless My::Config::Group->new($group_name), $class;
}
sub options {
my ($self)= @_;
()
}
sub value {
my ($self, $option_name)= @_;
my $option= $self->option($option_name);
croak "No option named '$option_name' in group '$self->{name}'"
if ! defined($option);
return $option->value()->();
}
package My::Config;
@ -182,7 +237,10 @@ sub new {
my ($class, $path)= @_;
my $group_name= undef;
my $self= bless { groups => [] }, $class;
my $self= bless { groups => [
My::Config::Group::ENV->new('ENV'),
My::Config::Group::OPT->new('OPT'),
] }, $class;
my $F= IO::File->new($path, "<")
or croak "Could not open '$path': $!";
@ -199,19 +257,13 @@ sub new {
}
# Magic #! comments
elsif ( $line =~ /^#\!/) {
my $magic= $line;
elsif ( $line =~ /^(#\!\S+)(?:\s*(.*?)\s*)?$/) {
my ($magic, $arg)= ($1, $2);
croak "Found magic comment '$magic' outside of group"
unless $group_name;
#print "$magic\n";
$self->insert($group_name, $magic, undef);
}
# Comments
elsif ( $line =~ /^#/ || $line =~ /^;/) {
# Skip comment
next;
$self->insert($group_name, $magic, $arg);
}
# Empty lines
@ -236,7 +288,7 @@ sub new {
}
# <option>
elsif ( $line =~ /^([\@\w-]+)\s*$/ ) {
elsif ( $line =~ /^(#?[\w-]+)\s*$/ ) {
my $option= $1;
croak "Found option '$option' outside of group"
@ -247,7 +299,7 @@ sub new {
}
# <option>=<value>
elsif ( $line =~ /^([\@\w-]+)\s*=\s*(.*?)\s*$/ ) {
elsif ( $line =~ /^(#?[\w-]+)\s*=\s*(.*?)\s*$/ ) {
my $option= $1;
my $value= $2;
@ -256,10 +308,17 @@ sub new {
#print "$option=$value\n";
$self->insert($group_name, $option, $value);
} else {
croak "Unexpected line '$line' found in '$path'";
}
# Comments
elsif ( $line =~ /^#/ || $line =~ /^;/) {
# Skip comment
next;
}
else {
croak "Unexpected line '$line' found in '$path'";
}
}
undef $F; # Close the file
@ -437,44 +496,4 @@ sub exists {
return defined($option);
}
# Overload "to string"-operator with 'stringify'
use overload
'""' => \&stringify;
#
# Return the config as a string in my.cnf file format
#
sub stringify {
my ($self)= @_;
my $res;
foreach my $group ($self->groups()) {
$res .= "[$group->{name}]\n";
foreach my $option ($group->options()) {
$res .= $option->name();
my $value= $option->value();
if (defined $value) {
$res .= "=$value";
}
$res .= "\n";
}
$res .= "\n";
}
return $res;
}
#
# Save the config to named file
#
sub save {
my ($self, $path)= @_;
my $F= IO::File->new($path, ">")
or croak "Could not open '$path': $!";
print $F $self;
undef $F; # Close the file
}
1;

View File

@ -57,16 +57,12 @@ sub fix_pidfile {
sub fix_port {
my ($self, $config, $group_name, $group)= @_;
my $hostname= $group->value('#host');
return $self->{HOSTS}->{$hostname}++;
return $self->{PORT}++;
}
sub fix_host {
my ($self)= @_;
# Get next host from HOSTS array
my @hosts= keys(%{$self->{HOSTS}});;
my $host_no= $self->{NEXT_HOST}++ % @hosts;
return $hosts[$host_no];
'localhost'
}
sub is_unique {
@ -229,7 +225,7 @@ if (IS_WINDOWS)
sub fix_ndb_mgmd_port {
my ($self, $config, $group_name, $group)= @_;
my $hostname= $group->value('HostName');
return $self->{HOSTS}->{$hostname}++;
return $self->{PORT}++;
}
@ -428,20 +424,24 @@ sub post_check_embedded_group {
sub resolve_at_variable {
my ($self, $config, $group, $option)= @_;
local $_ = $option->value();
my ($res, $after);
# Split the options value on last .
my @parts= split(/\./, $option->value());
my $option_name= pop(@parts);
my $group_name= join('.', @parts);
while (m/(.*?)\@((?:\w+\.)+)(#?[-\w]+)/g) {
my ($before, $group_name, $option_name)= ($1, $2, $3);
$after = $';
chop($group_name);
$group_name =~ s/^\@//; # Remove at
my $from_group= $config->group($group_name)
or croak "There is no group named '$group_name' that ",
"can be used to resolve '$option_name'";
my $from_group= $config->group($group_name)
or croak "There is no group named '$group_name' that ",
"can be used to resolve '$option_name'";
my $value= $from_group->value($option_name);
$res .= $before.$value;
}
$res .= $after;
my $from= $from_group->value($option_name);
$config->insert($group->name(), $option->name(), $from)
$config->insert($group->name(), $option->name(), $res)
}
@ -453,7 +453,7 @@ sub post_fix_resolve_at_variables {
next unless defined $option->value();
$self->resolve_at_variable($config, $group, $option)
if ($option->value() =~ /^\@/);
if ($option->value() =~ /\@/);
}
}
}
@ -595,28 +595,18 @@ sub new_config {
croak "you must pass '$required'" unless defined $args->{$required};
}
# Fill in hosts/port hash
my $hosts= {};
my $baseport= $args->{baseport};
$args->{hosts}= [ 'localhost' ] unless exists($args->{hosts});
foreach my $host ( @{$args->{hosts}} ) {
$hosts->{$host}= $baseport;
}
# Open the config template
my $config= My::Config->new($args->{'template_path'});
my $extra_template_path= $args->{'extra_template_path'};
if ($extra_template_path){
$config->append(My::Config->new($extra_template_path));
}
my $self= bless {
CONFIG => $config,
ARGS => $args,
HOSTS => $hosts,
NEXT_HOST => 0,
PORT => $args->{baseport},
SERVER_ID => 1,
}, $class;
# add auto-options
$config->insert('OPT', 'port' => sub { fix_port($self, $config) });
$config->insert('OPT', 'vardir' => sub { shift->{ARGS}->{vardir} });
{
# Run pre rules

0
mysql-test/lib/My/Handles.pm Executable file → Normal file
View File

View File

@ -120,7 +120,7 @@ sub new {
my $input = delete($opts{'input'});
my $output = delete($opts{'output'});
my $error = delete($opts{'error'});
my $verbose = delete($opts{'verbose'});
my $verbose = delete($opts{'verbose'}) || $::opt_verbose;
my $nocore = delete($opts{'nocore'});
my $host = delete($opts{'host'});
my $shutdown = delete($opts{'shutdown'});

View File

@ -0,0 +1,10 @@
# A default suite class that is used for all suites without their owns suite.pm
# see README.suites for a description
package My::Suite;
sub config_files { () }
sub servers { () }
bless { };

View File

@ -20,6 +20,12 @@ sub new {
return $self;
}
sub fullname {
my ($self)= @_;
$self->{name} . (defined $self->{combination}
? " '$self->{combination}'"
: "")
}
#
# Return a unique key that can be used to