← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/randgen/lib/GenTest/Reporter/Backtrace.pm

  • Committer: Mark Atwood
  • Date: 2011-10-14 15:59:08 UTC
  • mfrom: (2430.1.12 refactor3a)
  • Revision ID: me@mark.atwood.name-20111014155908-whqmrmaf2grpsg5c
merge lp:~olafvdspek/drizzle/refactor3

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/randgen/lib/GenTest/Reporter/Backtrace.pm
1
 
# Copyright (C) 2008-2010 Sun Microsystems, Inc. All rights reserved.
2
 
# Use is subject to license terms.
3
 
#
4
 
# This program is free software; you can redistribute it and/or modify
5
 
# it under the terms of the GNU General Public License as published by
6
 
# the Free Software Foundation; version 2 of the License.
7
 
#
8
 
# This program is distributed in the hope that it will be useful, but
9
 
# WITHOUT ANY WARRANTY; without even the implied warranty of
10
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11
 
# General Public License for more details.
12
 
#
13
 
# You should have received a copy of the GNU General Public License
14
 
# along with this program; if not, write to the Free Software
15
 
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
16
 
# USA
17
 
 
18
 
package GenTest::Reporter::Backtrace;
19
 
 
20
 
require Exporter;
21
 
@ISA = qw(GenTest::Reporter);
22
 
 
23
 
use strict;
24
 
use GenTest;
25
 
use GenTest::Constants;
26
 
use GenTest::Reporter;
27
 
use GenTest::Incident;
28
 
 
29
 
sub report {
30
 
        my $reporter = shift;
31
 
 
32
 
        my $datadir = $reporter->serverVariable('datadir');
33
 
        say("datadir is $datadir");
34
 
 
35
 
        my $binary = $reporter->serverInfo('binary');
36
 
        say("binary is $binary");
37
 
        
38
 
        my $bindir = $reporter->serverInfo('bindir');
39
 
        say("bindir is $bindir");
40
 
 
41
 
        my $pid = $reporter->serverInfo('pid');
42
 
        my $core = <$datadir/core*>;
43
 
        $core = </cores/core.$pid> if $^O eq 'darwin';
44
 
        say("core is $core");
45
 
 
46
 
        my @commands;
47
 
 
48
 
        if (osWindows()) {
49
 
                $bindir =~ s{/}{\\}sgio;
50
 
                my $cdb_cmd = "!sym prompts off; !analyze -v; .ecxr; !for_each_frame dv /t;~*k;q";              
51
 
                push @commands, 'cdb -i "'.$bindir.'" -y "'.$bindir.';srv*C:\\cdb_symbols*http://msdl.microsoft.com/download/symbols" -z "'.$datadir.'\mysqld.dmp" -lines -c "'.$cdb_cmd.'"';
52
 
    } elsif (osSolaris()) {
53
 
        ## We don't want to run gdb on solaris since it may core-dump
54
 
        ## if the executable was generated with SunStudio.
55
 
 
56
 
        ## 1) First try to do it with dbx. dbx should work for both
57
 
        ## Sunstudio and GNU CC. This is a bit complicated since we
58
 
        ## need to first ask dbx which threads we have, and then dump
59
 
        ## the stack for each thread.
60
 
 
61
 
        ## The code below is "inspired by MTR
62
 
        `echo | dbx - $core 2>&1` =~ m/Corefile specified executable: "([^"]+)"/;
63
 
        if ($1) {
64
 
            ## We do apparently have a working dbx
65
 
            
66
 
            # First, identify all threads
67
 
            my @threads = `echo threads | dbx $binary $core 2>&1` =~ m/t@\d+/g;
68
 
 
69
 
            ## Then we make a command for each thread (It would be
70
 
            ## more efficient and get nicer output to have all
71
 
            ## commands in one dbx-batch, TODO!)
72
 
 
73
 
            my $traces = join("; ",map{"where ".$_} @threads);
74
 
 
75
 
            push @commands, "echo \"$traces\" | dbx $binary $core";
76
 
        } elsif ($core) {
77
 
            ## We'll attempt pstack and c++filt which should allways
78
 
            ## work and show all threads. c++filt from SunStudio
79
 
            ## should even be able to demangle GNU CC-compiled
80
 
                ## executables.
81
 
            push @commands, "pstack $core | c++filt";
82
 
        } else {
83
 
            say ("No core available");
84
 
        }
85
 
        } else {
86
 
        ## Assume all other systems are gdb-"friendly" ;-)
87
 
                push @commands, "gdb --batch --se=$binary --core=$core --command=backtrace.gdb";
88
 
                push @commands, "gdb --batch --se=$binary --core=$core --command=backtrace-all.gdb";
89
 
        }
90
 
        
91
 
        my @debugs;
92
 
 
93
 
        foreach my $command (@commands) {
94
 
                my $output = `$command`;
95
 
                say("$output");
96
 
                push @debugs, [$command, $output];
97
 
        }
98
 
 
99
 
 
100
 
    my $incident = GenTest::Incident->new(
101
 
        result   => 'fail',
102
 
        corefile => $core,
103
 
        debugs   => \@debugs
104
 
    );
105
 
 
106
 
        return STATUS_OK, $incident;
107
 
}
108
 
 
109
 
sub type {
110
 
        return REPORTER_TYPE_CRASH | REPORTER_TYPE_DEADLOCK;
111
 
}
112
 
 
113
 
1;
 
1
# Copyright (C) 2008-2010 Sun Microsystems, Inc. All rights reserved.
 
2
# Use is subject to license terms.
 
3
#
 
4
# This program is free software; you can redistribute it and/or modify
 
5
# it under the terms of the GNU General Public License as published by
 
6
# the Free Software Foundation; version 2 of the License.
 
7
#
 
8
# This program is distributed in the hope that it will be useful, but
 
9
# WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 
11
# General Public License for more details.
 
12
#
 
13
# You should have received a copy of the GNU General Public License
 
14
# along with this program; if not, write to the Free Software
 
15
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
 
16
# USA
 
17
 
 
18
package GenTest::Reporter::Backtrace;
 
19
 
 
20
require Exporter;
 
21
@ISA = qw(GenTest::Reporter);
 
22
 
 
23
use strict;
 
24
use GenTest;
 
25
use GenTest::Constants;
 
26
use GenTest::Reporter;
 
27
use GenTest::Incident;
 
28
 
 
29
sub report {
 
30
        my $reporter = shift;
 
31
 
 
32
        my $datadir = $reporter->serverVariable('datadir');
 
33
        say("datadir is $datadir");
 
34
 
 
35
        my $binary = $reporter->serverInfo('binary');
 
36
        say("binary is $binary");
 
37
        
 
38
        my $bindir = $reporter->serverInfo('bindir');
 
39
        say("bindir is $bindir");
 
40
 
 
41
        my $pid = $reporter->serverInfo('pid');
 
42
        my $core = <$datadir/core*>;
 
43
        $core = </cores/core.$pid> if $^O eq 'darwin';
 
44
        say("core is $core");
 
45
 
 
46
        my @commands;
 
47
 
 
48
        if (osWindows()) {
 
49
                $bindir =~ s{/}{\\}sgio;
 
50
                my $cdb_cmd = "!sym prompts off; !analyze -v; .ecxr; !for_each_frame dv /t;~*k;q";              
 
51
                push @commands, 'cdb -i "'.$bindir.'" -y "'.$bindir.';srv*C:\\cdb_symbols*http://msdl.microsoft.com/download/symbols" -z "'.$datadir.'\mysqld.dmp" -lines -c "'.$cdb_cmd.'"';
 
52
    } elsif (osSolaris()) {
 
53
        ## We don't want to run gdb on solaris since it may core-dump
 
54
        ## if the executable was generated with SunStudio.
 
55
 
 
56
        ## 1) First try to do it with dbx. dbx should work for both
 
57
        ## Sunstudio and GNU CC. This is a bit complicated since we
 
58
        ## need to first ask dbx which threads we have, and then dump
 
59
        ## the stack for each thread.
 
60
 
 
61
        ## The code below is "inspired by MTR
 
62
        `echo | dbx - $core 2>&1` =~ m/Corefile specified executable: "([^"]+)"/;
 
63
        if ($1) {
 
64
            ## We do apparently have a working dbx
 
65
            
 
66
            # First, identify all threads
 
67
            my @threads = `echo threads | dbx $binary $core 2>&1` =~ m/t@\d+/g;
 
68
 
 
69
            ## Then we make a command for each thread (It would be
 
70
            ## more efficient and get nicer output to have all
 
71
            ## commands in one dbx-batch, TODO!)
 
72
 
 
73
            my $traces = join("; ",map{"where ".$_} @threads);
 
74
 
 
75
            push @commands, "echo \"$traces\" | dbx $binary $core";
 
76
        } elsif ($core) {
 
77
            ## We'll attempt pstack and c++filt which should allways
 
78
            ## work and show all threads. c++filt from SunStudio
 
79
            ## should even be able to demangle GNU CC-compiled
 
80
                ## executables.
 
81
            push @commands, "pstack $core | c++filt";
 
82
        } else {
 
83
            say ("No core available");
 
84
        }
 
85
        } else {
 
86
        ## Assume all other systems are gdb-"friendly" ;-)
 
87
                push @commands, "gdb --batch --se=$binary --core=$core --command=backtrace.gdb";
 
88
                push @commands, "gdb --batch --se=$binary --core=$core --command=backtrace-all.gdb";
 
89
        }
 
90
        
 
91
        my @debugs;
 
92
 
 
93
        foreach my $command (@commands) {
 
94
                my $output = `$command`;
 
95
                say("$output");
 
96
                push @debugs, [$command, $output];
 
97
        }
 
98
 
 
99
 
 
100
    my $incident = GenTest::Incident->new(
 
101
        result   => 'fail',
 
102
        corefile => $core,
 
103
        debugs   => \@debugs
 
104
    );
 
105
 
 
106
        return STATUS_OK, $incident;
 
107
}
 
108
 
 
109
sub type {
 
110
        return REPORTER_TYPE_CRASH | REPORTER_TYPE_DEADLOCK;
 
111
}
 
112
 
 
113
1;