Bug#38817 please make mtr analyze crashes better

1 files changed, 79 insertions, 0 deletions

diff --git a/mysql-test/lib/My/CoreDump.pm b/mysql-test/lib/My/CoreDump.pm
new file mode 100644
index 00000000000..5f7427768c2
--- /dev/null
+++ b/mysql-test/lib/My/CoreDump.pm
@@ -0,0 +1,79 @@
+# -*- cperl -*-
+# Copyright (C) 2004-2006 MySQL AB
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+
+package My::CoreDump;
+
+use strict;
+use Carp;
+use My::Platform;
+
+use File::Temp qw/ tempfile tempdir /;
+
+sub _gdb {
+  my ($core_name)= @_;
+
+  return unless -f $core_name;
+
+  my $dir = tempdir( CLEANUP => 1 );
+  my ($tmp, $tmp_name) = tempfile( DIR => $dir );
+
+  print $tmp
+    "thread apply all bt\n",
+    "quit\n";
+
+  # Find out name of binary that generated core
+  my $list= `gdb -c $core_name -x $tmp_name -q 2>&1`
+    or return;
+
+  my $binary;
+  foreach my $line (split('\n', $list))
+  {
+    $binary= $1
+      if ($line =~ /Core was generated by `(\S+)/);
+  }
+
+  return unless $binary;
+
+  print "Generated by '$binary'\n";
+
+  my $list= `gdb $binary -c $core_name -x $tmp_name -q 2>&1`
+    or return;
+
+  print $list, "\n";
+
+  return 1;
+}
+
+
+sub show {
+  my ($class, $core_name)= @_;
+
+  my @debuggers =
+    (
+     \&_gdb,
+     # TODO...
+   );
+
+  foreach my $debugger (@debuggers){
+    if ($debugger->($core_name)){
+      return;
+    }
+  }
+  return;
+}
+
+
+1;