mirror of
https://github.com/MariaDB/server.git
synced 2025-04-26 11:49:09 +03:00
setup_boot_args(), setup_client_args(), setup_args() traversing datastructures on each invocation. Even if performance is not important to perl script (though it definitely saves some CO2), this nonetheless provokes some code-reading questions. Reading and debugging such code is not convenient. The better way is to prepare all the data in advance in an easily readable form as well as do the validation step before any further processing. Use mtr_report() instead of die() like the other code does. TODO: do_args() does even more data processing magic. Prepare that data according the above strategy in advance in pre_setup() if possible.
281 lines
8.1 KiB
Perl
281 lines
8.1 KiB
Perl
package My::Debugger;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Text::Wrap;
|
|
use Cwd;
|
|
use My::Platform;
|
|
use mtr_report;
|
|
|
|
# 1. options to support:
|
|
# --xxx[=ARGS]
|
|
# --manual-xxx[=ARGS]
|
|
# --client-xxx[=ARGS]
|
|
# --boot-xxx[=ARGS]
|
|
# TODO --manual-client-xxx[=ARGS]
|
|
# TODO --manual-boot-xxx[=ARGS]
|
|
# TODO --exec-xxx[=ARGS] (for $ENV{MYSQL}, etc)
|
|
#
|
|
# ARGS is a semicolon-separated list of commands for the
|
|
# command file. If the first command starts from '-' it'll
|
|
# be for a command line, not for a command file.
|
|
#
|
|
# 2. terminal to use: xterm
|
|
# TODO MTR_TERM="xterm -title {title} -e {command}"
|
|
#
|
|
# 3. debugger combinations are *not allowed*
|
|
# (thus no --valgrind --gdb)
|
|
#
|
|
# 4. variables for the command line / file templates:
|
|
# {vardir} -> vardir
|
|
# {exe} -> /path/to/binary/to/execute
|
|
# {args} -> command-line arguments, "-quoted
|
|
# {input}
|
|
# {type} -> client, mysqld.1, etc
|
|
# {script} -> vardir/tmp/{debugger}init.$type
|
|
# {log} -> vardir/log/$type.{debugger}
|
|
# {options} -> user options for the debugger.
|
|
#
|
|
# if {options} isn't used, they're auto-placed before {exe}
|
|
# or at the end if no {exe}
|
|
|
|
my %debuggers = (
|
|
gdb => {
|
|
term => 1,
|
|
options => '-x {script} {exe}',
|
|
script => 'set args {args} < {input}',
|
|
},
|
|
ddd => {
|
|
options => '--command {script} {exe}',
|
|
script => 'set args {args} < {input}',
|
|
},
|
|
dbx => {
|
|
term => 1,
|
|
options => '-c "stop in main; run {exe} {args} < {input}"',
|
|
},
|
|
devenv => {
|
|
options => '/debugexe {exe} {args}',
|
|
},
|
|
windbg => {
|
|
options => '{exe} {args}',
|
|
},
|
|
lldb => {
|
|
term => 1,
|
|
options => '-s {script} {exe}',
|
|
script => 'process launch --stop-at-entry -- {args}',
|
|
},
|
|
valgrind => {
|
|
options => '--tool=memcheck --show-reachable=yes --leak-check=yes --num-callers=16 --quiet --suppressions='.cwd().'/valgrind.supp {exe} {args} --loose-wait-for-pos-timeout=1500',
|
|
pre => sub {
|
|
my $debug_libraries_path= "/usr/lib/debug";
|
|
$ENV{LD_LIBRARY_PATH} .= ":$debug_libraries_path" if -d $debug_libraries_path;
|
|
}
|
|
},
|
|
strace => {
|
|
options => '-f -o {log} {exe} {args}',
|
|
},
|
|
rr => {
|
|
options => '_RR_TRACE_DIR={log} rr record {exe} {args}',
|
|
run => 'env',
|
|
pre => sub {
|
|
::mtr_error('rr requires kernel.perf_event_paranoid <= 1')
|
|
if ::mtr_grab_file('/proc/sys/kernel/perf_event_paranoid') > 1;
|
|
}
|
|
},
|
|
valgdb => {
|
|
term => 1,
|
|
run => 'gdb',
|
|
options => '-x {script} {exe}',
|
|
script => <<EEE,
|
|
py
|
|
import subprocess,shlex,time
|
|
valg=subprocess.Popen(shlex.split("""valgrind --tool=memcheck --show-reachable=yes --leak-check=yes --num-callers=16 --quiet --suppressions=valgrind.supp --vgdb-error=0 {exe} {args} --loose-wait-for-pos-timeout=1500"""))
|
|
time.sleep(2)
|
|
gdb.execute("target remote | /usr/lib64/valgrind/../../bin/vgdb --pid=" + str(valg.pid))
|
|
EEE
|
|
pre => sub {
|
|
my $debug_libraries_path= "/usr/lib/debug";
|
|
$ENV{LD_LIBRARY_PATH} .= ":$debug_libraries_path" if -d $debug_libraries_path;
|
|
}
|
|
},
|
|
|
|
# aliases
|
|
vsjitdebugger => 'windbg',
|
|
ktrace => 'strace',
|
|
);
|
|
|
|
my %opts;
|
|
my %opt_vals;
|
|
my $debugger;
|
|
my $boot_debugger;
|
|
my $client_debugger;
|
|
|
|
my $help = "\n\nOptions for running debuggers\n\n";
|
|
|
|
for my $k (sort keys %debuggers) {
|
|
my $v = $debuggers{$k};
|
|
$v = $debuggers{$k} = $debuggers{$v} if not ref $v; # resolve aliases
|
|
|
|
sub register_opt($$) {
|
|
my ($name, $msg) = @_;
|
|
$opts{"$name=s"} = \$opt_vals{$name};
|
|
$help .= wrap(sprintf(" %-23s", $name), ' 'x25, "$msg under $name\n");
|
|
}
|
|
|
|
$v->{script} = '' unless $v->{script};
|
|
$v->{options} =~ s/(\{exe\}|$)/ {options} $&/ unless $v->{options} =~ /\{options\}/;
|
|
|
|
register_opt "$k" => "Start mysqld";
|
|
register_opt "client-$k" => "Start mysqltest client";
|
|
register_opt "boot-$k" => "Start bootstrap server";
|
|
register_opt "manual-$k" => "Before running test(s) let user manually start mysqld";
|
|
}
|
|
|
|
sub subst($%) {
|
|
use warnings FATAL => 'uninitialized';
|
|
my ($templ, %vars) = @_;
|
|
$templ =~ s/\{(\w+)\}/$vars{$1}/g;
|
|
$templ;
|
|
}
|
|
|
|
sub do_args($$$$$) {
|
|
my ($args, $exe, $input, $type, $opt) = @_;
|
|
my $k = $opt =~ /^(?:client|boot|manual)-(.*)$/ ? $1 : $opt;
|
|
my $v = $debuggers{$k};
|
|
|
|
# on windows mtr args are quoted (for system), otherwise not (for exec)
|
|
sub quote($) { $_[0] =~ /[; ]/ ? "\"$_[0]\"" : $_[0] }
|
|
sub unquote($) { $_[0] =~ s/^"(.*)"$/$1/; $_[0] }
|
|
sub quote_from_mtr($) { IS_WINDOWS() ? $_[0] : quote($_[0]) }
|
|
sub unquote_for_mtr($) { IS_WINDOWS() ? $_[0] : unquote($_[0]) }
|
|
|
|
my %vars = (
|
|
vardir => $::opt_vardir,
|
|
exe => $$exe,
|
|
args => join(' ', map { quote_from_mtr $_ } @$$args,
|
|
'--loose-debug-gdb', '--loose-skip-stack-trace'),
|
|
input => $input,
|
|
script => "$::opt_vardir/tmp/${k}init.$type",
|
|
log => "$::opt_vardir/log/$type.$k",
|
|
options => '',
|
|
);
|
|
my @params = split /;/, $opt_vals{$opt};
|
|
$vars{options} = shift @params if @params and $params[0] =~ /^-/;
|
|
|
|
my $script = join "\n", @params;
|
|
if ($v->{script}) {
|
|
::mtr_tonewfile($vars{script}, subst($v->{script}, %vars)."\n".$script);
|
|
} elsif ($script) {
|
|
mtr_error "$k is not using a script file, nowhere to write the script \n---\n$script\n---";
|
|
}
|
|
|
|
my $options = subst($v->{options}, %vars);
|
|
@$$args = map { unquote_for_mtr $_ } $options =~ /("[^"]+"|\S+)/g;
|
|
my $run = $v->{run} || $k;
|
|
|
|
if ($opt =~ /^manual-/) {
|
|
print "\nTo start $k for $type, type in another window:\n";
|
|
print "$run $options\n";
|
|
$$exe= undef; # Indicate the exe should not be started
|
|
} elsif ($v->{term}) {
|
|
unshift @$$args, '-title', $type, '-e', $run;
|
|
$$exe = 'xterm';
|
|
} else {
|
|
$$exe = $run;
|
|
}
|
|
}
|
|
|
|
sub options() { %opts }
|
|
sub help() { $help }
|
|
|
|
sub fix_options(@) {
|
|
my $re=join '|', keys %opts;
|
|
$re =~ s/=s//g;
|
|
# FIXME: what is '=;'? What about ':s' to denote optional argument in register_opt()
|
|
map { $_ . (/^--($re)$/ and '=;') } @_;
|
|
}
|
|
|
|
sub pre_setup() {
|
|
my $used;
|
|
my %options;
|
|
my %client_options;
|
|
my %boot_options;
|
|
|
|
my $embedded= $::opt_embedded_server ? ' with --embedded' : '';
|
|
|
|
for my $k (keys %debuggers) {
|
|
for my $opt ($k, "manual-$k", "boot-$k", "client-$k") {
|
|
my $val= $opt_vals{$opt};
|
|
if ($val) {
|
|
$used = 1;
|
|
if ($debuggers{$k}->{pre}) {
|
|
$debuggers{$k}->{pre}->();
|
|
delete $debuggers{$k}->{pre};
|
|
}
|
|
if ($opt eq $k) {
|
|
$options{$opt}= $val;
|
|
$client_options{$opt}= $val
|
|
if $embedded;
|
|
} elsif ($opt eq "manual-$k") {
|
|
$options{$opt}= $val;
|
|
} elsif ($opt eq "boot-$k") {
|
|
$boot_options{$opt}= $val;
|
|
} elsif ($opt eq "client-$k") {
|
|
$client_options{$opt}= $val;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if ((keys %options) > 1) {
|
|
mtr_error "Multiple debuggers specified: ",
|
|
join (" ", map { "--$_" } keys %options);
|
|
}
|
|
|
|
if ((keys %boot_options) > 1) {
|
|
mtr_error "Multiple boot debuggers specified: ",
|
|
join (" ", map { "--$_" } keys %boot_options);
|
|
}
|
|
|
|
if ((keys %client_options) > 1) {
|
|
mtr_error "Multiple client debuggers specified: ",
|
|
join (" ", map { "--$_" } keys %client_options);
|
|
}
|
|
|
|
$debugger= (keys %options)[0];
|
|
$boot_debugger= (keys %boot_options)[0];
|
|
$client_debugger= (keys %client_options)[0];
|
|
|
|
if ($used) {
|
|
$ENV{ASAN_OPTIONS}= 'abort_on_error=1:'.($ENV{ASAN_OPTIONS} || '');
|
|
::mtr_error("Can't use --extern when using debugger") if $ENV{USE_RUNNING_SERVER};
|
|
|
|
$::opt_retry= 1;
|
|
$::opt_retry_failure= 1;
|
|
$::opt_testcase_timeout= 7 * 24 * 60; # in minutes
|
|
$::opt_suite_timeout= 7 * 24 * 60; # in minutes
|
|
$::opt_shutdown_timeout= 24 * 60 *60; # in seconds
|
|
$::opt_start_timeout= 24 * 60 * 60; # in seconds
|
|
}
|
|
}
|
|
|
|
sub setup_boot_args($$$) {
|
|
my ($args, $exe, $input) = @_;
|
|
do_args($args, $exe, $input, 'bootstrap', $boot_debugger)
|
|
if defined $boot_debugger;
|
|
}
|
|
|
|
sub setup_client_args($$) {
|
|
my ($args, $exe) = @_;
|
|
do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', 'client', $client_debugger)
|
|
if defined $client_debugger;
|
|
}
|
|
|
|
sub setup_args($$$) {
|
|
my ($args, $exe, $type) = @_;
|
|
do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', $type, $debugger)
|
|
if defined $debugger;
|
|
}
|
|
|
|
1;
|