mariadb/mysql-test/lib/My/CoreDump.pm

# -*- 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)= @_;

  print "\nTrying 'gdb' to get a backtrace\n";

  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 -batch 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 " - core generated by '$binary'\n";

  my $list= `gdb $binary -c $core_name -x $tmp_name -batch 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;