131014dae410799bfb128af2d396ee70374fa4b75florian#!/usr/bin/env perl
231014dae410799bfb128af2d396ee70374fa4b75florian
331014dae410799bfb128af2d396ee70374fa4b75florianuse warnings;
431014dae410799bfb128af2d396ee70374fa4b75florianuse strict;
531014dae410799bfb128af2d396ee70374fa4b75florian
631014dae410799bfb128af2d396ee70374fa4b75florian#---------------------------------------------------------------------
731014dae410799bfb128af2d396ee70374fa4b75florian# A list of files specific to the tool at hand. Line numbers in
831014dae410799bfb128af2d396ee70374fa4b75florian# these files will be removed from backtrace entries matching these files.
931014dae410799bfb128af2d396ee70374fa4b75florian#---------------------------------------------------------------------
1031014dae410799bfb128af2d396ee70374fa4b75florianmy @tool_files = ( "hg_intercepts.c", "vg_replace_malloc.c" );
1131014dae410799bfb128af2d396ee70374fa4b75florian
1231014dae410799bfb128af2d396ee70374fa4b75florian
1331014dae410799bfb128af2d396ee70374fa4b75floriansub massage_backtrace_line ($$$) {
1431014dae410799bfb128af2d396ee70374fa4b75florian    my ($line, $tool_files, $cmdlin_files) = @_;
1531014dae410799bfb128af2d396ee70374fa4b75florian    my ($string, $qstring);
1631014dae410799bfb128af2d396ee70374fa4b75florian
1731014dae410799bfb128af2d396ee70374fa4b75florian# If LINE matches any of the file names passed on the command line
1831014dae410799bfb128af2d396ee70374fa4b75florian# (i.e. in CMDLIN_FILES) return LINE unmodified.
1931014dae410799bfb128af2d396ee70374fa4b75florian
2031014dae410799bfb128af2d396ee70374fa4b75florian    foreach $string (@$cmdlin_files) {
2131014dae410799bfb128af2d396ee70374fa4b75florian        $qstring = quotemeta($string);
2231014dae410799bfb128af2d396ee70374fa4b75florian        return $line if ($line =~ /$qstring/);
2331014dae410799bfb128af2d396ee70374fa4b75florian    }
2431014dae410799bfb128af2d396ee70374fa4b75florian
2531014dae410799bfb128af2d396ee70374fa4b75florian# If LINE matches any of the file names in TOOL_FILES remove the line
2631014dae410799bfb128af2d396ee70374fa4b75florian# number and return the so modified line.
2731014dae410799bfb128af2d396ee70374fa4b75florian
2831014dae410799bfb128af2d396ee70374fa4b75florian    foreach $string (@$tool_files) {
2931014dae410799bfb128af2d396ee70374fa4b75florian        $qstring = quotemeta($string);
3031014dae410799bfb128af2d396ee70374fa4b75florian        return $line if ($line =~ s/$qstring:[0-9]+/$string:.../m);
3131014dae410799bfb128af2d396ee70374fa4b75florian# Special case for functions whose line numbers have been removed in 
3231014dae410799bfb128af2d396ee70374fa4b75florian# filter_stderr_basic. FIXME: filter_stderr_basic should not do that.
3331014dae410799bfb128af2d396ee70374fa4b75florian        return $line if ($line =~ s/$qstring:\.\.\./$string:.../m);
3431014dae410799bfb128af2d396ee70374fa4b75florian    }
3531014dae410799bfb128af2d396ee70374fa4b75florian
3631014dae410799bfb128af2d396ee70374fa4b75florian# Did not match anything
3731014dae410799bfb128af2d396ee70374fa4b75florian    $line =~ s/[\w]+.*/.../m;
3831014dae410799bfb128af2d396ee70374fa4b75florian
3931014dae410799bfb128af2d396ee70374fa4b75florian    return "$line";
4031014dae410799bfb128af2d396ee70374fa4b75florian}
4131014dae410799bfb128af2d396ee70374fa4b75florian
4231014dae410799bfb128af2d396ee70374fa4b75florian
4331014dae410799bfb128af2d396ee70374fa4b75florian#---------------------------------------------------------------------
4431014dae410799bfb128af2d396ee70374fa4b75florian# Process lines. Two categories
4531014dae410799bfb128af2d396ee70374fa4b75florian# (a) lines from back traces
4631014dae410799bfb128af2d396ee70374fa4b75florian#     pass through those lines that contain file names we're interested in
4731014dae410799bfb128af2d396ee70374fa4b75florian# (b) everything else
4831014dae410799bfb128af2d396ee70374fa4b75florian#     pass through as is
4931014dae410799bfb128af2d396ee70374fa4b75florian#---------------------------------------------------------------------
5031014dae410799bfb128af2d396ee70374fa4b75florianmy $prev_line = "";
5131014dae410799bfb128af2d396ee70374fa4b75florianwhile (<STDIN>) {
5231014dae410799bfb128af2d396ee70374fa4b75florian    my $line = $_;
5331014dae410799bfb128af2d396ee70374fa4b75florian    chomp($line);
5431014dae410799bfb128af2d396ee70374fa4b75florian    if ($line =~ /^\s+(at |by )/)  {   # lines in a back trace
5531014dae410799bfb128af2d396ee70374fa4b75florian        $line = massage_backtrace_line($line, \@tool_files, \@ARGV);
5631014dae410799bfb128af2d396ee70374fa4b75florian        if ($line =~ /\s+\.\.\./) {
5731014dae410799bfb128af2d396ee70374fa4b75florian            print "$line\n" if ($prev_line !~ /\s+\.\.\./);
5831014dae410799bfb128af2d396ee70374fa4b75florian        } else {
5931014dae410799bfb128af2d396ee70374fa4b75florian            print "$line\n";
6031014dae410799bfb128af2d396ee70374fa4b75florian        }
6131014dae410799bfb128af2d396ee70374fa4b75florian    } else {
6231014dae410799bfb128af2d396ee70374fa4b75florian        print "$line\n";  # everything else
6331014dae410799bfb128af2d396ee70374fa4b75florian    }
6431014dae410799bfb128af2d396ee70374fa4b75florian    $prev_line = $line
6531014dae410799bfb128af2d396ee70374fa4b75florian}
6631014dae410799bfb128af2d396ee70374fa4b75florian
6731014dae410799bfb128af2d396ee70374fa4b75florianexit 0;
68