From 83f7d25c440ab7c4279c0716a5dea41de8238b75 Mon Sep 17 00:00:00 2001 From: Aleksey Midenkov Date: Mon, 18 Jul 2022 23:16:17 +0300 Subject: MDEV-28931 Cleanup: try GDB to print core first Do we still need this Sun Studio hack? --- mysql-test/lib/My/CoreDump.pm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'mysql-test/lib') diff --git a/mysql-test/lib/My/CoreDump.pm b/mysql-test/lib/My/CoreDump.pm index 3f983b8e72f..801b3136cd2 100644 --- a/mysql-test/lib/My/CoreDump.pm +++ b/mysql-test/lib/My/CoreDump.pm @@ -316,13 +316,10 @@ sub show { return; } - # We try dbx first; gdb itself may coredump if run on a Sun Studio - # compiled binary on Solaris. - my @debuggers = ( - \&_dbx, \&_gdb, + \&_dbx, \&_lldb, # TODO... ); -- cgit v1.2.1 From ce7820eb838c8413fb0fe1d3812c43824b508eab Mon Sep 17 00:00:00 2001 From: Aleksey Midenkov Date: Mon, 18 Jul 2022 23:16:17 +0300 Subject: MDEV-28931 --verbose option is too verbose GetOpt::Long bundling option for convenient one-char verbosity levels: -v General verbosity (file and execute operations) -vv High verbosity (algorithmic considerations) -vvv Debug verbosity (anything else) --- mysql-test/lib/mtr_cases.pm | 16 ++++++++-------- mysql-test/lib/mtr_process.pl | 10 +++++----- mysql-test/lib/mtr_report.pm | 11 ++++++++++- mysql-test/lib/v1/mtr_cases.pl | 18 +++++++++--------- mysql-test/lib/v1/mtr_timer.pl | 6 +++--- 5 files changed, 35 insertions(+), 26 deletions(-) (limited to 'mysql-test/lib') diff --git a/mysql-test/lib/mtr_cases.pm b/mysql-test/lib/mtr_cases.pm index dc385cb6c78..b252840555d 100644 --- a/mysql-test/lib/mtr_cases.pm +++ b/mysql-test/lib/mtr_cases.pm @@ -87,7 +87,7 @@ sub init_pattern { # separator betwen suite and testname), make the pattern match # beginning of string $from= "^$from"; - mtr_verbose("$what='$from'"); + mtr_verbose2("$what='$from'"); } # Check that pattern is a valid regex eval { "" =~/$from/; 1 } or @@ -292,7 +292,7 @@ sub combinations_from_file($$) } else { return () if @::opt_combinations or not -f $filename; # Read combinations file in my.cnf format - mtr_verbose("Read combinations file $filename"); + mtr_verbose2("Read combinations file $filename"); my $config= My::Config->new($filename); foreach my $group ($config->option_groups()) { my $comb= { name => $group->name(), comb_opt => [] }; @@ -426,9 +426,9 @@ sub collect_suite_name($$) sub collect_one_suite { my ($opt_cases, $suitename, $over, $suitedir, @overlays) = @_; - mtr_verbose("Collecting: $suitename"); - mtr_verbose("suitedir: $suitedir"); - mtr_verbose("overlays: @overlays") if @overlays; + mtr_verbose2("Collecting: $suitename"); + mtr_verbose2("suitedir: $suitedir"); + mtr_verbose2("overlays: @overlays") if @overlays; # we always need to process the parent suite, even if we won't use any # test from it. @@ -500,8 +500,8 @@ sub process_suite { $suite->{rdir} = -d $rdir ? $rdir : $suite->{tdir}; } - mtr_verbose("testdir: " . $suite->{tdir}); - mtr_verbose( "resdir: " . $suite->{rdir}); + mtr_verbose2("testdir: " . $suite->{tdir}); + mtr_verbose2( "resdir: " . $suite->{rdir}); # disabled.def parse_disabled($suite->{dir} .'/disabled.def', $suitename); @@ -511,7 +511,7 @@ sub process_suite { if (@::opt_combinations) { # take the combination from command-line - mtr_verbose("Take the combination from command line"); + mtr_verbose2("Take the combination from command line"); foreach my $combination (@::opt_combinations) { my $comb= {}; $comb->{name}= $combination; diff --git a/mysql-test/lib/mtr_process.pl b/mysql-test/lib/mtr_process.pl index 2ff78c0e10a..681ac4ca201 100644 --- a/mysql-test/lib/mtr_process.pl +++ b/mysql-test/lib/mtr_process.pl @@ -46,7 +46,7 @@ sub mtr_ping_port ($); sub mtr_ping_port ($) { my $port= shift; - mtr_verbose("mtr_ping_port: $port"); + mtr_verbose2("mtr_ping_port: $port"); if (IS_WINDOWS && USE_NETPING) { @@ -56,12 +56,12 @@ sub mtr_ping_port ($) { $ping->port_number($port); if ($ping->ping("localhost",0.1)) { - mtr_verbose("USED"); + mtr_verbose2("USED"); return 1; } else { - mtr_verbose("FREE"); + mtr_verbose2("FREE"); return 0; } } @@ -84,12 +84,12 @@ sub mtr_ping_port ($) { if ( connect(SOCK, $paddr) ) { close(SOCK); # FIXME check error? - mtr_verbose("USED"); + mtr_verbose2("USED"); return 1; } else { - mtr_verbose("FREE"); + mtr_verbose2("FREE"); return 0; } } diff --git a/mysql-test/lib/mtr_report.pm b/mysql-test/lib/mtr_report.pm index 8144a6ef02e..2a8ed65eb2c 100644 --- a/mysql-test/lib/mtr_report.pm +++ b/mysql-test/lib/mtr_report.pm @@ -27,7 +27,7 @@ use Sys::Hostname; use base qw(Exporter); our @EXPORT= qw(report_option mtr_print_line mtr_print_thick_line mtr_print_header mtr_report mtr_report_stats - mtr_warning mtr_error mtr_debug mtr_verbose + mtr_warning mtr_error mtr_debug mtr_verbose mtr_verbose2 mtr_verbose_restart mtr_report_test_passed mtr_report_test_skipped mtr_print mtr_report_test isotime); @@ -716,6 +716,15 @@ sub mtr_verbose (@) { } +sub mtr_verbose2 (@) { + if ( $verbose > 1 ) + { + print STDERR _name(). _timestamp(). + "> ".join(" ", @_)."\n"; + } +} + + sub mtr_verbose_restart (@) { my ($server, @args)= @_; my $proc= $server->{proc}; diff --git a/mysql-test/lib/v1/mtr_cases.pl b/mysql-test/lib/v1/mtr_cases.pl index faa673a9304..cc190cb39f7 100644 --- a/mysql-test/lib/v1/mtr_cases.pl +++ b/mysql-test/lib/v1/mtr_cases.pl @@ -126,19 +126,19 @@ sub collect_test_cases ($) { { my $base_name= $1; my $idx= $2; - mtr_verbose("$test_name => $base_name idx=$idx"); + mtr_verbose2("$test_name => $base_name idx=$idx"); if ( $idx > 1 ) { $idx-= 1; $base_name= "$base_name$idx"; - mtr_verbose("New basename $base_name"); + mtr_verbose2("New basename $base_name"); } foreach my $tinfo2 (@$cases) { if ( $tinfo2->{'name'} eq $base_name ) { - mtr_verbose("found dependent test $tinfo2->{'name'}"); + mtr_verbose2("found dependent test $tinfo2->{'name'}"); $depend_on_test_name=$base_name; } } @@ -146,7 +146,7 @@ sub collect_test_cases ($) { if ( defined $depend_on_test_name ) { - mtr_verbose("Giving $test_name same critera as $depend_on_test_name"); + mtr_verbose2("Giving $test_name same critera as $depend_on_test_name"); $sort_criteria{$test_name} = $sort_criteria{$depend_on_test_name}; } else @@ -224,14 +224,14 @@ sub collect_one_suite($) my $suite= shift; # Test suite name my @cases; # Array of hash - mtr_verbose("Collecting: $suite"); + mtr_verbose2("Collecting: $suite"); my $suitedir= "$::glob_mysql_test_dir"; # Default if ( $suite ne "main" ) { $suitedir= mtr_path_exists("$suitedir/suite/$suite", "$suitedir/$suite"); - mtr_verbose("suitedir: $suitedir"); + mtr_verbose2("suitedir: $suitedir"); } my $testdir= "$suitedir/t"; @@ -363,7 +363,7 @@ sub collect_one_suite($) if (@::opt_combinations) { # take the combination from command-line - mtr_verbose("Take the combination from command line"); + mtr_verbose2("Take the combination from command line"); foreach my $combination (@::opt_combinations) { my $comb= {}; $comb->{name}= $combination; @@ -374,7 +374,7 @@ sub collect_one_suite($) elsif (-f $combination_file ) { # Read combinations file in my.cnf format - mtr_verbose("Read combinations file"); + mtr_verbose2("Read combinations file"); my $config= My::Config->new($combination_file); foreach my $group ($config->groups()) { @@ -605,7 +605,7 @@ sub collect_one_test_case($$$$$$$$$) { # Add suite opts foreach my $opt ( @$suite_opts ) { - mtr_verbose($opt); + mtr_verbose2($opt); push(@{$tinfo->{'master_opt'}}, $opt); push(@{$tinfo->{'slave_opt'}}, $opt); } diff --git a/mysql-test/lib/v1/mtr_timer.pl b/mysql-test/lib/v1/mtr_timer.pl index 630a93ca7dc..98dc27b3f0f 100644 --- a/mysql-test/lib/v1/mtr_timer.pl +++ b/mysql-test/lib/v1/mtr_timer.pl @@ -80,7 +80,7 @@ sub mtr_timer_start($$$) { if ( $tpid ) { # Parent, record the information - mtr_verbose("Starting timer for '$name',", + mtr_verbose2("Starting timer for '$name',", "duration: $duration, pid: $tpid"); $timers->{'timers'}->{$name}->{'pid'}= $tpid; $timers->{'timers'}->{$name}->{'duration'}= $duration; @@ -96,13 +96,13 @@ sub mtr_timer_start($$$) { $SIG{INT}= 'DEFAULT'; $SIG{TERM}= sub { - mtr_verbose("timer $$ woke up, exiting!"); + mtr_verbose2("timer $$ woke up, exiting!"); exit(0); }; $0= "mtr_timer(timers,$name,$duration)"; sleep($duration); - mtr_verbose("timer $$ expired after $duration seconds"); + mtr_verbose2("timer $$ expired after $duration seconds"); exit(0); } } -- cgit v1.2.1 From 220fb6797b7447d500f1103d5ce556255939c762 Mon Sep 17 00:00:00 2001 From: Aleksey Midenkov Date: Mon, 18 Jul 2022 23:16:17 +0300 Subject: MDEV-28931 Debugger.pm readability fix 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. --- mysql-test/lib/My/Debugger.pm | 89 +++++++++++++++++++++++++------------------ 1 file changed, 51 insertions(+), 38 deletions(-) (limited to 'mysql-test/lib') diff --git a/mysql-test/lib/My/Debugger.pm b/mysql-test/lib/My/Debugger.pm index 8d09189e766..f472a4c3316 100644 --- a/mysql-test/lib/My/Debugger.pm +++ b/mysql-test/lib/My/Debugger.pm @@ -5,6 +5,7 @@ use warnings; use Text::Wrap; use Cwd; use My::Platform; +use mtr_report; # 1. options to support: # --xxx[=ARGS] @@ -105,6 +106,10 @@ EEE 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) { @@ -161,7 +166,7 @@ sub do_args($$$$$) { if ($v->{script}) { ::mtr_tonewfile($vars{script}, subst($v->{script}, %vars)."\n".$script); } elsif ($script) { - die "$k is not using a script file, nowhere to write the script \n---\n$script\n---\n"; + mtr_error "$k is not using a script file, nowhere to write the script \n---\n$script\n---"; } my $options = subst($v->{options}, %vars); @@ -186,24 +191,61 @@ 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") { - if ($opt_vals{$opt}) - { + 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}; @@ -219,49 +261,20 @@ sub pre_setup() { sub setup_boot_args($$$) { my ($args, $exe, $input) = @_; - my $found; - - for my $k (keys %debuggers) { - if ($opt_vals{"boot-$k"}) { - die "--boot-$k and --$found cannot be used at the same time\n" if $found; - - $found="boot-$k"; - do_args($args, $exe, $input, 'bootstrap', $found); - } - } + do_args($args, $exe, $input, 'bootstrap', $boot_debugger) + if defined $boot_debugger; } sub setup_client_args($$) { my ($args, $exe) = @_; - my $found; - my $embedded = $::opt_embedded_server ? ' with --embedded' : ''; - - for my $k (keys %debuggers) { - my @opt_names=("client-$k"); - push @opt_names, $k if $embedded; - for my $opt (@opt_names) { - if ($opt_vals{$opt}) { - die "--$opt and --$found cannot be used at the same time$embedded\n" if $found; - $found=$opt; - do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', 'client', $found); - } - } - } + do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', 'client', $client_debugger) + if defined $client_debugger; } sub setup_args($$$) { my ($args, $exe, $type) = @_; - my $found; - - for my $k (keys %debuggers) { - for my $opt ($k, "manual-$k") { - if ($opt_vals{$opt}) { - die "--$opt and --$found cannot be used at the same time\n" if $found; - $found=$opt; - do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', $type, $found); - } - } - } + do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', $type, $debugger) + if defined $debugger; } 1; -- cgit v1.2.1 From e9be5428a27eaaccf142f2bd53f4d30e8e368484 Mon Sep 17 00:00:00 2001 From: Aleksey Midenkov Date: Mon, 18 Jul 2022 23:16:17 +0300 Subject: MDEV-28931 MTR prints detailed stack trace unconditionally 66832e3a introduced change that prints core dumps in very detailed format. That's completely out of user-friendliness but serves as a measure for debugging hard-reproducible bugs. The proper way to implement this: 1. it must be controlled by command-line and environment variable; 2. detailed traces must be default for buildbots only, for user invocations normal stack traces should be printed. Options for control are: MTR_PRINT_CORE and --print-core that accept the following values: no Don't print core short Print stack trace of failed thread medium Print stack traces of all threads detailed Print all stack traces with debug context custom: Use debugger commands to print stack trace Default setting is: short (see env_or_default() call in pre_setup()) For environment variable wrong values are silently ignored (falls back to default setting, see env_or_default()). Command-line option --print-core (or -C) overrides environment variable. Its default value is 'short' if not specified explicitly (same env_or_default() call in pre_setup()). Explicit values are checked for validity. --print-method option can specify by which debugger we print cores. For Windows there is only one choice: cdb. For Unix the values are: gdb, dbx, lldb, auto. Default value is: auto In 'auto' we try to use all possible debuggers until success. --- mysql-test/lib/My/CoreDump.pm | 237 ++++++++++++++++++++++++++++++++++++------ 1 file changed, 204 insertions(+), 33 deletions(-) (limited to 'mysql-test/lib') diff --git a/mysql-test/lib/My/CoreDump.pm b/mysql-test/lib/My/CoreDump.pm index 801b3136cd2..3b61f20ef24 100644 --- a/mysql-test/lib/My/CoreDump.pm +++ b/mysql-test/lib/My/CoreDump.pm @@ -19,9 +19,141 @@ package My::CoreDump; use strict; use Carp; use My::Platform; +use Text::Wrap; +use Data::Dumper; use File::Temp qw/ tempfile tempdir /; use mtr_results; +use mtr_report; + +my %opts; +my %config; +my $help = "\n\nOptions for printing core dumps\n\n"; + +sub register_opt($$$) { + my ($name, $format, $msg)= @_; + my @names= split(/\|/, $name); + my $option_name= $names[0]; + $option_name=~ s/-/_/; + $opts{$name. $format}= \$config{$option_name}; + $help.= wrap(sprintf(" %-23s", join(', ', @names)), ' 'x25, "$msg\n"); +} + +# To preserve order we use array instead of hash +my @print_formats= ( + short => { + description => "Failing stack trace", + codes => {} + }, + medium => { + description => "All stack traces", + codes => {} + }, + detailed => { + description => "All stack traces with debug context", + codes => {} + }, + custom => { + description => "Custom debugger script for printing stack" + }, + # 'no' must be last (check generated help) + no => { + description => "Skip stack trace printing" + } +); + +# TODO: make class for each {method, get_code} +my @print_methods= (IS_WINDOWS) ? (cdb => { method => \&_cdb }) : ( + gdb => { + method => \&_gdb, + get_code => \&_gdb_format, + }, + dbx => { + method => \&_dbx + }, + lldb => { + method => \&_lldb + }, + # 'auto' must be last (check generated help) + auto => { + method => \&_auto + } +); + +# But we also use hash +my %print_formats= @print_formats; +my %print_methods= @print_methods; + +# and scalar +my $x= 0; +my $print_formats= join(', ', grep { ++$x % 2 } @print_formats); +$x= 0; +my $print_methods= join(', ', grep { ++$x % 2 } @print_methods); + +# Fill 'short' and 'detailed' formats per each print_method +# that has interface for that +for my $f (keys %print_formats) +{ + next unless exists $print_formats{$f}->{codes}; + for my $m (keys %print_methods) + { + next unless exists $print_methods{$m}->{get_code}; + # That calls f.ex. _gdb_format('short') + # and assigns { gdb => value-of-_gdb_format } into $print_formats{short}->{format}: + $print_formats{$f}->{codes}->{$m}= $print_methods{$m}->{get_code}->($f); + } +} + +register_opt('print-core|C', ':s', + "Print core dump format: ". $print_formats. " (for not printing cores). ". + "Defaults to value of MTR_PRINT_CORE or 'short'"); +if (!IS_WINDOWS) +{ + register_opt('print-method', '=s', + "Print core method: ". join(', ', $print_methods). " (try each method until success). ". + "Defaults to 'auto'"); +} + +sub options() { %opts } +sub help() { $help } + + +sub env_or_default($$) { + my ($default, $env)= @_; + if (exists $ENV{$env}) { + my $f= $ENV{$env}; + $f= 'custom' + if $f =~ m/^custom:/; + return $ENV{$env} + if exists $print_formats{$f}; + mtr_verbose("$env value ignored: $ENV{$env}"); + } + return $default; +} + +sub pre_setup() { + $config{print_core}= env_or_default('short', 'MTR_PRINT_CORE') + if not defined $config{print_core}; + $config{print_method}= (IS_WINDOWS) ? 'cdb' : 'auto' + if not defined $config{print_method}; + # If the user has specified 'custom' we fill appropriate print_format + # and that will be used automatically + # Note: this can assign 'custom' to method 'auto'. + if ($config{print_core} =~ m/^custom:(.+)$/) { + $config{print_core}= 'custom'; + $print_formats{'custom'}= { + $config{print_method} => $1 + } + } + mtr_error "Wrong value for --print-core: $config{print_core}" + if not exists $print_formats{$config{print_core}}; + mtr_error "Wrong value for --print-method: $config{print_method}" + if not exists $print_methods{$config{print_method}}; + + mtr_debug(Data::Dumper->Dump( + [\%config, \%print_formats, \%print_methods], + [qw(config print_formats print_methods)])); +} my $hint_mysqld; # Last resort guess for executable path @@ -50,8 +182,38 @@ sub _verify_binpath { return $binpath; } + +# Returns GDB code according to specified format + +# Note: this is like simple hash, separate interface was made +# in advance for implementing below TODO + +# TODO: _gdb_format() and _gdb() should be separate class +# (like the other printing methods) + +sub _gdb_format($) { + my ($format)= @_; + my %formats= ( + short => "bt\n", + medium => "thread apply all bt\n", + detailed => + "bt\n". + "set print sevenbit on\n". + "set print static-members off\n". + "set print frame-arguments all\n". + "thread apply all bt full\n". + "quit\n" + ); + confess "Unknown format: ". $format + unless exists $formats{$format}; + return $formats{$format}; +} + + sub _gdb { - my ($core_name)= @_; + my ($core_name, $code)= @_; + confess "Undefined format" + unless defined $code; # Check that gdb exists `gdb --version`; @@ -61,7 +223,7 @@ sub _gdb { } if (-f $core_name) { - print "\nTrying 'gdb' to get a backtrace from coredump $core_name\n"; + mtr_verbose("Trying 'gdb' to get a backtrace from coredump $core_name"); } else { print "\nCoredump $core_name does not exist, cannot run 'gdb'\n"; return; @@ -76,13 +238,7 @@ sub _gdb { # Create tempfile containing gdb commands my ($tmp, $tmp_name) = tempfile(); - print $tmp - "bt\n", - "set print sevenbit on\n", - "set print static-members off\n", - "set print frame-arguments all\n", - "thread apply all bt full\n", - "quit\n"; + print $tmp $code; close $tmp or die "Error closing $tmp_name: $!"; # Run gdb @@ -105,7 +261,7 @@ EOF sub _dbx { - my ($core_name)= @_; + my ($core_name, $format)= @_; print "\nTrying 'dbx' to get a backtrace\n"; @@ -167,7 +323,7 @@ sub cdb_check { sub _cdb { - my ($core_name)= @_; + my ($core_name, $format)= @_; print "\nTrying 'cdb' to get a backtrace\n"; return unless -f $core_name; @@ -304,32 +460,47 @@ EOF } +sub _auto +{ + my ($core_name, $code, $rest)= @_; + # We use ordered array @print_methods and omit auto itself + my @valid_methods= @print_methods[0 .. $#print_methods - 2]; + my $x= 0; + my @methods= grep { ++$x % 2} @valid_methods; + my $f= $config{print_core}; + foreach my $m (@methods) + { + my $debugger= $print_methods{$m}; + confess "Broken @print_methods" + if $debugger->{method} == \&_auto; + # If we didn't find format for 'auto' (that is only possible for 'custom') + # we get format for specific debugger + if (not defined $code && defined $print_formats{$f} and + exists $print_formats{$f}->{codes}->{$m}) + { + $code= $print_formats{$f}->{codes}->{$m}; + } + mtr_verbose2("Trying to print with method ${m}:${f}"); + if ($debugger->{method}->($core_name, $code)) { + return; + } + } +} + sub show { my ($class, $core_name, $exe_mysqld, $parallel)= @_; - $hint_mysqld= $exe_mysqld; - - # On Windows, rely on cdb to be there... - if (IS_WINDOWS) - { - _cdb($core_name); - return; - } - - my @debuggers = - ( - \&_gdb, - \&_dbx, - \&_lldb, - # TODO... - ); - - # Try debuggers until one succeeds - - foreach my $debugger (@debuggers){ - if ($debugger->($core_name)){ - return; + if ($config{print_core} ne 'no') { + my $f= $config{print_core}; + my $m= $config{print_method}; + my $code= undef; + if (exists $print_formats{$f}->{codes} and + exists $print_formats{$f}->{codes}->{$m}) { + $code= $print_formats{$f}->{codes}->{$m}; } + mtr_verbose2("Printing core with method ${m}:${f}"); + mtr_debug("code: ${code}"); + $print_methods{$m}->{method}->($core_name, $code); } return; } -- cgit v1.2.1 From 1bdcffb02801df880a63a6ced7c87bf70ee1886f Mon Sep 17 00:00:00 2001 From: Aleksey Midenkov Date: Mon, 18 Jul 2022 23:16:17 +0300 Subject: MDEV-29025 Refactoring: moved out core_wanted() out of mysql-test-run.pl --- mysql-test/lib/My/CoreDump.pm | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) (limited to 'mysql-test/lib') diff --git a/mysql-test/lib/My/CoreDump.pm b/mysql-test/lib/My/CoreDump.pm index 3b61f20ef24..298cf9ef877 100644 --- a/mysql-test/lib/My/CoreDump.pm +++ b/mysql-test/lib/My/CoreDump.pm @@ -23,6 +23,8 @@ use Text::Wrap; use Data::Dumper; use File::Temp qw/ tempfile tempdir /; +use File::Find; +use File::Basename; use mtr_results; use mtr_report; @@ -489,7 +491,7 @@ sub _auto sub show { - my ($class, $core_name, $exe_mysqld, $parallel)= @_; + my ($core_name, $exe_mysqld, $parallel)= @_; if ($config{print_core} ne 'no') { my $f= $config{print_core}; my $m= $config{print_method}; @@ -506,4 +508,36 @@ sub show { } +sub core_wanted($$$$$) { + my ($num_saved_cores, $opt_max_save_core, $compress, + $exe_mysqld, $opt_parallel)= @_; + my $core_file= $File::Find::name; + my $core_name= basename($core_file); + + # Name beginning with core, not ending in .gz + if (($core_name =~ /^core/ and $core_name !~ /\.gz$/) + or (IS_WINDOWS and $core_name =~ /\.dmp$/)) + { + # Ending with .dmp + mtr_report(" - found '$core_name'", + "($$num_saved_cores/$opt_max_save_core)"); + + show($core_file, $exe_mysqld, $opt_parallel); + + # Limit number of core files saved + if ($$num_saved_cores >= $opt_max_save_core) + { + mtr_report(" - deleting it, already saved", + "$opt_max_save_core"); + unlink("$core_file"); + } + else + { + main::mtr_compress_file($core_file) if $compress; + ++$$num_saved_cores; + } + } +} + + 1; -- cgit v1.2.1