|
| 1 | +package My::Debugger; |
| 2 | + |
| 3 | +use strict; |
| 4 | +use warnings; |
| 5 | +use Text::Wrap; |
| 6 | +use Cwd; |
| 7 | + |
| 8 | +# 1. options to support: |
| 9 | +# --xxx[=ARGS] |
| 10 | +# --manual-xxx[=ARGS] |
| 11 | +# --client-xxx[=ARGS] |
| 12 | +# --boot-xxx[=ARGS] |
| 13 | +# TODO --manual-client-xxx[=ARGS] |
| 14 | +# TODO --manual-boot-xxx[=ARGS] |
| 15 | +# TODO --exec-xxx[=ARGS] (for $ENV{MYSQL}, etc) |
| 16 | +# |
| 17 | +# ARGS is a semicolon-separated list of commands for the |
| 18 | +# command file. If the first command starts from '-' it'll |
| 19 | +# be for a command line, not for a command file. |
| 20 | +# |
| 21 | +# 2. terminal to use: xterm |
| 22 | +# TODO MTR_TERM="xterm -title {title} -e {command}" |
| 23 | +# |
| 24 | +# 3. debugger combinations are *not allowed* |
| 25 | +# (thus no --valgrind --gdb) |
| 26 | +# |
| 27 | +# 4. variables for the command line / file templates: |
| 28 | +# {vardir} -> vardir |
| 29 | +# {exe} -> /path/to/binary/to/execute |
| 30 | +# {args} -> command-line arguments, "-quoted |
| 31 | +# {input} |
| 32 | +# {type} -> client, mysqld.1, etc |
| 33 | +# {script} -> vardir/tmp/{debugger}init.$type |
| 34 | +# {log} -> vardir/log/$type.{debugger} |
| 35 | +# {options} -> user options for the debugger. |
| 36 | +# |
| 37 | +# if {options} isn't used, they're auto-placed before {exe} |
| 38 | +# or at the end if no {exe} |
| 39 | + |
| 40 | +my %debuggers = ( |
| 41 | + gdb => { |
| 42 | + term => 1, |
| 43 | + options => '-x {script} {exe}', |
| 44 | + script => 'set args {args} < {input}', |
| 45 | + }, |
| 46 | + ddd => { |
| 47 | + options => '--command {script} {exe}', |
| 48 | + script => 'set args {args} < {input}', |
| 49 | + }, |
| 50 | + dbx => { |
| 51 | + term => 1, |
| 52 | + options => '-c "stop in main; run {exe} {args} < {input}"', |
| 53 | + }, |
| 54 | + devenv => { |
| 55 | + options => '/debugexe {exe} {args}', |
| 56 | + }, |
| 57 | + windbg => { |
| 58 | + options => '{exe} {args}', |
| 59 | + }, |
| 60 | + lldb => { |
| 61 | + term => 1, |
| 62 | + options => '-s {script} {exe}', |
| 63 | + script => 'process launch --stop-at-entry {args}', |
| 64 | + }, |
| 65 | + valgrind => { |
| 66 | + 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', |
| 67 | + pre => sub { |
| 68 | + my $debug_libraries_path= "/usr/lib/debug"; |
| 69 | + $ENV{LD_LIBRARY_PATH} .= ":$debug_libraries_path" if -d $debug_libraries_path; |
| 70 | + } |
| 71 | + }, |
| 72 | + strace => { |
| 73 | + options => '-f -o {log} {exe} {args}', |
| 74 | + }, |
| 75 | + rr => { |
| 76 | + options => 'record -o {log} {exe} {args}', |
| 77 | + pre => sub { |
| 78 | + ::mtr_error('rr requires kernel.perf_event_paranoid <= 1') |
| 79 | + if ::mtr_grab_file('/proc/sys/kernel/perf_event_paranoid') > 1; |
| 80 | + } |
| 81 | + }, |
| 82 | + |
| 83 | + # aliases |
| 84 | + vsjitdebugger => 'windbg', |
| 85 | + ktrace => 'strace', |
| 86 | +); |
| 87 | + |
| 88 | +my %opts; |
| 89 | +my %opt_vals; |
| 90 | +my $help = "\n\nOptions for running debuggers\n\n"; |
| 91 | + |
| 92 | +for my $k (sort keys %debuggers) { |
| 93 | + my $v = $debuggers{$k}; |
| 94 | + $v = $debuggers{$k} = $debuggers{$v} if not ref $v; # resolve aliases |
| 95 | + |
| 96 | + sub register_opt($$) { |
| 97 | + my ($name, $msg) = @_; |
| 98 | + $opts{"$name=s"} = \$opt_vals{$name}; |
| 99 | + $help .= wrap(sprintf(" %-23s", $name), ' 'x25, "$msg under $name\n"); |
| 100 | + } |
| 101 | + |
| 102 | + $v->{script} = '' unless $v->{script}; |
| 103 | + $v->{options} =~ s/(\{exe\}|$)/ {options} $&/ unless $v->{options} =~ /\{options\}/; |
| 104 | + |
| 105 | + register_opt "$k" => "Start mysqld"; |
| 106 | + register_opt "client-$k" => "Start mysqltest client"; |
| 107 | + register_opt "boot-$k" => "Start bootstrap server"; |
| 108 | + register_opt "manual-$k" => "Before running test(s) let user manually start mysqld"; |
| 109 | +} |
| 110 | + |
| 111 | +sub subst($%) { |
| 112 | + use warnings FATAL => 'uninitialized'; |
| 113 | + my ($templ, %vars) = @_; |
| 114 | + $templ =~ s/\{(\w+)\}/$vars{$1}/g; |
| 115 | + $templ; |
| 116 | +} |
| 117 | + |
| 118 | +sub do_args($$$$$) { |
| 119 | + my ($args, $exe, $input, $type, $opt) = @_; |
| 120 | + my $k = $opt =~ /^(?:client|boot|manual)-(.*)$/ ? $1 : $opt; |
| 121 | + my $v = $debuggers{$k}; |
| 122 | + |
| 123 | + # on windows mtr args are quoted (for system), otherwise not (for exec) |
| 124 | + sub quote($) { $_[0] =~ / / ? "\"$_[0]\"" : $_[0] } |
| 125 | + sub unquote($) { $_[0] =~ s/^"(.*)"$/$1/; $_[0] } |
| 126 | + sub quote_from_mtr($) { ::IS_WINDOWS ? $_[0] : quote($_[0]) } |
| 127 | + sub unquote_for_mtr($) { ::IS_WINDOWS ? $_[0] : unquote($_[0]) } |
| 128 | + |
| 129 | + my %vars = ( |
| 130 | + vardir => $::opt_vardir, |
| 131 | + exe => $$exe, |
| 132 | + args => join(' ', map { quote_from_mtr $_ } @$$args, '--gdb'), |
| 133 | + input => $input, |
| 134 | + script => "$::opt_vardir/tmp/${k}init.$type", |
| 135 | + log => "$::opt_vardir/log/$type.$k", |
| 136 | + options => '', |
| 137 | + ); |
| 138 | + my @params = split /;/, $opt_vals{$opt}; |
| 139 | + $vars{options} = shift @params if @params and $params[0] =~ /^-/; |
| 140 | + |
| 141 | + my $script = join "\n", @params; |
| 142 | + if ($v->{script}) { |
| 143 | + ::mtr_tofile($vars{script}, subst($v->{script}, %vars)."\n".$script); |
| 144 | + } elsif ($script) { |
| 145 | + die "$k is not using a script file, nowhere to write the script \n---\n$script\n---\n"; |
| 146 | + } |
| 147 | + |
| 148 | + my $options = subst($v->{options}, %vars); |
| 149 | + @$$args = map { unquote_for_mtr $_ } $options =~ /("[^"]+"|\S+)/g; |
| 150 | + |
| 151 | + if ($opt =~ /^manual-/) { |
| 152 | + print "\nTo start $k for $type, type in another window:\n"; |
| 153 | + print "$k $options\n"; |
| 154 | + $$exe= undef; # Indicate the exe should not be started |
| 155 | + } elsif ($v->{term}) { |
| 156 | + unshift @$$args, '-title', $type, '-e', $k; |
| 157 | + $$exe = 'xterm'; |
| 158 | + } else { |
| 159 | + $$exe = $k; |
| 160 | + } |
| 161 | +} |
| 162 | + |
| 163 | +sub options() { %opts } |
| 164 | +sub help() { $help } |
| 165 | + |
| 166 | +sub fix_options(@) { |
| 167 | + my $re=join '|', keys %opts; |
| 168 | + $re =~ s/=s//g; |
| 169 | + map { $_ . (/^--($re)$/ and '=;') } @_; |
| 170 | +} |
| 171 | + |
| 172 | +sub pre_setup() { |
| 173 | + my $used; |
| 174 | + for my $k (keys %debuggers) { |
| 175 | + for my $opt ($k, "manual-$k", "boot-$k", "client-$k") { |
| 176 | + if ($opt_vals{$opt}) |
| 177 | + { |
| 178 | + $used = 1; |
| 179 | + if ($debuggers{$k}->{pre}) { |
| 180 | + $debuggers{$k}->{pre}->(); |
| 181 | + delete $debuggers{$k}->{pre}; |
| 182 | + } |
| 183 | + } |
| 184 | + } |
| 185 | + } |
| 186 | + |
| 187 | + if ($used) { |
| 188 | + $ENV{ASAN_OPTIONS}= 'abort_on_error=1:'.($ENV{ASAN_OPTIONS} || ''); |
| 189 | + ::mtr_error("Can't use --extern when using debugger") if $ENV{USE_RUNNING_SERVER}; |
| 190 | + |
| 191 | + $::opt_retry= 1; |
| 192 | + $::opt_retry_failure= 1; |
| 193 | + $::opt_testcase_timeout= 7 * 24 * 60; # in minutes |
| 194 | + $::opt_suite_timeout= 7 * 24 * 60; # in minutes |
| 195 | + $::opt_shutdown_timeout= 24 * 60 *60; # in seconds |
| 196 | + $::opt_start_timeout= 24 * 60 * 60; # in seconds |
| 197 | + } |
| 198 | +} |
| 199 | + |
| 200 | +sub setup_boot_args($$$) { |
| 201 | + my ($args, $exe, $input) = @_; |
| 202 | + my $found; |
| 203 | + |
| 204 | + for my $k (keys %debuggers) { |
| 205 | + if ($opt_vals{"boot-$k"}) { |
| 206 | + die "--boot-$k and --$found cannot be used at the same time\n" if $found; |
| 207 | + |
| 208 | + $found="boot-$k"; |
| 209 | + do_args($args, $exe, $input, 'bootstrap', $found); |
| 210 | + } |
| 211 | + } |
| 212 | +} |
| 213 | + |
| 214 | +sub setup_client_args($$) { |
| 215 | + my ($args, $exe) = @_; |
| 216 | + my $found; |
| 217 | + my $embedded = $::opt_embedded_server ? ' with --embedded' : ''; |
| 218 | + |
| 219 | + for my $k (keys %debuggers) { |
| 220 | + my @opt_names=("client-$k"); |
| 221 | + push @opt_names, $k if $embedded; |
| 222 | + for my $opt (@opt_names) { |
| 223 | + if ($opt_vals{$opt}) { |
| 224 | + die "--$opt and --$found cannot be used at the same time$embedded\n" if $found; |
| 225 | + $found=$opt; |
| 226 | + do_args($args, $exe, ::IS_WINDOWS ? 'NUL' : '/dev/null', 'client', $found); |
| 227 | + } |
| 228 | + } |
| 229 | + } |
| 230 | +} |
| 231 | + |
| 232 | +sub setup_args($$$) { |
| 233 | + my ($args, $exe, $type) = @_; |
| 234 | + my $found; |
| 235 | + |
| 236 | + for my $k (keys %debuggers) { |
| 237 | + for my $opt ($k, "manual-$k") { |
| 238 | + if ($opt_vals{$opt}) { |
| 239 | + die "--$opt and --$found cannot be used at the same time\n" if $found; |
| 240 | + $found=$opt; |
| 241 | + do_args($args, $exe, ::IS_WINDOWS ? 'NUL' : '/dev/null', $type, $found); |
| 242 | + } |
| 243 | + } |
| 244 | + } |
| 245 | +} |
| 246 | + |
| 247 | +1; |
0 commit comments