1 | package arb_build_common; |
---|
2 | |
---|
3 | # meant to be used from perl scripts used during build of ARB |
---|
4 | |
---|
5 | use strict; |
---|
6 | use warnings; |
---|
7 | |
---|
8 | BEGIN { |
---|
9 | use Exporter (); |
---|
10 | our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS); |
---|
11 | $VERSION = 1.00; |
---|
12 | @ISA = qw(Exporter); |
---|
13 | @EXPORT = qw( |
---|
14 | &format_asan_line |
---|
15 | ); |
---|
16 | %EXPORT_TAGS = qw(); |
---|
17 | @EXPORT_OK = qw(); |
---|
18 | } |
---|
19 | |
---|
20 | # ---------------------------------------- |
---|
21 | |
---|
22 | my @alternative = (); |
---|
23 | my $ARBHOME = $ENV{ARBHOME}; |
---|
24 | |
---|
25 | sub format_asan_line($$) { |
---|
26 | my ($line,$topdir) = @_; |
---|
27 | # if $line is output from AddressSanitizer/LeakSanitizer -> reformat into 'file:lineno: msg' format |
---|
28 | # return undef if isnt (or source file is unknown) |
---|
29 | # if $topdir!=undef => remove topdir-prefix from path |
---|
30 | |
---|
31 | my $result = undef; |
---|
32 | |
---|
33 | my $dump_alternatives = 1; |
---|
34 | |
---|
35 | if ($line =~ /^\s+(\#[0-9]+\s.*)\s+(.*):([0-9]+)$/o) { |
---|
36 | my ($msg,$file,$lineNo) = ($1,$2,$3); |
---|
37 | if (-f $file) { |
---|
38 | if ((defined $topdir) and ($file =~ /^$topdir\//)) { $file = $'; } |
---|
39 | $result = "$file:$lineNo: $msg\n"; |
---|
40 | } |
---|
41 | elsif ($file =~ /^(C|GENC|GENH)\//o) { |
---|
42 | my $PROBE_file = 'PROBE_COM/'.$file; |
---|
43 | my $NAMES_file = 'NAMES_COM/'.$file; |
---|
44 | |
---|
45 | my $base = (defined $topdir) ? $topdir : $ARBHOME; |
---|
46 | $PROBE_file = $base.'/'.$PROBE_file; |
---|
47 | $NAMES_file = $base.'/'.$NAMES_file; |
---|
48 | |
---|
49 | $dump_alternatives = 0; # do later |
---|
50 | |
---|
51 | if (-f $PROBE_file) { |
---|
52 | if ((defined $topdir) and ($PROBE_file =~ /^$topdir\//)) { $PROBE_file = $'; } |
---|
53 | $result = "$PROBE_file:$lineNo: $msg\n"; |
---|
54 | } |
---|
55 | if (-f $NAMES_file) { |
---|
56 | if ((defined $topdir) and ($NAMES_file =~ /^$topdir\//)) { $NAMES_file = $'; } |
---|
57 | push @alternative, "$NAMES_file:$lineNo: $msg"; |
---|
58 | } |
---|
59 | } |
---|
60 | } |
---|
61 | |
---|
62 | if ($dump_alternatives==1 and scalar(@alternative)>0) { |
---|
63 | my $pre_result .= "alternative callstack [start]\n"; |
---|
64 | foreach (@alternative) { |
---|
65 | $pre_result .= $_."\n"; |
---|
66 | } |
---|
67 | $pre_result .= "alternative callstack [end]\n"; |
---|
68 | @alternative = (); |
---|
69 | $result = $pre_result.$result; |
---|
70 | } |
---|
71 | |
---|
72 | return $result; |
---|
73 | } |
---|
74 | |
---|
75 | |
---|
76 | # ---------------------------------------- |
---|
77 | # cleanup (if needed) |
---|
78 | END { } |
---|
79 | |
---|
80 | 1; # module initialization is ok |
---|