1#!/usr/bin/env perl
2
3use warnings;
4use strict;
5
6#---------------------------------------------------------------------
7# A list of files specific to the tool at hand. Line numbers in
8# these files will be removed from backtrace entries matching these files.
9#---------------------------------------------------------------------
10my @tool_files = ( "hg_intercepts.c", "vg_replace_malloc.c" );
11
12
13sub massage_backtrace_line ($$$) {
14    my ($line, $tool_files, $cmdlin_files) = @_;
15    my ($string, $qstring);
16
17# If LINE matches any of the file names passed on the command line
18# (i.e. in CMDLIN_FILES) return LINE unmodified.
19
20    foreach $string (@$cmdlin_files) {
21        $qstring = quotemeta($string);
22        return $line if ($line =~ /$qstring/);
23    }
24
25# If LINE matches any of the file names in TOOL_FILES remove the line
26# number and return the so modified line.
27
28    foreach $string (@$tool_files) {
29        $qstring = quotemeta($string);
30        return $line if ($line =~ s/$qstring:[0-9]+/$string:.../m);
31# Special case for functions whose line numbers have been removed in 
32# filter_stderr_basic. FIXME: filter_stderr_basic should not do that.
33        return $line if ($line =~ s/$qstring:\.\.\./$string:.../m);
34    }
35
36# Did not match anything
37    $line =~ s/[\w]+.*/.../m;
38
39    return "$line";
40}
41
42
43#---------------------------------------------------------------------
44# Process lines. Two categories
45# (a) lines from back traces
46#     pass through those lines that contain file names we're interested in
47# (b) everything else
48#     pass through as is
49#---------------------------------------------------------------------
50my $prev_line = "";
51while (<STDIN>) {
52    my $line = $_;
53    chomp($line);
54    if ($line =~ /^\s+(at |by )/)  {   # lines in a back trace
55        $line = massage_backtrace_line($line, \@tool_files, \@ARGV);
56        if ($line =~ /\s+\.\.\./) {
57            print "$line\n" if ($prev_line !~ /\s+\.\.\./);
58        } else {
59            print "$line\n";
60        }
61    } else {
62        print "$line\n";  # everything else
63    }
64    $prev_line = $line
65}
66
67exit 0;
68